(define-module (bitter)
  #:use-module (bits)
  #:use-module (sxml simple)
  #:use-module (web request)
  #:use-module (web uri)
  #:use-module (rnrs bytevectors)
  #:export (bitter-handler))

(define (load-bits)
  (catch #t
    (lambda ()
      (let ((v (with-input-from-file "bitter.bits" read)))
        (make-bits v (bitvector-length v))))
    (lambda _
      (with-output-to-file "bitter.bits" (lambda () (write #*)))
      (empty-bits))))

(define *bits* (load-bits))

(define *out-port* (open-file "bitter.bits" "a"))

(define (show-bits)
  `(html
    (head (title "Are you bitter about it?")
          (style (@ (type "text/css"))
            "body { background: #aaaacc; margin: 3em 25% 3em 25%"))
    (body (h1 "Are you bitter about it?")
          (h2 "Well, are you?")
          (form (@ (action "/")
                   (method "POST"))
                (p "Well " (input (@ (type "submit")
                                    (name "v")
                                    (value "yes")) ", yes I am."))
                (p (input (@ (type "submit")
                             (name "v")
                             (value "No")) ", why would I be bitter about it?")))
          (h2 "Recent bits")
          ,@(let ((start (max (- (bits-len *bits*) 10) 0)))
              (map (lambda (n)
                     (let ((m (- (bits-len *bits*) n 1)))
                       `(p ,(if (bitvector-ref (bits-vector *bits*) m) "1" "0"))))
                   (iota (- (bits-len *bits*) start))))
          (h3 "Bit counter")
          (p ,(bit-count #t (bits-vector *bits*)) "/" ,(bits-len *bits*))
          (h3 "About")
          (p "Because "
             (a (@ (href "http://twitter.com/#!/mattmight/status/129231818984660992"))
                "shorter " (i "is") " better") ".")
          (h3 "Colophon")
          (p "Download "
             (a (@ (href "http://wingolog.org/pub/bitter.scm")) "bitter.scm")
             " and "
             (a (@ (href "http://wingolog.org/pub/bits.scm")) "bits.scm")
             " into a directory, then run " (code "guile -L /path/to/dir") ".")
          (p "Then " (code "(use-modules (bitter) (web server))") ", then "
             (code "(run-server bitter-handler)") ".")
          (p "Part of a talk by Andy Wingo on "
             (a (@ (href "http://gnu.org/s/guile/")) "Guile")
             " at " (a (@ (href "http://fscons.org/2011/")) "FSCONS")
             " 2011.  "
             (a (@ (href "http://wingolog.org/pub/fscons-2011-slides.pdf")) "Slides")
             " and "
             (a (@ (href "http://wingolog.org/pub/fscons-2011-notes.pdf")) "notes")
             " available."))))

(define (post-bit! b)
  (add-bit! *bits* b)
  (display (if b "1" "0") *out-port*)
  (show-bits))

(define (sxml->string sxml)
  (with-output-to-string (lambda () (sxml->xml sxml))))

(define (bitter-handler request request-body)
  (values
   '((content-type . (text/html)))
   (sxml->string
    (case (request-method request)
      ((GET) (show-bits))
      ((POST)
       (post-bit! (equal? (utf8->string request-body) "v=yes")))))))