(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken irregex))
(import (chicken io))
(import (chicken port))
(import (chicken process))
(import (chicken sort))
(import (chicken string))
(import (chicken time posix))
(import (srfi 1))
(import html-parser)
(import hyde)
(import (hyde atom))
(import medea)
(import sxml-serializer)
(import sxpath)

(pathify-forbidden-chars '(submatch (+ (~ alphanum #\- #\space))))

(define-values (server-in server-out server-pid)
  (process "python" '("rstserver.py")))

(define (send-command! command)
  (write-json command server-out)
  (newline server-out)
  (flush-output server-out))

(define (translate-rst-string str slug)
  (send-command! `((command . "translate")
                   (string . ,str)
                   (slug . ,slug)))
  (read-json (read-line server-in)))

(define (close-server!)
  (when (output-port-open? server-out)
    (send-command! '((command . "quit")))
    (close-output-port server-out))
  (when (input-port-open? server-in)
    (close-input-port server-in)))

(on-exit close-server!)

(define (translate-rst #!optional (in (current-input-port)))
  (let* ((meta (page-vars (current-page)))
         (slug (and-let* ((title (alist-ref 'title meta)))
                 (pathify title)))
         (json (translate-rst-string (read-string #f in) slug))
         (rst (alist-ref 'output json))
         (dom (call-with-input-string rst html->sxml))
         (html (serialize-sxml ((sxpath "//body/div/node()") dom) indent: #f)))
    (display html)))

(on-exit close-server!)

(translators (cons (list "rst" translate-rst) (translators)))

(define post-regex '(: "posts/" (+ any) ".rst"))
(define page-regex '(: (+ any) (or ".rst" ".sxml")))

(default-page-vars `((,post-regex (layouts "post.sxml" "default.sxml"))
                     (,page-regex (layouts "page.sxml" "default.sxml"))))

(define $ (environment-ref (page-eval-env) '$))

(define (filter-posts #!optional tag)
  (filter (lambda (page)
            (and (irregex-match post-regex (car page))
                 (if tag
                     ($ tag (cdr page))
                     #t)))
          (pages)))

(define (sort-by-date posts)
  (sort posts (lambda (a b) (string>=? ($ 'date (cdr a))
                                       ($ 'date (cdr b))))))

(define (all-posts #!optional tag)
  (map cdr (sort-by-date (filter-posts tag))))

(define max-posts 5)

(define (latest-posts #!optional tag)
  (let ((posts (all-posts tag)))
    (if (<= (length posts) max-posts)
        posts
        (take posts max-posts))))

;; helpers

(define (pretty-date date)
  (time->string (string->time date "%Y-%m-%d %H:%M:%S") "%d/%m/%Y"))

(define (archive-date date)
  (time->string (string->time date "%Y-%m-%d %H:%M:%S") "%Y-%m-%d"))

(define (post-url post)
  (format "/posts/~a.html" (pathify ($ 'title post))))