;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Generate Markdown documentation.
;;;
;;; Copyright (c) 2018, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare
  (module (beaker markdown))
  (export document-author
          document-dependencies
          document-extension
          document-license
          document-program)
  (import (beaker egg info)
          (chicken io)
          (chicken irregex)
          (chicken pathname)
          (chicken port)
          (chicken process)
          (chicken process-context)
          (chicken read-syntax)
          (chicken string)
          (schematic extract)
          (srfi 13)))

;;
;; Reads Scheme source from `input` and writes Markdown documentation
;; for each commented value to `output`.
;;
;; If no arguments are given, `input` and `output` default to the
;; `(current-input-port)` and `(current-output-port)`.
;;
(define (generate-markdown #!optional input output)
  (let* ((buffer  (open-output-string))
         (input*  (or input (current-input-port)))
         (output* (or output (current-output-port)))
         (_       (extract-definitions '(";;") #t input* buffer))
         (buffer* (open-input-string (get-output-string buffer))))
    (parameterize ((current-input-port buffer*)
                   (current-output-port output*))
      (do ((x (read) (read)))
          ((eof-object? x))
        (for-each (lambda (d)
                    (unless (eq? (car d) 'declaration)
                      (print "    [" (car d) "] " (cdr d))))
                  (cdr x))
        (print #\newline (car x) #\newline)))))

(define (document-file file)
  (string-trim-both
   (with-output-to-string
    (lambda ()
      (call-with-input-file file generate-markdown)))))

(define (document-command command)
  (string-append "    " (string-trim-both (with-input-from-pipe command read-string))))

(define (document-extension file)
  (document-file file))

(define (document-program file command)
  (string-append (document-command command) "\n\n" (document-file file)))

(define (document-dependencies egg-file)
  (string-intersperse
   (map (lambda (d) (conc "* [" d "](/eggref/5/" d ")"))
        (egg-dependencies egg-file))
   "\n"))

(define (document-author egg-file)
  (let* ((author (egg-author egg-file))
         (link (irregex-replace/all
                "[A-Z]" (string-translate author " " "-")
                (lambda (m) (string-downcase (irregex-match-substring m 0))))))
    (string-append "[" author "](/users/" link ")")))

(define (document-license file)
  (string-intersperse
   (map (lambda (l) (string-append "    " l))
        (with-input-from-file file read-lines))
   "\n"))