(import (chicken base)
	utf8
	spiffy
	nrepl
	srfi-18
	(chicken file)
	(chicken io)
	(chicken port)
	(chicken format)
	(chicken pretty-print)
	lowdown
	sxml-transforms
	matchable
	(chicken irregex)
	shell
	srfi-13
	intarweb
	html-parser)

(define (pipe x . fns)
  (match fns
    [() x]
    [(fn . rest) (apply pipe (fn x) rest)]))

;; Convenience macro (@ expr ...) that expands to (lambda (x) (expr ... x))
(define-syntax @
  (syntax-rules ()
    ((_ fn-body expr ...)
     (lambda (x) (fn-body expr ... x)))))

(define (replace from to str)
  (irregex-replace/all from str to))

(define (html-unescape html)
  (pipe html
	(@ replace """ "\"")
	(@ replace "'" "'")
	(@ replace "&" "&")
	(@ replace "&lt;" "<")
	(@ replace "&gt;" ">")))

(define (highlight ext code)
  (define tmp-file-path (create-temporary-file ext))
  (with-output-to-file tmp-file-path
    (lambda () (display code)))
  (define result (capture ,(format "highlight ~A -O html -f" tmp-file-path)))
  (delete-file tmp-file-path)
  result)

(define (replace-code-block content return)
  (define irx (irregex "^%lang (\\S+)%\\n?" 's))
  (define lang-match
    (irregex-search irx content))
  (if (not lang-match)
      (return content))

  (define lang
    (irregex-match-substring lang-match 1))

  (pipe content
	(@ replace irx "")
	(@ html-unescape)
	(@ highlight lang)
	(@ string-trim-both)))

(define (convert-md-to-html filepath)
  (with-output-to-string
    (lambda () (markdown->html (open-input-file filepath)))))

(define (highlight-code-blocks html)
  (define (highlight-match m)
    (format "<code>~A</code>"
	    (call/cc (@ replace-code-block (irregex-match-substring m 1)))))

  (irregex-replace/all (irregex "<code>(.*?)</code>" 's) html
		       highlight-match))

(define (insert-to-page-tmpl tmpl-path html)
  (format (read-string #f (open-input-file tmpl-path))
	  html))

(define (app c)
  (define html-text
    (pipe "article.md"
	  (@ convert-md-to-html)
	  (@ highlight-code-blocks)
	  (@ insert-to-page-tmpl "index.html")))

  (send-response body: html-text
		 headers: '((content-type #(text/html ((charset . utf-8)))))))

(thread-start!
 (lambda ()
   (print "starting nrepl on port 1234")
   (nrepl-prompt (lambda () (display "#;0> ")))
   (nrepl 1234)))

(vhost-map `((".*" . ,(lambda (c) (app c)))))

(start-server)