;;
;; MIT License
;;
;; Copyright (c) 2018 Thomas Chust
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
;;

(import
  (chicken fixnum)
  (only (chicken blob) string->blob)
  (only (chicken time) current-seconds)
  (chicken io)
  (only (chicken port) call-with-output-string)
  (only srfi-1 break!)
  srfi-4
  (only srfi-13 string-null? string-prefix? string-join)
  tweetnacl
  lmdb
  webview
  (only webview-content write-js))

(define rng
  (open-random-stream
   (string->blob "Not a very random stream key ;-)")
   (do ([v (make-u8vector random-stream-noncebytes)]
        [n (current-seconds) (quotient n 256)]
        [i 0 (fx+ i 1)])
       ((fx>= i (u8vector-length v)) v)
     (u8vector-set! v i (modulo n 256)))))

(open-database-environment
 "fortune.mdb" #:no-subdirectory)
(define db
  (with-transaction (lambda () (open-database))))

(define-values (add-fortune! add-fortunes!)
  (letrec ([%add-fortune!
            (lambda (text)
              (database-set! db (hash text) text))]
           [add-fortune!
            (lambda (text)
              (with-transaction
               (lambda ()
                 (%add-fortune! text))))]
           [add-fortunes!
            (lambda (text)
              (with-transaction
               (lambda ()
                 (let loop ([text text] [count 0])
                   (if (pair? text)
                     (begin
                       (%add-fortune! (car text))
                       (loop (cdr text) (+ count 1)))
                     count)))))])
    (values add-fortune! add-fortunes!)))

(define (add-fortunes-file! path)
  (add-fortunes!
   (let loop ([i (call-with-input-file path read-lines)] [o '()])
     (let-values ([(h i) (break! (cut string=? <> "%") i)])
       (let ([o (if (pair? h) (cons (string-join h "\n") o) o)])
         (if (pair? i) (loop (cdr i) o) o))))))

(define (get-fortune)
  (with-transaction
   (lambda ()
     (let retry ([key (read-string hash-bytes rng)])
       (unless (and (string? key) (not (string-null? key)))
         (set! key #f))
       (or (call-with-current-continuation
             (lambda (return)
               (database-fold
                (lambda (key val seed) (return val))
                #f db #:from key)))
           (and key
                (retry (substring key 0 (fx- (string-length key) 1)))))))
   #:read-only))

(define (make-fortune)
  (cond
    [(get-fortune)
     => (cut list 'pre <>)]
    [else
     '(pre ([style "text-color: grey;"]) "(nothing found)")]))

(define (inject-fortune! view)
  (webview-style-set! view "#save" "display" "none")
  (webview-html-set! view "#fortune" (make-fortune)))

(define (inject-editor! view)
  (webview-style-set! view "#save" "display" "inline")
  (webview-html-set! view "#fortune"
   '(textarea ([cols "72"] [rows "16"] [wrap "off"] [style "font-family: monospace;"]))))

(define (make-invocation name #!optional selector)
  (call-with-output-string
   (lambda (port)
     (display "window.external.invoke(" port)
     (write-js name port)
     (when selector
       (display "+document.querySelector(" port)
       (write-js selector port)
       (display ").value" port))
     (display #\) port))))

(define (inject-app! view)
  (webview-html-set! view "#app"
   `(begin
      (div ([class "toolbar"])
        (button ([type "button"] [onclick ,(make-invocation "random")])
          "Random")
        (button ([type "button"] [onclick ,(make-invocation "add-file")])
          "Add File…")
        (button ([type "button"] [onclick ,(make-invocation "edit")])
          "New…")
        (button ([type "button"] [onclick ,(make-invocation "save:" "#fortune textarea")]
                 [id "save"] [style "display: none;"])
          "Save"))
      (div ([class "content"])
        (code ([id "fortune"])
          ,(make-fortune))))))

(define (on-add-file view)
  (and-let* ([p (webview-dialog view "Add File" #:open)]
             [n (add-fortunes-file! p)])
    (webview-dialog
     view "Add File" #:info
     (string-append (number->string n) " fortunes added"))))

(webview
 "Fortune"
 (lambda (view msg)
   (cond
     [(string=? "load" msg)
      (inject-app! view)]
     [(string=? "random" msg)
      (inject-fortune! view)]
     [(string=? "add-file" msg)
      (on-add-file view)]
     [(string=? "edit" msg)
      (inject-editor! view)]
     [(string-prefix? "save:" msg)
      (add-fortune! (substring msg 5))
      (inject-fortune! view)]
     [else
      (webview-log (string-append "Unknown Message: " msg))]))
 #:width 640 #:height 320)

(close-database-environment)

;; vim: set ai et ts=4 sts=2 sw=2 ft=scheme: ;;