#lang racket/base
; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.
;; Pollen “tag functions” that return elements of a Yarn AST. This AST can be
;; rendered into HTML or other formats (using, e.g., the yarn/render/html module).
(require pollen/decode
pollen/tag
racket/string
txexpr
"index.rkt"
"string.rkt"
"tools.rkt"
yarn/path)
(provide (all-defined-out))
(define (root . elems)
(print (validate-txexpr `(test ,@elems)))
(check-title elems)
(serialize-article-placeholder)
`(document ,@(decode-hardwrapped-paragraphs elems)))
;; Customized paragraph decoder replaces single newlines within paragraphs
;; with single spaces instead of <br> tags (allow hard-wrapped paragraphs)
(define (decode-hardwrapped-paragraphs xs)
(define (no-linebreaks xs)
(decode-linebreaks xs " "))
(decode-paragraphs xs 'paragraph #:linebreak-proc no-linebreaks))
;; Set a title if not already set
(define (check-title elems)
(cond
[(and (not (meta-set? 'title))
(pair? elems)
((tx-is? 'poetry #:has-attrs 'title) (car elems)))
(set-meta 'title (format "‘~a’" (attr-ref (car elems) 'title)))
(set-meta 'title-supplied? #t)]
[(not (meta-set? 'title))
(set-meta 'title (if (pair? elems) (first-words elems 5) ""))]))
;; Yarn AST:
;; (document Block-Contents)
;; Footnote definitions, index entry keys are stored in the metas
;; Block-Content :=
;; (heading #:level Inline-Contents)
;; | (paragraph Inline-Contents)
;; | (thematic-break style)
;; | (codeblock info Inline-Contents)
;; | (blockquote items := (item Block-Contents))
;; | (poetry title style Block-Contents)
;; | (itemization style start Block-Contents)
;; | (dialogue speeches := (speech interlocutor Block-Contents))
;; | (figure source caption)
;; | (margin-note Block-Contents)
;; Inline-Content :=
;; string?
;; | (italic Inline-Contents)
;; | (bold Inline-Contents)
;; | (link destination Inline-Contents)
;; | (monospace Inline-Contents)
;; | (strikethrough Inline-Contents)
;; | (caps Inline-Contents)
;; | (image description source)
;; | (xref type dest-key Inline-Contents)
;; | (footnote-ref label)
;; | line-break
(define blocks-elements
'(heading
paragraph
thematic-break
codeblock
blockquote
poetry
itemization
dialogue
figure
margin-note))
(define inline-elements
'(italic
bold
link
image
xref
footnote-ref
line-break))
(define (title . t) (set-meta 'title t) (set-meta 'title-supplied? #t) "")
(define (section . s) `(heading [[level "2"]] ,@s))
(define (subsection . s) `(heading [[level "3"]] ,@s))
(define (excerpt . e) (set-meta 'excerpt e))
(define (excerpt* . e) (apply excerpt e) `(@ ,@e))
(define (pause [type 'blank]) `(thematic-break ,type)) ; type = blank | mark
(define codeblock (default-tag-function 'codeblock #:info ""))
(define blockquote (default-tag-function 'blockquote)) ; #:caption
(define figure (default-tag-function 'figure))
(define (i . inline) `(italic ,@inline))
(define em i)
(define (b . inline) `(bold ,@inline))
(define (mono . inline) `(monospace ,@inline))
(define (caps . inline) `(caps ,@inline))
(define (strike . inline) `(strikethrough ,@inline))
(define br 'line-break)
(define (link ref . elems) `(link ,ref ,@elems))
(define (url ref URL) (update-metas-subhash 'urls ref URL) "")
(define (xref type elems k)
(define key (or k (normalize-key (->text elems))))
(cons-to-metas-list 'xref-keys key)
`(xref ,type ,key ,@elems))
(define (pin #:key [key #f] . elems) (xref 'idx elems key))
(define (def #:key [key #f] . elems) (xref 'def elems key))
(define (ref #:key [key #f] . elems) (xref 'ref elems key))
(define (fn ref) `(footnote-ref ,ref))
(define (fndef ref . elems) (update-metas-subhash 'footnote-defs ref elems) "")
(define (ol . elems) `(itemization [[start "1"]] ,@elems)) ; #:style
(define (ul . elems) `(itemization ,@elems)) ; #:style
(define (item . blocks) `(item ,@blocks))
(define (dialogue . speeches) `(dialogue ,@speeches))
(define (say interlocutor elems) `(speech ,interlocutor ,@elems))
(define (saylines interlocutor elems)
`(speech ,interlocutor ,@(decode-linebreaks elems 'line-break)))
(define verse (default-tag-function 'poetry)) ; #:title, #:style
(define-tag-function (note attrs elems)
(let* ([note-count (update-meta 'note-count add1 0)]
[note-id (string-append (attr-ref attrs 'date) (format "_~a" note-count))]
[maybe-disp (string-split (attr-ref attrs 'disposition ""))]
[the-note (attr-set* `(note ,attrs ,@elems) 'id note-id 'parent (here-output-path))])
(cond
[(> (length maybe-disp) 1)
(set-meta 'disposition `(,(car maybe-disp)
,(string-join (cdr maybe-disp))
,note-id))])
(cons-to-metas-list 'notes the-note)
(serialize-note the-note note-count)
""))
