webview

;;
;; 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)
  (chicken io)
  (only (chicken blob) string->blob)
  (only (chicken time) current-seconds)
  (only srfi-1 break!)
  (only srfi-13 string-null? string-prefix? string-join)
  srfi-4
  tweetnacl
  lmdb
  webview)

(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 (render-fortune)
  (cond
    [(get-fortune)
     => (cut list 'pre <>)]
    [else
     '(pre ([style "text-color: grey;"]) "(nothing found)")]))

(define (inject-fortune view)
  (webview-eval view "document.getElementById('save').style.setProperty('display','none')")
  (webview-inject view "fortune" (render-fortune)))

(define (inject-editor view)
  (webview-eval view "document.getElementById('save').style.setProperty('display','inline')")
  (webview-inject view "fortune"
   '(textarea ([cols "72"] [rows "16"] [wrap "off"])
      "")))

(define (render-app)
  `(begin
     (div ([class "toolbar"])
       (button ([type "click"] [onclick "external.invoke('random')"])
         "Random")
       (button ([type "click"] [onclick "external.invoke('add-file')"])
         "Add File…")
       (button ([type "click"] [onclick "external.invoke('edit')"])
         "New…")
       (button ([type "click"] [id "save"] [onclick "external.invoke('save:' + document.getElementById('fortune').getElementsByTagName('textarea')[0].value)"] [style "display: none;"])
         "Save"))
     (div ([class "content"])
       (code ([id "fortune"])
         ,(render-fortune)))))

(define (inject-app view)
  (webview-inject view "app" (render-app)))

(webview
 "Fortune"
 (lambda (view msg)
   (cond
     [(string=? "load" msg)
      (inject-app view)]
     [(string=? "random" msg)
      (inject-fortune view)]
     [(string=? "add-file" msg)
      (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")))]
     [(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: ;;