(require 2htdp/batch-io)

;; VERSION 6

;; purpose: creating quizzes concerning template development 
;; use: (generate-quiz n) where n is some natural nunber 
;; language: ISL

;; known bugs:
;; -- on occasion the same field name shows up more than once in a struct type definition

;; ---------------------------------------------------------------------------------------------------

;; Nat -> String 
;; generate a quiz with one struct type definition of n fields 
;; no need to test this; it composes well-tested random functions 
(define (generate-quiz n)
  (local (;; --- generate random structure type definitions and instances 
          (define def-name (string-append "C" (random-pick NAMES)))
          (define struct-type-def1 (generate-struct-type n))
          (define struct-type-def2 (generate-struct-type 1))
          (define instance1 (instantiate def-name struct-type-def1))
          (define instance2 (instantiate def-name struct-type-def2))
          ;; --- use the above to fill the quiz schema and turn the result into a string 
          (define quiz-as-list 
            (quiz-template struct-type-def1 struct-type-def2 def-name instance1 instance2))
          (define quiz-as-string
            (string-join (map nested-list-string quiz-as-list) "\n")))
    ;; --- now write beautiful prose 
    (write-file 'stdout quiz-as-string)))

;; ---------------------------------------------------------------------------------------------------
;; StructTypeDef is one of: 
;; -- "cons"
;; -- (cons Name [List-of Name])
;; Name is String
;;
;; Instance is (cons Name [List-of Name])
;; 
;; String* is one of: 
;; -- String 
;; -- [List-of String*]

;; StructTypeDef StructTypeDef Name Instance Instance -> [List-of [List-of String] u String]
;; fill the quiz template with proper struct type definitions and instances 
;; in a sense, this is just a fancy construction of a constant but it's worth making sure 
;; it always constructs some constant with a silly test or two 

(check-expect
 (cons? (quiz-template '("a" "b") '("c" "d") "Cx" "done" '("make-a" "Number" "Number"))) 
 true)
(check-expect
 (cons? (quiz-template "cons" '("c" "d") "Cx" '("cons" "Number" "Cx") "done"))
 true)

(define (quiz-template struct-type-def1 struct-type-def2 def-name instance instance2)
  `((,(render-struct-type-def struct-type-def1))
    (,(render-struct-type-def struct-type-def2))
    ("A " ,def-name " is one of:")
    ("--" ,(if (and (string? struct-type-def1) (recursive-list-def? def-name instance))
               "empty"
               (stringify (random-pick (cons instance2 NAMES)))))
    ("--" ,instance)
    ()
    ("Develop a template for " ,def-name)
    ("You may wish to create examples first.")
    ()
    ("YOU HAVE THREE MINUTES")))

;; Nat -> StructTypeDef 
;; generate a struct type def with n fields 
(define (generate-struct-type n)
  (local (;; ANY -> String 
          (define (generate-field-name i) (random-pick NAMES))
          (define field-names (build-list n generate-field-name))
          (define struct-name (random-pick NAMES)))
    (if (and (= n 2) (<= (random 100) 80)) ;; biased coin 
        "cons"
        (cons struct-name field-names))))

;; WHERE TESTS ARE 

;; Any -> Boolean 
;; is the given value an instance of StructTypeDef? 
(define (struct-type-def-basics? lon)
  (or (string? lon) (and (cons? lon) (andmap string? lon))))

(check-expect (struct-type-def-basics? (generate-struct-type 1)) true)
(check-expect (struct-type-def-basics? (generate-struct-type 2)) true)
(check-expect (struct-type-def-basics? (generate-struct-type 3)) true)

;; Name StructTypeDef -> Instance 
;; instantiate a struct type def for a line in a data def 
(define (instantiate dn sdt)
  (local (;; ANY -> Name
          (define (data-def-name i)
            (random-pick (cons dn DDNAMES))))
    (if (string? sdt)
        (list "cons" (data-def-name 1)(random-pick (list dn "empty")))
        (local ((define sdt-name (first sdt))
                (define sdt-fields (rest sdt))
                (define constructor (string-append "make-" sdt-name)))
          (cons constructor (map data-def-name sdt-fields))))))

;; WHERE TESTS ARE 

;; String Instance -> Boolean 
;; is the given instance using allowed names of data collections? 
(define (names-of-data-collections? n lon)
  (local (;; String -> Boolean 
          (define (allowed-name k)
            (not (or (string=? k n) (member k DDNAMES))))
          (define not-allowed-name (filter allowed-name lon)))
    (or (empty? not-allowed-name)
        (error (string-append "not allowed: " (first not-allowed-name))))))

(check-expect (first (instantiate "CX" '"cons")) "cons")
(check-expect (names-of-data-collections? "CX" (rest (instantiate "CX" "cons"))) true)
(check-expect (length (instantiate "CX" '"cons")) 3)
(check-expect (first (instantiate "CX" '("a" "b" "c"))) "make-a")
(check-expect (length (instantiate "CX" '("a" "b" "c"))) 3)
(check-expect (names-of-data-collections? "CX" (rest (instantiate "CX" '("a" "b" "c")))) true)

;; Instance -> Boolean 
;; does the instance specify a recursive use of cons? 
(check-expect (recursive-list-def? "CX" '("cons" "CX" "empty")) false)
(check-expect (recursive-list-def? "CX" '("cons" "empty" "CX")) true)
(define (recursive-list-def? dn instance)
  (and (string=? (first instance) "cons")
       (string=? (third instance) dn)))

;; ---------------------------------------------------------------------------------------------------
;; StructTypeDef -> (list 'define-struct Name [List-of Name])
;; render a struct type def as a list
(check-expect (render-struct-type-def '("a" "b"))
              '("define-struct" "a" ("b")))
(define (render-struct-type-def std)
  (if (string? std)
      '()
      `("define-struct" ,(first std) ,(rest std))))

;; String* -> String
;; turn a nested list into a parenthesized string 
(check-expect (nested-list-string '("hello" ("world") "bye"))
              "hello (world) bye")
(define (nested-list-string l)
  (local ((define (one-item l)
            (cond
              [(string? l) l]
              [(list? l) (string-append "(" (string-join (map one-item l) " ") ")")])))
    (string-join (map one-item l) " ")))

;; [Either-or String X] -> [Either-or String X]
(check-expect (stringify "empty") "empty")
(check-expect (stringify "a") "\"a\"")
(check-expect (stringify (list "a")) (list "a"))
(define (stringify s)
  (cond
    [(string? s) (if (string=? "empty" s) s (string-append "\"" s "\""))]
    [else s]))

;; ---------------------------------------------------------------------------------------------------
;; the names we use for now

;; names allowed as built-in collections of data 
(define DDNAMES 
  '("empty"
    "Number"
    "String"
    "Image"
    "Symbol"
    "Boolean"))

;; words useful for constructors and fields 
(define NAMES
  '("a"
    "b"
    "c"
    "city"
    "zip"
    "other"
    "strings"
    "done"
    "world"
    "hello"
    "whatever"
    "zip"
    "other"
    "strings"))


;; ---------------------------------------------------------------------------------------------------
;; library function reimplemented 

;; [List-of String] String -> String 
;; adjoin strings in los with s in between 
(check-expect (string-join '("a" "b" "c") " ") "a b c")
(check-expect (string-join '() " ") "")
(define (string-join los s)
  (local ((define (string-join los)
            (cond
              [(empty? los) ""]
              [else (string-append s (first los) (string-join (rest los)))])))
    (cond
      [(empty? los) ""]
      [else (string-append (first los) (string-join (rest los)))])))

;; [List-of X] -> X 
;; pick a random item from the given list 
(check-expect (member (random-pick '(a b c)) '(a b c)) true)
(define (random-pick l)
  (list-ref l (random (length l))))