(use awful
     irregex
     posix
     utils
     lowdown
     (prefix fancypants fancypants-)
     lowdown-lolevel
     srfi-13
     (prefix comparse c-)
     clojurian-syntax
     uri-common)

(define wiki-dir "wiki")

(create-directory wiki-dir 'recursively)

(define start-page "WelcomeVisitor")
(define all-pages "AllPages")

(enable-sxml #t)

;; stolen form lowdown-extra
(define inline-wiki-link
  (c-enclosed-by (c-char-seq "{")
               (->> (c-none-of* (c-is #\}) c-item)
                    (c-one-or-more)
                    (node 'wiki-link))
               (c-char-seq "}")))

(define fancypants
  (c-any-of
   (map (lambda (mapping)
          (c-preceded-by (c-char-seq (car mapping))
                                (c-result (cdr mapping))))
        fancypants-default-map)))

(define wiki-html-conversion-rules*
  `((wiki-link . ,(lambda (_ page-name)
                    `(a (@ (href ,page-name)) . ,page-name)))))

(inline-hook (cons* fancypants inline-wiki-link (inline-hook)))
(markdown-html-conversion-rules* (append wiki-html-conversion-rules*
                                         (markdown-html-conversion-rules*)))

(define (link page #!optional description)
  `(a (@ (href ,page)) ,(or description page)))

(define (all-versions page-name)
  (sort (find-files wiki-dir test: (lambda (f) (equal? (pathname-file f) page-name)))
               (lambda (a b)
                 (> (->> a pathname-extension string->number)
                    (->> b pathname-extension string->number)))))

(define (latest-file page-name)
  (let ((candidates (all-versions page-name)))
    (and (not (null? candidates)) (car candidates))))

(define (new-version wiki-file)
  (let loop ((n 0))
    (let (( f  (pathname-replace-extension wiki-file (->string n))))
      (if (file-exists? f)
          (loop (add1 n))
          f))))

(define (version-links page-name path #!key edit?)
  (let ((pages (all-versions page-name)))
    (if (or (= (length pages) 1) (null? pages))
        '()
        `(small "Versions "
          ,(link (string-append page-name (if edit? "?edit=1" "")) "(latest)") " > "
          ,@(intersperse (map (lambda (f)
                               (link (string-append path "?version=" (pathname-extension f) (if edit? ";edit=1" ""))
                                     (pathname-extension f)))  (cdr pages)) " > ")))))

(define (show-all-pages)
  `((ul ,@(map (lambda (f)
                 `(li ,(link (pathname-file (car f)))))
               (fold  (lambda (f l)
                        (let-values (((dir file ext) (decompose-pathname f)))
                          (if (string> ext (alist-ref file l equal? "") )
                              (alist-update file ext l equal?)
                              l)))
                      '()
                      (find-files wiki-dir))))
    (hr)))

(define-page (irregex "/[^/]*")
  (lambda (path)
    (with-request-variables ((edit (nonempty as-boolean))
                             (content (nonempty as-string))
                             (search (nonempty as-string))
                             (version (nonempty as-string)))
      (when (equal? path "/")
            (redirect-to start-page))
      (let* ((edit-path (string-append path "?edit=1"))
             (wiki-file (make-pathname wiki-dir path))
             (page-name (string-trim path #\/))
             (display-or-start
              (lambda (page-name . page-version)
                `(,(let ((f (if (not (null? page-version))
                                (pathname-replace-extension wiki-file (car page-version))
                                (latest-file page-name))))
                  (if f
                      `(,(with-input-from-file f markdown->sxml)
                        (hr)
                        ,(version-links page-name path)
                        (hr)
                        (a (@ (href ,(if (not (null? page-version))
                                         (string-append edit-path ";version=" (car page-version))
                                         edit-path))) "Edit"))
                      (redirect-to edit-path)))
                  " | "))))
        `((h1 (a (@ (href ,(string-append path "?search=" page-name))) ,page-name))
          (hr)
          ,(cond
            ((equal? page-name all-pages)
             (show-all-pages))
            (edit
             (let ((content (let ((f (if version
                                         (pathname-replace-extension wiki-file version)
                                         (latest-file page-name))))
                              (if f
                                  (read-all f)
                                  "This is a new page, please edit"))))
               `((form (@ (action ,path)
                          (method post))
                       (textarea (@
                                  (name "content")
                                  (cols 80)
                                  (rows 25)
                                  (autofocus))
                                 ,content)
                       (hr)
                       ,(version-links page-name path edit?: #t)
                       (hr)
                       (input (@ (type "submit") (value "Save")))))))
            (version
             (display-or-start page-name version))
            (content
             (cond ((equal? content "[delete]")
                    (let ((file (latest-file page-name)))
                      (when (file-read-access? file)
                            (delete-file file))
                      (redirect-to start-page)))
                   (else
                    (with-output-to-file (new-version wiki-file)
                      (cut print content))
                    (redirect-to path))))
            (search
             `((h2 "Search results for " ,search)
               (ul
                ,(with-input-from-pipe
                  (sprintf "grep -ri ~a ~s" (qs search) wiki-dir)
                  (lambda ()
                    (map (lambda (l) (let* ((r (string-split l ":"))
                                            (p (pathname-file (car r)))
                                            (c (cdr r)))
                                       `(li (a (@ (href ,p)) ,p) " : " ,c))) (read-lines)))))))
            (else
             (display-or-start page-name)))
          (a (@ (href ,start-page)) ,start-page) " | "
          (a (@ (href ,all-pages)) ,all-pages) " | "
          (form (@ (action ,path) (method post))
                (input (@ (type "text") (name "search")))
                (input (@ (type "submit") (value "Search"))))))))
  method: '(get post))