(define (wiki-title title)
#<#EOF
== #{title}
EOF
)
(define (wiki-subtitle title)
#<#EOF
=== #{title}
EOF
)
(define (wiki-subsubtitle title)
#<#EOF
==== #{title}
EOF
)
(define (wiki-subsubsubtitle title)
#<#EOF
===== #{title}
EOF
)
(define (wiki-source source)
#<#EOF
#{source}
EOF
)
(define (wiki-procedure signature to)
#<#EOF
#{signature} → #{to}
EOF
)
(define (wiki-syntax signature to)
#<#EOF
#{signature} → #{to}
EOF
)
(define (wiki-read signature to)
#<#EOF
#{signature} → #{to}
EOF
)
(define (wiki-record type)
#<#EOF
#{type}
EOF
)
(define (wiki-record type)
#<#EOF
#{type}
EOF
)
(define (wiki-module name)
#<#EOF
'''[module]''' {{#{name}}}
EOF
)
(define (wiki-export export)
#<#EOF
* [[###{export}]]
EOF
)
;;; What happens with colons in the definition?
(define (wiki-parameter parameter definition)
#<#EOF
; #{parameter} : #{definition}
EOF
)
(define (wiki-monospace text)
#<#EOF
{{#{text}}}
EOF
)
(define (wiki-preamble)
#<#EOF
[[toc:]]
EOF
)
(define (wiki-postamble)
#<#EOF
Documented by [[/egg/cock|cock]].
EOF
)
(define (wiki-parameter-object name init)
#<#EOF
#{name} → #{init}
EOF
)
(define (wiki-scalar name definition)
#<#EOF
#{name} → #{definition}
EOF
)
;;; Needs to be generalized.
(define (wiki-parse-directive doc expr data document)
(let ((directive (car doc))
(arguments (cdr doc))
(data (document-data document)))
(case directive
((title)
(let ((title (car arguments)))
(lambda () (display (wiki-title title)))))
((heading)
(let ((title (car arguments)))
(lambda ()
(hash-table-set! data 'heading-level 1)
(display (wiki-subtitle title)))))
((subheading)
(let ((title (car arguments)))
(lambda ()
(hash-table-set! data 'heading-level 2)
(display (wiki-subsubtitle title)))))
;; Shit: we're supporting a different language than LaTeX; TODO:
;; intermediate S-expressions over pre-post-order!
((subsubheading)
(let ((title (car arguments)))
(lambda ()
(hash-table-set! data 'heading-level 3)
(display (wiki-subsubsubtitle title)))))
(else
(lambda () (warning "wiki-parse-directive -- Unknown directive" directive))))))
(define (wiki-make-heading heading-level)
(match heading-level
(0 wiki-subtitle)
(1 wiki-subsubtitle)
(2 wiki-subsubsubtitle)
(3 wiki-subsubsubtitle)))
(define (wiki-make-description descriptions)
(string-join descriptions "\n\n"))
(define (write-wiki-block doc
expr
data
name
item
. rest-items)
(let ((heading
(wiki-make-heading
(hash-table-ref/default
data
'heading-level
0)))
(description (wiki-make-description (doc-descriptions doc))))
(display (heading (wiki-monospace name)))
(display (string-join (cons item (cons description rest-items)) "\n" 'suffix))
(when (write-source?)
(display (wiki-source (with-output-to-string (lambda () (pp expr))))))))
;;; Generalize this.
(define (make-wiki-procedure template name formals to)
(template (cons name formals) (string-join to ", ")))
(define (purge-newlines string)
(irregex-replace/all "\n" string " "))
(define (make-wiki-parameters parameters)
(let ((parameters
(map
(match-lambda ((parameter definition)
(wiki-parameter parameter (purge-newlines definition))))
parameters)))
(string-join parameters "\n")))
(define (wiki-parse-procedure doc expr data name formals)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(let ((to (procedure-to special-parameters)))
(let ((procedure
(make-wiki-procedure wiki-procedure name formals to))
(parameters
(make-wiki-parameters normal-parameters)))
(lambda ()
(write-wiki-block doc
expr
data
name
procedure
parameters))))))
(define (wiki-parse-case-lambda doc expr data name formals+)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(let ((to (procedure-to special-parameters)))
(let ((procedures
(string-join
(map (lambda (formals)
(make-wiki-procedure
wiki-procedure
name
formals
to))
formals+)
"\n"))
(parameters
(make-wiki-parameters normal-parameters)))
(lambda ()
(write-wiki-block
doc
expr
data
name
procedures
parameters))))))
(define (wiki-parse-parameter doc expr data name init)
(let ((parameter (wiki-parameter-object name init)))
(thunk (write-wiki-block
doc
expr
data
name
parameter))))
(define (wiki-parse-scalar doc expr data name)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(if (scalar-procedure? normal-parameters special-parameters)
(wiki-parse-procedure doc
expr
data
name
(map car normal-parameters))
(let* ((definition (last expr))
(scalar (wiki-scalar name definition)))
(thunk (write-wiki-block doc
expr
data
name
scalar))))))
(define (wiki-parse-syntax doc expr data name)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(let ((to (procedure-to special-parameters)))
(let ((syntax (make-wiki-procedure wiki-syntax
name
(formals normal-parameters)
to))
(parameters (make-wiki-parameters normal-parameters)))
(thunk (write-wiki-block doc
expr
data
name
syntax
parameters))))))
(define (wiki-parse-read doc expr data char)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(let* ((to (procedure-to special-parameters))
(read (wiki-read char (string-join to ", "))))
(let ((parameters (make-wiki-parameters normal-parameters)))
(thunk (write-wiki-block doc
expr
data
char
read
parameters))))))
(define (wiki-parse-record doc expr data type)
(receive (normal-parameters special-parameters)
(doc-normal-and-special-parameters doc)
(let ((record (wiki-record type))
(fields (make-wiki-parameters normal-parameters)))
(thunk (write-wiki-block doc
expr
data
type
record
fields)))))
(define (make-wiki-exports exports)
(string-join (map wiki-export exports) "\n"))
(define (wiki-parse-module doc expr data name exports)
(let ((module (wiki-module name))
(exports (make-wiki-exports exports)))
(thunk (parameterize ((write-source? #f))
(write-wiki-block doc
expr
data
name
module
exports)))))
(define (wiki-parse-docexpr document docexpr)
(parameterize ((parse-directive wiki-parse-directive)
(parse-procedure wiki-parse-procedure)
(parse-case-lambda wiki-parse-case-lambda)
(parse-parameter wiki-parse-parameter)
(parse-scalar wiki-parse-scalar)
(parse-syntax wiki-parse-syntax)
(parse-read wiki-parse-read)
(parse-record wiki-parse-record)
(parse-module wiki-parse-module))
(parse-docexpr document docexpr)))
;;; Needs to be generalized.
(define (wiki-parse-docexprs document docexprs)
(let ((parsed-docexprs (make-stack)))
(stack-for-each
docexprs
(lambda (docexpr)
(stack-push! parsed-docexprs
(wiki-parse-docexpr document docexpr))))
parsed-docexprs))
;;; Needs to be generalized.
(define (wiki-write-docexprs docexprs)
@("Write the source-derived docexprs as svnwiki."
(docexprs "The parsed docexprs"))
(let* ((document (make-document (make-hash-table) (make-stack)))
(parsed-docexprs (wiki-parse-docexprs document docexprs)))
(display (wiki-preamble))
(stack-for-each parsed-docexprs (lambda (docexpr) (docexpr)))
(display (wiki-postamble))))