#lang scheme/base

;; Represent an indexable ramblings file as a reactive value (RV).

;; Parsing is done in two steps:
;;   1. parse all headers
;;   2. parse body when needed

;; Question: what should be lazy?
;; There seem to be only 2 important parts to cache:
;;   - the initial parse (indexing).  
;;   - the tex rendering
;;
;; In diagram form, only 3 kinds of nodes.
;;        [ TXT ] -> [ ARTICLES ]  -> out
;;                                 -> [ PNG ] -> out
;;   TXT:      The file node, invalidated by the FAM daemon
;;   ARTICLES: Indexed (segmented) file.  Can serve raw text to output:
;;             we don't cache normal xhtml results.
;;   PNG:      Tex rendering takes some time and produces multiple pages, so
;;             it's also cached.


(require
 scheme/dict
 scheme/match
 scheme/list
 web-server/dispatch
 web-server/http/request-structs
 net/url
 (planet zwizwa/lib/memo)
 (planet zwizwa/lib/rv)
 (planet zwizwa/lib/rv-file)
 "entry-index.ss"  ;; pure parsing functions
 "sweb.ss"
 "latex.ss"
 "entry-tex.ss"
 "entry-format.ss"
 "facade.ss"     ;; wrappers for web server functions
 "style.ss"
 )

(provide (all-defined-out))


;; Create a section database from a directory.
;; FIXME: This is still static.  When files appear or disappear,
;; nothing gets updated.
(define (dir-to-db dir)
  (define (file->name file)
    (string->symbol
     (car (regexp-split #rx"\\.txt"
                        (path->string file)))))
  (define (path->blurb path)
    (with-handlers ((exn:fail:filesystem? (lambda _ #f)))
      (with-input-from-file path
        (lambda () (read-line)))))
  (printf "dir: ~a\n" dir)
  (let*
      ((files  (directory-list dir))
       (names  (map file->name files))
       (paths  (for/list ((f files)) (build-path dir f)))
       (blurbs (map path->blurb paths)))
    (for/list ((n names)
               (p paths)
               (b blurbs)
               #:when b)
      (list n p b))))



;; Curried version of rv-apply
(define (rv-lift fn)
  (lambda rvs (rv-apply fn rvs)))

(define (rv-ramblings absfile section)
  (rv-app
   (lambda (filename)
     (printf "parsing: ~a\n" filename)
     (parse-ramblings filename section))
   (rv-file absfile)))

(define (db->sections db)
  (for/list (((k v) (in-dict db)))
    (cons k (memo (compose
                   (rv-lift format-article)
                   (rv-dict (rv-ramblings (car v) k)))))))


;; DB Storage.
(define *db*       (dir-to-db (sweb-file "txt")))
(define *sections* (db->sections *db*))

(define *banlist*
  (with-handlers ((void (lambda _ '())))
    (let ((bl (read (open-input-file (sweb-file "banlist")))))
      (printf "banlist: ~a\n" bl)
      bl)))

;; Used in `ramblings-file'.  Extracted here for manual debugging.
(define (article sid aid)
  (rv-force ((dict-ref *sections* sid) aid)))

;; Get all Index->ID maps.  (Index is parsed from Date in parse-article)
;; This operation is not cached as it's straightforward to recompute.
(define (index-ids-unsorted)
  (apply append
         (for/list (((section get-article)
                     (in-dict *sections*)))
           (let ((contents (rv-force (get-article 'contents))))
             (for/list (((index val)
                         (in-dict (dict-ref contents 'IndexIDs))))
               ;; Tag with section name
               (list* index section val))))))
                     
(define (index-ids)
  (sort (index-ids-unsorted)
        string>?
        #:key (compose symbol->string car)))

;; I always forget where thes are..
(define (map* fn lst)
  (map (lambda (el) (apply fn el)) lst))
         

;; Generate recent page.
(define (ramblings-recent req . _)
  (define query-dict (url-query (request-uri req)))
  (define per-page (string->number (dict-ref query-dict 'size "10")))
  `(html
    (pre
     ,@(apply append
              (map* (lambda (index section id entry)
                      `((a ((href ,(format "~a/~a" section id)))
                           ,(format "~a" index))
                        " "
                        (a ((href ,(format "~a" section)))
                           ,(format "[~a]" section))
                        " "
                        ,(format "~a" entry)
                        "\n"))
                    (take (index-ids) per-page))))))

(define (topic-in-index? t)
  (not (memq (string->symbol t) *banlist*)))
  

;; Create the topics page from the database.
(define (ramblings-topics . _)
  (define (padding len str)
    (build-list (- len (string-length str)) (lambda _ " ")))
  (let* ((db (sort 
              (for/list ((d *db*))
                (cons (symbol->string (car d)) (cdr d)))
              string-ci<=?
              #:key car))
         (topics (map car db))
         (descs  (map caddr db))
         (width  (apply max (map string-length topics))))

    (style
        #:body
      `((pre
         ;; "ramblings "
         ,@(apply append
                  (for/list ((topic topics)
                             (desc  descs))
                    (if (topic-in-index? topic)
                        `(,@(padding width topic)
                          "["
                          (a ((href ,(format "~a" topic))) 
                             ,(format "~a" topic))
                          "] "
                          ,desc
                          "\n")
                        '()))))))))



(define (without-error-response thunk)
  (with-handlers ((void (lambda _
                          (not-found))))
    (thunk)))

;; Use `with-error-response' for the stacktrace,
;; `without-error-response' for the 404.

(define (ramblings-file req sid [str-aid "contents"])
  (without-error-response
   (lambda ()
     (let-values (((aid fmt) (aid/fmt str-aid)))
       (let* ((article-node (article sid aid))
              (query-dict (url-query (request-uri req)))
              (fmt-dict (if fmt `((format . ,(symbol->string fmt))) '())))
         (query-formatted-article article-node
                                  (append fmt-dict
                                          query-dict)))))))
(define (ramblings-subdir req db)
  (redirect-to (format "~a/" db)))


;; Quick hack: solve somewhere else.
(define (responsify fn)
  (lambda args
    (let ((out (apply fn args)))
      (if (pair? out)
          (response/xexpr
           #:preamble #"<!DOCTYPE html>"
           out)
          out))))


(define-values
  (ramblings-dispatch ramblings-url)
  (dispatch-rules
   [("ramblings.ss" "recent")                  (responsify ramblings-recent)]
   [("ramblings.ss" "topics")                  (responsify ramblings-topics)]
   [("ramblings.ss" (symbol-arg) "")           (responsify ramblings-file)]
   [("ramblings.ss" (symbol-arg) (string-arg)) (responsify ramblings-file)]
   [("ramblings.ss" (symbol-arg))              (responsify ramblings-subdir)]
   [else (lambda (x)
           (printf "~a\n" (req->strings x))
           (not-found))]))