(module webpages mzscheme
  (require (lib "xml.ss" "xml") (lib "servlet.ss" "htdp"))
  (require (lib "contract.ss"))
  (provide 
   web-dialog ; (web-dialog ([(identifier ...) expression] ...) body)
   write-page ; String Xexpr -> true
   final      ; String -> true
   ul         ; (Listof X) -> Xexpr[ul]
   li         ; Xexpr -> Xexpr[li]
   table      ; (Listof (Listof X)) -> Xexpr[table]
   tr         ; Xexpr -> Xexpr[tr]
   td         ; Xexpr -> Xexpr[td]    
   )

  ;; String[file name] Xexpr -> true
  (define (write-page file x)
    (with-output-to-file file 
      (lambda () (display-xml/content (xexpr->xml x)))
      'replace)
    #t)
  
  ;; (Listof (Listof x)) -> Xexpr[table]
  (define (table t)
    `(table ,(map (lambda (row) (tr (map td row))))))
  (define (tr x) `(tr ,x))
  (define (td x) `(td ,x))
  
  ;; (Listof X) -> Xpexr[UL]
  (define (ul l) `(ul ,(map li l)))
  (define (li x) `(li ,x))
  
  ;; Symbol Bindings -> String or false
  (define (extract-one-binding s b)
    (let ([x (extract-bindings s b)])
      (if (null? x) #f (car x))))

  (define-syntax web-dialog
    (syntax-rules ()
      [(_ [] body ...) (begin body ...)]
      [(_ ([(result:var ...) page:xexpr] next ...) . body)
       (let ([b (request-bindings (send-page "query" page:xexpr))])
         (let ([result:var (extract-one-binding 'result:var b)] ...)
           (web-dialog (next ...) . body)))]
      [(_ ([result:var page:xexpr] next ...) . body)
       (let ([result:var (request-bindings (send-page "query" page:xexpr))])
         (web-dialog (next ...) . body))]))
  
  ;; String Xexpr -> Response
  (define (send-page title form-content)
    (send/suspend 
     (lambda (k)
       `(html 
         (head (title ,title)
               (form ([action ,k][method "get"]) ,form-content))))))

  (define (final msg)
    (send/finish `(html (head (title "message")) (body ,msg))))

  ;; ============================================================
  ;; HIGH-LEVEL Q&A INTERFACE
  
  (define (page q answer-html)
    (lambda (k)
      `(html (head (title "Question"))
             (div ((id "content"))
                  (form ((action ,k))
                        (p ,q) ,answer-html
                        (br)
                        (input ((type "submit"))))))))
  
  (define (q&a-page q)
    (page q '(select ((name "answer"))
                     (option "Yes")
                     (option "No"))))
    
  (define (free-page q)
    (page q '(input ((type "text") (name "answer") (cols "100")))))
  
  (provide/contract (ask-yes/no-question (string? . -> . boolean?)))
  (define (ask-yes/no-question q)
    (let* ((request (send/suspend (q&a-page q)))
           (answer (extract-one-binding 'answer (request-bindings request))))
      (string=? answer "Yes")))
  
  
  (provide/contract (ask-free-response-question (string? . -> . string?)))
  (define (ask-free-response-question q)
    (let* ((request (send/suspend (free-page q)))
           (answer (extract-one-binding 'answer (request-bindings request))))
      answer))
    
  
  
  )