#! /usr/local/bin/guile3 \
-e main -s
!#

(use-modules (ice-9 exceptions))
(use-modules (srfi srfi-19))
(use-modules (sxml simple))
(use-modules (json))

(define guest-book-json-file "guest-book.json")
(define test-number-max 100)

(define (decode-hex hex)
  (string (integer->char
           (string->number (string-append "#x"
                                          hex)))))

;; Handle query string encoding
(define (format-query-string item)
  (letrec ((decode-query
            (lambda (value)
              (let ((index (string-index value #\%))
                    (value-length (string-length value)))
                (cond ((and index value-length)
                       (string-append (substring value 0 index)
                                      (decode-hex (substring value
                                                             (+ index 1)
                                                             (+ index 3)))
                                      (cond ((< index (- value-length 3))
                                             (decode-query
                                              (substring value
                                                         (+ index 3)
                                                         value-length)))
                                            (else ""))))
                      (else value))))))
    (decode-query (string-map (lambda (character)
                                (case character
                                  ((#\+) #\space)
                                  (else character)))
                              item))))

;; Progress form data
(define (get-form)
  (let ((query (getenv "QUERY_STRING")))
    (cond ((string= query "") #f)
          (else
           (map (lambda (item)
                  (let ((pairs (string-split item #\=)))
                    (set-cdr! pairs (format-query-string (cadr pairs)))
                    pairs))
                (string-split query #\&))))))

(define (sanitize-input value)
  (let ((output (open-output-string))
        (sanitized ""))
    (sxml->xml `(*TOP* ,value) output)
    (set! sanitized (get-output-string output))
    (close-output-port output)
    sanitized))

(define (number-to-entity number)
  (letrec ((process-digits
            (lambda (digits)
              (if (eq? digits '())
                  ""
                  (string-append "&#"
                                 (number->string (char->integer (car digits)))
                                 ";"
                                 (process-digits (cdr digits)))))))
    (process-digits (string->list (number->string number)))))

(define (write-guest-to-json name url message)
  (let ((guest-book '())
        (guest `(("name" . ,name)
                 ("url" . ,url)
                 ("message" . ,message)
                 ("date" . ,(date->string (current-date) "~B, ~d ~Y"))))
        (not-already-added #t))
    
    (if (file-exists? guest-book-json-file)
        (call-with-input-file guest-book-json-file
          (lambda (fp)
            (set! guest-book (vector->list (json->scm fp)))
            ;; Handle order thingy
            (set! guest-book (map (lambda (item)
                                    (reverse item))
                                  guest-book)))))

    ;; Guest already added.
    (letrec ((check-if-already-added
              (lambda (guests)
                (unless (eq? guests '())
                  (cond ((compare-guests 0 (car guests) guest)
                         (set! not-already-added #f))
                        (else
                         (check-if-already-added (cdr guests)))))))
             (compare-guests
              (lambda (index guest1 guest2)
                (and (string= (cdr (list-ref guest1 index))
                              (cdr (list-ref guest2 index)))
                     (cond ((< index 3)
                            (compare-guests (+ index 1) guest1 guest2))
                           (else #t))))))
      (check-if-already-added guest-book))

    ;; Add guest to guest-book
    (cond (not-already-added
           (cond ((eq? guest-book '())
                  (set! guest-book (list guest)))
                 (else
                  (append! guest-book (list guest))))

           ;; Write guest book to json
           (call-with-output-file guest-book-json-file
             (lambda (fp)
               (scm->json (list->vector guest-book) fp)))

           (display "<p>You been added to the guest book yippe (:</p>\
<img src=\"../images/yippee.gif\" alt=\"yippee!\"/>\n"))
           (else
            (display "You already been added\n")))))

(define (handle-fields)
  (let ((form (get-form)))
    (if form
        (let ((name (sanitize-input (cdr (list-ref form 0))))
              (url (sanitize-input (cdr (list-ref form 1))))
              (message (sanitize-input (cdr (list-ref form 2))))
              (answer (string->number (sanitize-input (cdr (list-ref form
                                                                     3)))))
              (first (string->number (sanitize-input (cdr (list-ref form 4)))))
              (second (string->number (sanitize-input (cdr (list-ref form
                                                                     5))))))
          (cond ((string= name "") ;; No name given
                 (display "<p>name is required</p>"))
                ((string= message "") ;; No message given
                 (display "<p>please write a silly something (:</p>"))
                ((not (= (+ first second) answer))
                 (display "<p>You suck at math lol</p>"))
                (else
                 (write-guest-to-json name url message)))))))

;; Display a guest in the guest book
(define (display-guest guest)
  (let ((date (cdr (list-ref guest 0)))
        (message (cdr (list-ref guest 1)))
        (url (cdr (list-ref guest 2)))
        (name (cdr (list-ref guest 3))))
    (format #t "  <hr />\n  <div class=\"container\">
    <b>~a</b> <a href=\"~a\" target=\"_blank\">~a</a> --- signed ~a\n\
    <div class=\"silly-something\"><p>~a</p></div>\n\
  </div>\n  <br />\n" name url url date message)))

;; Display pretty much everything
(define (display-guest-book)
  (set! *random-state* (seed->random-state (time-second (current-time))))
  (let ((first-test-number (number-to-entity (random test-number-max)))
        (second-test-number (number-to-entity (random test-number-max))))
    (format #t "Content-Type: text/html\n\n\
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n\
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\
<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n\
<head>\n\
  <title>Guest Book</title>\n\
  <link rel=\"icon\" type=\"image/x-icon\" href=\"../images/icon.png\" />
  <link rel=\"stylesheet\" type=\"text/css\" href=\"../css/guest-book.css\" />\n\
</head>\n\
<body>\n\
  <a href=\"../index.xhtml\"><img src=\"../images/back_home.png\"\n\
  alt=\"Back to home page\"/></a>\n\
  <div class=\"container\">\n\
    <h2>Sign my fucking guest book</h2>\n\
    <form action = \"guest-book.cgi\" method = \"get\">\n\
      <label for = \"name\" maxlength=\"100\">Name</label>\n\
      <input type = \"text\" name = \"name\"/>\n\
      <br />\n\
      <label for = \"url\" maxlength=\"256\">Website (Optional)\n\
      </label>\n\
      <input type = \"text\" name = \"url\"/>\n\
      <br /><br />\n\
      <label for = \"message\">Write a little silly something</label>\n\
      <br />\n\
      <textarea type = \"text\" name = \"message\" rows = \"4\"\n\
      cols = \"40\" maxlength=\"512\"></textarea>\n\
      <br /><br />\n\
      <label for = \"answer\">Answer ~a plus ~a</label>\n\
      <input type = \"number\" name = \"answer\"/>\n\
      <input type = \"hidden\" name =\"first\" value = \"~a\">\n\
      <input type = \"hidden\" name =\"second\" value = \"~a\">\n\
      <br />\n\
      <input type = \"submit\" value = \"Fucking submit\">\n\
      <b>You can't delete/edit it afterwards</b>\n\
    </form>\n\
    <p>\n\
      <b>Be nice! Dont be a fucking ass.</b>\n\
    </p>\n" first-test-number second-test-number first-test-number
    second-test-number)
    (handle-fields)
    (display "  </div>\n  <br />\n")

    ;; Try to read the guest book json
    (with-exception-handler
        (lambda (error)
          (display "  <div class=\"container\">\n\
      <p>No guest(s) have been added ): But you can be the first!</p>\n\
    </div>\n"))
      (lambda ()
        (call-with-input-file guest-book-json-file
          (lambda (fp)
            (letrec ((guest-book (json->scm fp))
                     (guest-loop
                      (lambda (index)
                        (display-guest (vector-ref guest-book index))
                        (if (> index 0)
                            (guest-loop (- index 1))))))
              (guest-loop (- (vector-length guest-book) 1))))))
      #:unwind? #t)

    (display "</body>\n</html>\n")))

(define (main args)
  (display-guest-book))