(import scheme)
(import (chicken base))
(import (chicken condition))
(import (chicken file))
(import (chicken format))
(import (chicken io))
(import (chicken pathname))
(import (chicken port))
(import (chicken platform))
(import (chicken pretty-print))
(import (chicken process-context))
(import (chicken random))
(import (chicken string))
(import (srfi 1))
(import (srfi 18))
(import intarweb)
(import matchable)
(import medea)
(import scsh-process)
(import spiffy)
(import ssax)
(import sxpath)
(import sxml-transforms)
(import uri-common)
(import webview)
(import webview-content)

(define str string-append)

;;; sxml helpers

(define (strip-namespaces sxml)
  (pre-post-order*
   sxml
   `((*text* . ,(lambda (_ str) str))
     (*default* . ,(lambda (tag elements)
                     (if (namespaced-tag? tag)
                         (cons (strip-namespace tag) elements)
                         (cons tag elements)))))))

(define (xml->sxml filename)
  (condition-case
   (with-input-from-file filename
     ;; TODO: figure out namespace URLs
     ;; TODO: strip ns by passing `((#f . ,ns-url))
     (lambda () (ssax:xml->sxml (current-input-port) '())))
   ((exn ssax) #f)))

(define (parse-xml filename)
  (and-let* ((sxml (xml->sxml filename)))
    (strip-namespaces sxml)))

(define (namespaced-tag? tag)
  (let ((name (symbol->string tag)))
    (substring-index ":" name)))

(define (strip-namespace tag)
  (let ((name (symbol->string tag)))
    (string->symbol (last (string-split name ":")))))

(define (non-blank-string string)
  (if (not (equal? string ""))
      string
      #f))

;;; epub preprocessing

(define (unzip-epub directory filename)
  (receive (exit-code status _pid)
     (run (unzip -d ,directory ,filename) (= 2 1) (> "/dev/null"))
   (and status (zero? exit-code))))

(define (file-contents filename)
  (with-input-from-file filename read-string))

(define (mimetype-valid? directory)
  (let ((filename (make-pathname directory "mimetype")))
    (and (file-exists? filename)
         (equal? (file-contents filename) "application/epub+zip"))))

(define (container-file directory)
  (make-pathname directory "META-INF/container.xml"))

(define (container-content-file sxml)
  ((sxpath "string(/container/rootfiles
                   /rootfile[@media-type='application/oebps-package+xml']
                   /@full-path)") sxml))

(define (container-valid? directory)
  (and-let* ((filename (container-file directory))
             ((file-exists? filename))
             (sxml (strip-namespaces (parse-xml filename)))
             (content-file (non-blank-string (container-content-file sxml)))
             ((file-exists? (make-pathname directory content-file))))
    #t))

(define (epub-valid? directory)
  (and (mimetype-valid? directory)
       (container-valid? directory)))

(define (content-manifest sxml)
  (map (lambda (item)
         (let ((id ((sxpath "string(/@id)") item))
               (source ((sxpath "string(/@href)") item)))
           (cons (string->symbol id) source)))
       ((sxpath "/package/manifest/item") sxml)))

(define (content-spine sxml)
  (map
   (lambda (item)
     (string->symbol ((sxpath "string(/@idref)") item)))
   ((sxpath "/package/spine/itemref") sxml)))

(define (content-files sxml)
  (let ((manifest (content-manifest sxml))
        (spine (content-spine sxml)))
    (map (lambda (item) (alist-ref item manifest))
         spine)))

(define (epub-documents directory)
  (let* ((sxml (parse-xml (container-file directory)))
         (content-file (make-pathname directory (container-content-file sxml)))
         (sxml (parse-xml content-file)))
    (content-files sxml)))

(define (clean-up directory)
  (when (file-exists? directory)
    (delete-directory directory #t)))

;;; last places

(define last-places (make-parameter '()))

(define (last-place filename)
  (and-let* ((place (alist-ref filename (last-places) equal?)))
    (list->vector place)))

(define (last-places-file)
  (let ((data-home (get-environment-variable "XDG_DATA_HOME")))
    (if (and data-home (equal? (string-ref data-home 0) #\/))
        (make-pathname data-home "/teapub/last_places")
        (make-pathname (get-environment-variable "HOME")
                       "/.local/share/teapub/last_places"))))

(define (load-last-places)
  (when (file-exists? (last-places-file))
    (let ((places (with-input-from-file (last-places-file) read)))
      (last-places places))))

(define (dump-last-places)
  (let ((base-directory (pathname-directory (last-places-file))))
    (when (not (file-exists? base-directory))
      (create-directory base-directory #t)))
  (with-output-to-file (last-places-file)
    (lambda () (pp (last-places)))))

(define (add-to-last-places index scroll-top)
  (last-places (alist-update (epub-filename)
                             (list index scroll-top)
                             (last-places)
                             equal?)))

;;; dev server

(define (random-integer from to)
  (+ (pseudo-random-integer (- to from)) from))

(define (random-ephemeral-port) (random-integer 49152 65536))

(define dev-server-port (random-ephemeral-port))

(define (start-spiffy! resources-dir documents-dir)
  (define (send-file-from dir dirs)
    (parameterize ((root-path dir))
      (send-static-file (if (null? dirs)
                            "index.html"
                            (string-intersperse dirs "/")))))
  (vhost-map `((".*" . ,(lambda (continue)
                          (match (uri-path (request-uri (current-request)))
                            ((/ "resources" . dirs)
                             (send-file-from resources-dir dirs))
                            ((/ "documents" . dirs)
                             (send-file-from documents-dir dirs))
                            (_ (continue)))))))
  (let loop ()
    (condition-case (start-server port: dev-server-port)
      ((exn i/o net)
       (set! dev-server-port (random-ephemeral-port))
       (loop))
      (e (exn) (print e)))))

;;; webview

(define (user-stylesheet-file)
  (let ((config-home (get-environment-variable "XDG_CONFIG_HOME")))
    (if (and config-home (equal? (string-ref config-home 0) #\/))
        (make-pathname config-home "/teapub/style.css")
        (make-pathname (get-environment-variable "HOME")
                       "/.config/teapub/style.css"))))

(define documents (make-parameter #()))
(define epub-filename (make-parameter #f))
(define user-stylesheet (make-parameter #f))

(define (js-escape x)
  (call-with-output-string
   (lambda (out)
     (write-js (->string x) out))))

(define (message-callback view message)
  (match (string-split message ":")
    (("load")
     (print "Loading...")
     (webview-eval view (str "window.external.init("
                             (js-escape
                              (json->string
                               `((documents . ,(documents))
                                 (stylesheet . ,(user-stylesheet))
                                 (lastPlace . ,(last-place (epub-filename))))))
                             ")")))
    (("quit" index scroll-top)
     (add-to-last-places (string->number index) (string->number scroll-top))
     (webview-terminate! view))
    (_ (print "Unknown: " message))))

(define (open-webview! url)
  (webview "" message-callback url: url debug?: #t yield!: 0.005))

;;; CLI

(define (extend-exception-handler thunk)
  (let ((original-handler (current-exception-handler)))
    (lambda (exception)
      (thunk)
      (original-handler exception))))

(define (print-error . args)
  (with-output-to-port (current-error-port)
    (lambda () (apply print args))))

(define (resources-directory)
  (if (get-environment-variable "DEBUG")
      (make-pathname (current-directory) "teapub-resources")
      (make-pathname (chicken-home) "teapub-resources")))

(define (main)
  (define (file-url path) (string-append "file://" path))
  (define (dev-server-url paths)
    (uri->string (update-uri (uri-reference "http://localhost")
                             port: dev-server-port
                             path: paths)))
  (when (not (= (length (command-line-arguments)) 1))
    (print-error "No filename specified")
    (exit 1))
  (let* ((directory (create-temporary-directory))
         (filename (car (command-line-arguments)))
         (status (unzip-epub directory filename))
         (clean-up-thunk (lambda () (clean-up directory))))
    (on-exit clean-up-thunk)
    (extend-exception-handler clean-up-thunk)

    (when (not status)
      (print-error "Could not extract archive")
      (exit 1))
    (when (not (epub-valid? directory))
      (print-error "Invalid EPUB file")
      (exit 1))

    (epub-filename (pathname-strip-directory filename))
    (load-last-places)
    (when (file-exists? (user-stylesheet-file))
      (user-stylesheet (file-contents (user-stylesheet-file))))
    (documents (list->vector (epub-documents directory)))

    (thread-start!
     (make-thread
      (lambda ()
        (start-spiffy! (resources-directory) directory))))
    (open-webview! (dev-server-url '(/ "resources" "index.html")))

    (dump-last-places)))

(main)