(module random mzscheme
  (require (lib "contract.ss")
           (lib "etc.ss"))
  (define-struct generator (proc))
  (provide random-recursive )
  (provide/contract
   [generator? (any/c . -> . boolean?)]
   [nonrandom (any/c . -> . generator?)]
   [random-apply (->* (procedure?) (listof generator?)  (generator?) )]
   [random-size (opt-> () (natural-number/c)  generator?)]
   [random-function ( procedure? . -> . generator?) ]
   [random-choice (->* () (listof generator?) (generator?)) ]
   [random-boolean generator?]
   [random-nat generator?]
   [generate (generator? . -> .  any/c)]
   [random-weighted (->* () 
                         (flat-rec-contract weighted-generators/c
                                            null?
                                            (cons/c (>/c 0)
                                                    (cons/c generator?
                                                            weighted-generators/c)))
                         (generator?))]
   [random-int-between (integer? integer? . -> . generator?)]
   [random-uniform (opt-> ((->* () (listof generator?) (generator?))
                           generator?)
                          (generator?)
                          generator?)]
   [random-list-of (opt-> (generator?) (generator?) generator?)]
   [random-vector-of (opt-> (generator?) (generator?) generator?) ]
   [random-list (->* () (listof generator?) (generator?))]
   [random-vector (->* () (listof generator?) (generator?))]
   [random-bytes (opt-> () (generator? generator?) generator?)]
   [random-char (opt-> () (generator?) generator?)]
   [random-string (opt-> () (generator?) generator?)]
   [random-symbol (opt-> () (generator?) generator?)]
   [random-byte generator?]
   
   )
  
  (define (generate gen)
    ((generator-proc gen)))
  
  ;; A -> (Generator A)
  (define (nonrandom val)
    (make-generator (lambda () val)))
  
  ;; (T1 ... Tn  -> A) (Generator T1 ... (Generator Tn) -> (Generator A)  
  (define (random-apply f . gens)
    (make-generator (lambda () (apply f (map generate gens)))))
  
  
  
  (define (random-big-nat size)
    (make-generator (lambda () 
                      (generate
                       (random-choice (nonrandom size )
                                      (make-generator 
                                       (lambda () (generate (random-big-nat (+ size 1))))))))))
  
  
  (define random-size
    (opt-lambda ((min 0))
      (make-generator 
       (lambda ()
         (generate
         (random-weighted 1/4 (nonrandom min) 1/4 (nonrandom (+ 1 min))
                          1/2 (make-generator (lambda () (generate (random-big-nat (+ min 2)))))))))))
  
  (define-syntax random-recursive
    (lambda (x)
      (syntax-case x ()
        ((_ rec-gen-name (prob gen) ...)
         (with-syntax ([(a ...) (generate-temporaries (syntax (gen ...)))]) 
         (syntax  (letrec ((rec-gen-name 
                            (make-generator (lambda () (generate
                                                        (random-weighted-internal (list a ...) (list prob ...))))))
                           (a (make-generator (lambda () (generate gen)))) ...)
                    rec-gen-name)))))))
  
  ;;; :
  (define (random-function f)
    (make-generator 
     (lambda ()
       (let ((hshtbl  (make-hash-table 'equal)))
         (lambda args
           (hash-table-get hshtbl args 
                           (lambda ()
                             (let ((val (generate (apply f args))))
                               (begin 
                                 (hash-table-put! hshtbl args val)
                                 val)))))))))
      
  
  
  
  ;; : (listof (Generator T)) (listof Positive-Rational) Positive-Rational -> (Generator T)
  (define (get-gen gens weights prob)
    (if (>= 0 (- prob (car weights)))
        (car gens)
        (get-gen (cdr gens) (cdr weights) (- prob (car weights)))))
  
  (define (fold cons nil lst)
    (cond ((null? lst)
           nil)
          ((pair? lst)
           (fold cons (cons nil (car lst)) (cdr lst)))))
  
  
 ;; (list A B .... A B )->(or (listof A) (listof B))
  (define (extract lst bool)
    (cond ((null? lst)
           '())
          ((pair? lst)
           (if bool
               (cons (car lst) (extract (cdr lst) (not bool)))
               (extract (cdr lst) (not bool))))))
  
   ;; : (list Positive-Rational (Generator T1) ... Positive-Rational (Generator Tn))-> (Generator (union T1 ... Tn))
  (define (random-weighted . lst)
    (let* ((gens (extract  lst #f))
           (weights (extract lst #t)))  
      (random-weighted-internal gens weights)))
  
(define  (random-weighted-internal gens weights)
  (let ((sum (fold + 0 weights)))
  (make-generator (lambda () (generate (get-gen gens weights (* sum (random))))))))
  
  ;;(Generator T1) ... (Generator Tn) -> (Generator (union T1 ... Tn))
  (define (random-choice . gens)
    (let ((l (- (length gens) 1)))
      (make-generator (lambda ()
                        (generate (list-ref gens (generate(random-int-between 0 l))))))))
  ;; (Generator boolean)
  (define random-boolean
    (random-choice (nonrandom #t)  (nonrandom #f)))
  
  ;; (Generator A) Natural -> (Generator (listof A))
  ;; Generates a list whose length is the given natural number
  (define (random-list-of-fixed-size elem-gen size)
    (make-generator
     (lambda ()
       (if (<=  size 0)
           '()
           (generate  (random-apply cons elem-gen 
                                    (make-generator 
                                     (lambda () 
                                       (generate 
                                        (random-list-of-fixed-size elem-gen (- size 1)))))))))))
  
  
  
  ;; the largest number mzcheme can generate
  (define max-random-int  (- (expt 2 31) 2))
  

  
  ;; Integer Intger -> (Generator Integer)
  ;; Generates a random value between lo and hi, currently restricted to intervals where (hi-lo)< 2^31 -1
  (define (random-int-between  lo hi)
    (let* ((max (- hi lo)))
      (if (> max max-random-int)
          (error "you gave random-int-betwen too large an interval")
          (make-generator 
           (lambda () 
             (+ lo (random (+ max 1))))))))
  
  ;; : (Generator Nat)
  (define random-nat
    (random-int-between 0 max-random-int))
  
  
  ;; Byte = [0,255]
  ;; : (Generator Byte)
  (define random-byte
    (random-int-between 0 255))
  
  ;; : [Generator Nat] -> (Generator Char)
  (define random-char
    (opt-lambda ((code-gen (random-int-between 32 127)))
      (make-generator (lambda () (integer->char (generate code-gen))))))
  
  ;; : T ... ->(Groupof T) (Generator T) [Generator Nat] -> (Generator (Groupof T))
  (define random-uniform
    (opt-lambda (make elem-gen (len-gen (random-size)))
      (make-generator 
       (lambda () (apply make (generate (random-list-of-fixed-size elem-gen (generate len-gen))))))))
  
  
  ;; : (Generator T) [Generator Nat] -> (Listof T)
  (define random-list-of 
    (opt-lambda (elem-gen (len-gen (random-size)))
      (random-uniform list elem-gen len-gen)))
  
  
  ;; : (Generator T) [Generator Nat] -> (Vectorof T)
  (define random-vector-of
    (opt-lambda (elem-gen (len-gen (random-size)))
      (random-uniform vector elem-gen len-gen)))
  
  ;; : [Generator Char] [Generator Nat] -> (Generator String)
  (define random-string
    (opt-lambda ((char-gen (random-char))(len-gen (random-size)))
      (make-generator (lambda () 
                        (list->string (generate (random-list-of char-gen len-gen)))))))
  
  ;; : [Generator String]-> (Generator Symbol)
  (define random-symbol 
    (opt-lambda ((name-gen (random-string)))
      (make-generator (lambda () (string->symbol (generate name-gen))))))
  
  ;; : [Generator Byte] [Generator Nat] -> (Generator ByteString)
  (define random-bytes
    (opt-lambda ((byte-gen random-byte)(len-gen (random-size)))
      (random-uniform bytes byte-gen len-gen))) 
  
  ;; : (Generator T1) ...  (Generator Tn) -> Generator (List T1 ... Tn)
  (define (random-list . gens)
    (apply random-apply (cons list gens)))
  
  ;; : (Generator T1) ... (Generator Tn) -> Generator  (Vector T1 ... Tn)
  (define (random-vector . gens)
    (apply random-apply (cons vector  gens)))
  
  
  
  )