#lang plai-typed

(require [typed-in games/cards
                   (shuffle-list : ((listof 'a) number -> (listof 'a)))])

(require [typed-in racket
                   (negative? : (number -> boolean))
                   (findf : ((number -> boolean) (listof 'a) -> 'a))
                   (false? : ('a -> boolean))
                   (print : ('a -> string))])

(define-type Marriage
  (marriage (woman : number) (man : number)))

(define (find-first (l : (listof number)) (m1 : number) (m2 : number)) : number
  (cond
    [(empty? l) -1]
    [(cons? l) (if (or (= m1 (first l)) (= m2 (first l))) (first l) (find-first (rest l) m1 m2))]))

(define (match1 (women : (listof (listof number))) (men  : (listof (listof number)))) : (listof Marriage)
  (local [(define m-engagements (make-vector (length men) -1))
          (define w-engagements (make-vector (length women) -1))
          (define (match (men : (listof (listof number)))) : (listof Marriage)
            (if (empty? (filter eligible? men))
                (produce-answer men)
                (match (map match-a-man men))))
          (define (match-a-man (aman : (listof number))) : (listof number)
            (if (eligible? aman)
                (local [(define m (first aman))
                        (define w (first (rest aman)))
                        (define fiance (vector-ref w-engagements w))]
                  (begin (if (negative? fiance)
                             (engage m w)
                             (let ([preferred (find-first (list-ref women w) m fiance)])
                               (cond
                                 [(= -1 preferred) (error 'a "She doesn't like either guy?")]
                                 [(equal? m preferred)
                                  (begin
                                    (vector-set! m-engagements fiance -1)
                                    (engage m w))]
                                 [else (void)])))
                         (cons m (rest (rest aman)))))
                aman))
          (define (engage (m : number) (w : number)) : void
            (begin
              (vector-set! m-engagements m w)
              (vector-set! w-engagements w m)))
          (define (eligible? (aman : (listof number))) : boolean
            (and (negative? (vector-ref m-engagements (first aman)))
                 (not (empty? (rest aman)))))
          (define (produce-answer (men : (listof (listof number)))) : (listof Marriage)
            (map (lambda (aman)
                          (marriage (first aman) (vector-ref w-engagements (first aman)) ))
                 men))]
    (match (index-list men))))

(define (matchmaker (women : (listof (listof number))) (men : (listof (listof number)))) : (listof Marriage)
  (shuffle-list (match1 men women) 7))


(define (index-list (alox : (listof 'a))) : (listof (listof 'a))
  (local [(define (index-list-help alox num)
            (cond
              [(empty? alox) empty]
              [(cons? alox) (cons (cons num (first alox)) (index-list-help (rest alox) (+ num 1)))]))]
    (index-list-help alox 0)))