Overview
| Comment: | Start on new markup and renderer |
|---|---|
| Timelines: | family | ancestors | descendants | both | evolve |
| Files: | files | file ages | folders |
| SHA3-256: |
4ac3f95c1671d6eb4ce1d8f34e62c3bb |
| User & Date: | joel on 2022-04-05 19:19:32 |
| Other Links: | branch diff | manifest | tags |
Context
|
2022-04-11
| ||
| 18:32 | Shuffle stuff, serialize notes Leaf check-in: cf83a366 user: joel tags: evolve | |
|
2022-04-05
| ||
| 19:19 | Start on new markup and renderer check-in: 4ac3f95c user: joel tags: evolve | |
|
2021-11-28
| ||
| 19:19 | Clean house check-in: 43a06b90 user: joel tags: evolve | |
Changes
Modified articles/what-should-people-do-with-old-journals.poly.pm from [36b86268] to [e18f160a].
1 2 3 4 5 6 7 8 | 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 | - + + + - + - + - + | #lang pollen
◊; Copyright 2019 by Joel Dueck. All Rights Reserved.
◊(define-meta published "2019-04-11")
◊title{What Should People Do With Old Journals?}
|
Name change from pollen.rkt to pollen-old.rkt.
Modified pollen.rkt from [92b6e46e] to [295a2ae6].
1 2 | 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 | - + - - + - - + - - - - + + - - - - - - - - - + + + - - - - - - + + - - - - + - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - + - - - - + - - - - - - - - - + + + - - + - - + + - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - + - - - - - - - - - - + + + + - - - - + - - - - - - | #lang racket/base |
Modified yarn-lib/markup.rkt from [88b1006b] to [44b41b90].
1 2 3 4 5 | 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 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | - + + - - - - - - + - - - - - + + + - + - - - - - - - - + - - + - - - - - - - - - - - + - - - - + + - - + + + - - - - + - - + - - + - - - + - - - - - - - + - - - - - + - - - - - - - - - - + - - - - - - - - - - - - - - - + - - - + - - - + + - - - - + + - - - - + + + - - + - - - - - + + - - - - - + - - - - - - - + - - - - - + + - - - + - - - - - - - - - + - - + - - - - + + - - - + + - - - - - - - - - - - - - + + - - - + - - - - - + + + + + - - - - + - - + - - - - - - - - - + + + - - - - - - + - - - - - - - - - + + + - - - - - + + + - - - - - - - - - + - - - - - + + - - + - - - + + - - - - + - - - - - - - - - + - - - - - + - - - - + - - - - + - - - - + - - + - - - - - + - - - - - - - + - - + - - - + + + - - - - + + - - - + - - - - - - - - - - - + - - + + | #lang racket/base ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. |
Added yarn-lib/render/html.rkt version [db6d2a1b].
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 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | #lang racket/base
; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.
;; Renders a Yarn AST and metadata into HTML
(require "../tools.rkt"
"../string.rkt"
koyo/haml
pollen/core
pollen/decode
racket/function
racket/list
racket/match
racket/string
txexpr)
(provide doc->html)
;; TODO: most of this should all go into the template code
(define (doc->html doc)
(define-values (title-type class)
(if (meta-set? 'title-supplied?)
(values 'given "with-title")
(values 'generated "no-title")))
(haml
(:article.h-entry
[[:class class]]
,@(heading/permlink title-type)
(:section.entry-content
,@(decode-elements #:block-txexpr-proc render-block
#:inline-txexpr-proc render-inline
(cdr doc))))))
;; TODO: This should really go into the template code
(define (heading/permlink title-type)
(define m (current-metas))
(define p (hash-ref m 'published))
(case title-type
[(given)
(haml
(:h1.entry-title ,@(hash-ref m 'title))
(:p.time
(:a.rel-bookmark
[[:href (string-append "/" (here-output-path))]]
(:time.published [[:datetime p]] (ymd->english p)))))]
[(generated)
(haml
(:h1
(:a.rel-bookmark
[[:href (string-append "/" (here-output-path))]]
(:time.entry-title [[:datetime p]] (ymd->english p)))))]))
;; 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)
(define (render-block e)
(match e
[(list 'heading (list (list 'level lev)) elems ...) (render-heading lev elems)]
[(list 'paragraph elems ...) `(p ,@elems)]
[(list 'thematic-break style) `(hr [[class ,style]])]
[(list 'blockquote elems ...) `(blockquote ,@elems)]
[(txexpr 'poetry attrs elems) (render-poetry attrs elems)]
[(txexpr 'codeblock attrs elems) (render-codeblock attrs elems)]
[(txexpr 'itemization attrs elems) (render-itemization attrs elems)]
[(txexpr 'dialogue _ elems) `(dl ,@elems)]
[(list 'speech interlocutor elems ...)
`(@ (dt ,interlocutor (span [[class "x"]] ": ")) (dd ,@elems))]
[(txexpr 'figure attrs elems) (render-figure (car elems) (cdr elems))]
[else (raise-argument-error 'render-block "block-content" e)]))
;; 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 (render-inline e)
(match e
[(list 'italic elems ...) `(i ,@elems)]
[(list 'bold elems ...) `(b ,@elems)]
[(list 'monospace elems ...) `(samp ,@elems)]
[(list 'strikethrough elems ...) `(del ,@elems)]
[(list 'caps elems ...) `(span [[class "caps"]] ,@elems)]
[(list 'link dest elems ...) (render-link dest elems)]
[(list 'xref type key elems ...) (render-xref type key elems)]
[(list 'footnote-ref ref) (render-footnote-ref ref)]
[(list 'item elems ...) `(li ,@elems)]
[else e]))
(define (render-link dest elems)
(define url
(or (get-metas-subhash 'urls dest)
(format "#Missing_Reference_~a" dest)))
`(a [[href ,url]] ,@elems))
(define (render-heading level elems)
(define tag (string->symbol (format "h~a" level)))
`(,tag ,@elems))
(define (render-poetry attrs elems)
(define title
(match (attr-ref attrs 'title attrs #f)
[(? string? t) `(p [[class "verse-heading"]] ,t)]
[_ ""]))
(define pre-attrs
(cond
[(string-contains? (attr-ref attrs 'style "") "italic")
'((style "font-style: italic"))]
[else '()]))
`(div [[class "poem"]] ,title (pre [[class "verse"] ,@pre-attrs] ,@elems)))
(define (render-codeblock attrs elems)
(define file (or (assoc 'filename attrs) ""))
(define codeblock `(pre [[class "code"]] (code ,@elems)))
(cond [(non-empty-string? file) `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
[else codeblock]))
(define (render-itemization attrs elems)
(define tag (if (attr-ref attrs 'start #f) 'ol 'ul))
`(,tag ,attrs ,@elems))
(define (render-figure source elems)
`(figure [[class "fullwidth"]]
(img [[src ,source]] [[alt ,(->text elems)]])
(figcaption ,@elems)))
;; The AST guarantees that they key will already be URI-safe
(define (render-xref type key elems)
`(a [[id ,(here-key (format "_~a-~a" type key))]
[href ,(string-append "/keyword-index.html#" key)] ; TODO: ref type links need to resolve to the target
[data-index-entry ,key]
[class ,(symbol->string type)]]
,@elems))
(define (render-footnote-ref ref)
(cons-to-metas-list 'fn-names ref)
(let* ([here (here-key)]
[fn-names (hash-ref (current-metas) 'fn-names)]
[def-anchor (format "#~a_fndef_~a" here ref)]
[nth-ref (number->string (count (curry equal? ref) fn-names))]
[ref-id (format "#~a_fn_~a_~a" here ref nth-ref)]
[fn-number (+ 1 (index-of (remove-duplicates (reverse fn-names)) ref))]
[ref-text (format "(~a)" fn-number)])
`(sup (a [[href ,def-anchor] [id ,ref-id]] ,ref-text))))
|
Added yarn-lib/string.rkt version [73b950a7].
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 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | #lang racket/base
(require gregor
racket/match
racket/string
txexpr)
(provide ->text
first-words
ymd->english)
(module+ test (require rackunit))
;; Concatenate the string elements of a txexpr or list together
(define (->text v)
(match v
[(txexpr _ _ elements) (->text elements)]
[(list elements ...) (string-append* (map ->text elements))]
[(? string? s) s]
[_ ""]))
;; Return the first N words out of a list of txexprs. This function will unpack the strings out of
;; the elements of one txexpr at a time until it finds the requested number of words. It aims to be
;; both reliable and fast for any size of list you pass it, and smart about the punctuation it
;; allows through.
(define (first-words txprs words-needed)
(define punc-allowed-in-word '(#\- #\' #\% #\$ #\‘ #\’ #\# #\& #\/ #\. #\!))
(define (word-boundary? c) (or (char-whitespace? c) (equal? c #\null) (eof-object? c)))
(define (word-char? c) (or (char-alphabetic? c) (char-numeric? c)))
(define in (open-input-string (->text (car txprs))))
(define out (open-output-string))
(define words-found
(let loop ([words-found 0] [last-c #\null] [last-c-in-word? #f])
(define c (read-char in))
(cond [(equal? words-found words-needed) words-found]
[(eof-object? c)
(cond [(positive? words-found) (if last-c-in-word? (+ 1 words-found) words-found)]
[else 0])]
[else
(define-values (write-this-char? new-word-count c-in-word?)
(cond
;; Spaces increment the word count if the previous character was part of,
;; or adjacent to, a word
[(and (char-whitespace? c) last-c-in-word?)
(values (if (equal? words-needed (+ 1 words-found)) #f #t) (+ 1 words-found) #f)]
;; Some punctuation survives if the previous or next char is part of a word
[(member c punc-allowed-in-word)
(cond [(or (word-char? last-c) (word-char? (peek-char in)))
(values #t words-found #t)]
[else (values #f words-found #f)])]
[(word-char? c)
(values #t words-found #t)]
;; If c is a non-whitespace non-allowed character that immediately follows a word,
;; do not write it out but count it as being part of the word.
[(and (not (word-char? c)) (not (char-whitespace? c)) last-c-in-word?)
(values #f words-found #t)]
[else (values #f words-found #f)]))
(cond [(and (char-whitespace? c) write-this-char?) (write-char #\space out)]
[write-this-char? (write-char c out)])
(loop new-word-count c c-in-word?)])))
(define words (get-output-string out))
(cond [(equal? words-found words-needed) (string-append words "…")]
[(equal? '() (cdr txprs)) words]
[else (string-append words " " (first-words (cdr txprs) (- words-needed words-found)))]))
(module+ test
(require rackunit)
(define txs-decimals
'((p "Four score and 7.8 years ago — our fathers brought forth on this continent etc etc")))
(define txs-punc+split-elems
'((p "“Stop!” she called.") (p "(She was never one to be silent.)")))
(define txs-dashes
'((p [[class "newthought"]] (span [[class "smallcaps"]] "One - and") " only one.")
(p "That was all she would allow.")))
(define txs-parens-commas
'((p "She counted (" (em "one, two") "— silently, eyes unblinking")))
(define txs-short
'((span "Not much here!")))
(check-equal? (first-words txs-decimals 5) "Four score and 7.8 years…")
(check-equal? (first-words txs-punc+split-elems 5) "Stop! she called. She was…")
(check-equal? (first-words txs-dashes 5) "One and only one. That…")
(check-equal? (first-words txs-dashes 4) "One and only one.…")
(check-equal? (first-words txs-parens-commas 5) "She counted one two silently…")
(check-equal? (first-words txs-short 5) "Not much here!"))
;; ~~~ Convenience functions for YYYY-MM-DD date strings ~~~
;; These functions ignore everything after the first space in the input!
(define (ymd->dateformat ymd-string dateformat)
(~t (iso8601->date (car (string-split ymd-string))) dateformat))
(define (ymd->english ymd-string)
(ymd->dateformat ymd-string "MMMM d, yyyy"))
(module+ test
(check-equal? (ymd->english "2018-08-12") "August 12, 2018")
(check-equal? (ymd->dateformat "2018-08-12" "d MMM YYYY") "12 Aug 2018")
;; How we handle weird input
(check-equal? (ymd->english "2018-08-12 everything after 1st space ignored") "August 12, 2018")
(check-equal? (ymd->english "2018-08 omitting the day") "August 1, 2018")
(check-equal? (ymd->english "2018 omitting month and day") "January 1, 2018")
(check-equal? (ymd->dateformat "2018-08-12" "123") "123")
;; Stuff we just don't handle
(check-exn exn:gregor:parse? (lambda () (ymd->english "2018-xyz"))))
|
Added yarn-lib/tools.rkt version [349befab].
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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | #lang racket/base
(require file/sha1
pollen/core
pollen/file
pollen/setup
(only-in racket/function identity)
racket/match
racket/path
racket/string
threading
txexpr)
(provide (all-defined-out))
;; Convert a string into all lowercase, delete all non-alphanum chars, replace spaces with ‘-’
(define (normalize-key str)
(~> (string-downcase str)
(regexp-replace #rx"ies$" _ "y")
(string-trim "s" #:left? #f)
(regexp-replace* #rx"[^A-Za-z0-9 ]" _ "")
(string-normalize-spaces #px"\\s+" "-")))
;; ~~ Metas reference and updating ~~~~~~~~~~~~~~~
;; Computes a unique string key for the current Pollen source and stashes it in the metas
(define (here-key [suffix ""])
(define metas (current-metas))
(define (set-here-key!)
(set-meta 'here-key
(~> (hash-ref metas 'here-path)
string->bytes/utf-8
sha1-bytes
bytes->hex-string
(substring 0 8))))
(string-append (hash-ref metas 'here-key set-here-key!) suffix))
(define (here-source-path #:string? [string? #t])
(define proc (if string? path->string identity))
(cond
[(current-metas)
(proc (find-relative-path (current-project-root) (hash-ref (current-metas) 'here-path)))]
[else "."]))
(define (here-output-path #:string? [string? #t])
(define proc (if string? path->string identity))
(proc (->output-path (here-source-path #:string? #f))))
(define (meta-set? key)
(and (hash-ref (current-metas) key #f) #t))
(define (set-meta key val)
(current-metas (hash-set (current-metas) key val))
val)
(define (cons-to-metas-list key val)
(define consed (cons val (hash-ref (current-metas) key '())))
(current-metas (hash-set (current-metas) key consed))
consed)
(define (update-metas-subhash key subkey val [proc (λ (v) v)])
(define metas (current-metas))
(define subhash (hash-ref metas key hasheq))
(set-meta key (hash-set subhash subkey (proc val))))
(define (get-metas-subhash key subkey)
(hash-ref (hash-ref (current-metas) key #hasheq()) subkey #f))
;; Returns a function will test if a txexpr's tag matches the given symbol and
;; (optionally) contains all given attributes.
(define (tx-is? t #:has-attrs [a '()])
(define tags (if (list? t) tags (list t)))
(define attrs (if (list? a) a (list a)))
(lambda (v)
(and (txexpr? v)
(member (get-tag v) tags)
(andmap (λ (attr) (attrs-have-key? a attr)) attrs)
#t)))
|