;;; wikme --- build a static wiki out of a folder of markdown files

(import (cmark)
        (srfi-152)
        (utf8)
        (chicken irregex)
        (chicken port)
        (chicken string))


;;; Configuration

(define site-config
  (make-parameter `((base-url . "https://www.example.com")
                    ;; These default directories aren't .. great.
                    (source-dir . "src")
                    (output-dir . "out")
                    (transformers . ,(list commonmark->html
                                           wikify-links))
                    (filename-transform
                     . (lambda (fname)
                         (md->index-html fname)))
                    (page-environment
                     . ((title
                         . ,(lambda (page)
                              (cdr (assq 'title (page-meta page)))))
                        (body
                         . ,(lambda (page)
                              (page-body page)))
                        (last_updated
                         . ,(lambda (page)
                              (cdr (assq 'last-updated (page-meta page))))))))))

(define (config-get x)
  (if (assq x (site-config))
      (cdr (assq x (site-config)))
      #f))


;;; Templates

(define (render template env)
  ;;; Render TEMPLATE using ENV.
  ;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value
  ;; pairs to insert into the TEMPLATE's placeholders.
  (string-substitute* template (env->replacements env)))

(define (env->replacements env)
  ;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...).
  ;; X's are template variables and Y's are the values of those variables.  In
  ;; the template, both "{{X}}" and "{{ X }}" will be replaced.
  ;; If Y is a thunk, call it.
  (let loop ((env env)
             (res '()))
    (if (null? env)
        res
        (let* ((this (car env))
               (rest (cdr env))
               (key (->string (car this)))
               (val (if (procedure? (cdr this))
                        ((cdr this))
                        (->string (cdr this)))))
          (loop (cdr env)
                (append (list (cons (string-append "{{" key "}}") val)
                              (cons (string-append "{{ " key " }}") val))
                        env))))))


;;; Wiki links

(define wiki-link-sre
  ;;; An SRE for [[wiki-style links|with optional titles]].
  '(: "[["
      (submatch-named page (+ (~ "|")))
      (? (submatch "|" (submatch-named title (*? nonl))))
      "]]"))

(define (wikify-links text)
  ;;; Convert [[Wiki-style links]] to HTML style in TEXT.
  (irregex-replace/all wiki-link-sre text
                       (lambda (m)
                         (let* ((page (irregex-match-substring m 'page))
                                (title (or (irregex-match-substring m 'title)
                                           page)))
                           (string-append
                            "<a href=\"" (linkify page) "\">" title "</a>")))))

(define (linkify pagename)
  ;;; Turn a page name into a link suitable for an <a> tag.
  (string-append (base-url) "/" (slugify pagename) "/index.html"))

(define (string-capitalize str)
  ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase.
  ;; Stolen and adapted from MIT/GNU Scheme
  (let* ((end (string-length str))
         (str* (make-string end)))
    (do ((i 0 (+ i 1)))
        ((= i end))
      (string-set! str* i ((if (= i 0) char-upcase char-downcase)
                           (string-ref str i))))
    str*))

(define (slugify str)
  ;;;  Convert STR to a 'slug', that is, another string suitable for linking.
  ;; This function will return the input string, in sentence case, and with all
  ;; punctuation and spaces converted to a hypen.
  (string-capitalize
   (string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-")
                     (lambda (c)
                       (char=? c #\-)))))

(define (unslugify slug)
  ;;; Convert a SLUG back into a normal string as best as possible.
  ;; Because information is lost in slugification, it's impossible to be sure
  ;; that the result of this procedure is totally accurate.  That is,
  ;; slugification is not round-trippable.
  (irregex-replace/all '("-") slug " "))


;;; Transform source

(define (transform source . transformers)
  ;;; Transform SOURCE to html by passing it through a series of TRANSFORMERS.
  ;; Each TRANSFORMER should be a one-argument procedure taking and returning a
  ;; string.
  (let loop ((transformers transformers)
             (output source))
    (if (null? transformers)
        output
        (loop (cdr transformers)
              ((car transformers) output)))))

(define (md->index-html filename)
  ;;; Transform a FILENAME of the form dir/name.md to dir/name/index.html.
  ;; Uses source
  )


;;; Pages

(define-record-type <page>
  ;;; A wiki page is a mapping between source and body content, and between the
  ;;; page's origin and its destination files, wrapped together with some
  ;;; metadata.
  (make-page source body origin destination meta)
  page?
  (source page-source                   ; source markup
          (setter page-source))
  (body page-body                       ; rendered page body
        (setter page-source))
  (origin page-origin                   ; file containing the markup
          (setter page-origin))
  (destination page-destination         ; destination file
               (setter page-destination))
  (meta page-meta                       ; alist of metadata tags
        (setter page-meta)))

(define (page-meta-ref key page)
  ;;; Get metadata KEY from PAGE.
  (cdr (assq key (page-meta page))))

(define (file->page file
                    #!key
                    (transformers (config-get 'transformers))
                    (destination ))
  ;;; Create a <page> from FILE.
  ;; Wraps make-page for easier use.

  )


;;; Writing files

(define (publish file config)
  ;;; Publish FILE, using CONFIG.
  ;; CONFIG should be a configuration alist, which see above.
  #f)