~evhan/beaker

ref: a613b5f78c7521d010b5089805edf0e2d59ae3cf beaker/lib/beaker/markdown.scm -rw-r--r-- 2.6 KiB
a613b5f7Evan Hanson Avoid false-positive module reference warnings when compiler syntax is applied 3 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Generate Markdown documentation.
;;;
;;; Copyright (c) 2018-2019, 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 port)
          (chicken process)
          (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"))