◊(Local Yarn Code "Check-in [cf83a366]")

Overview
Comment:Shuffle stuff, serialize notes
Timelines: family | ancestors | evolve
Files: files | file ages | folders
SHA3-256: cf83a366e1367b2511bdfc6adbe7e94c9b48b3b0f2681e6e8cf3d1d9cc21eb17
User & Date: joel on 2022-04-11 18:32:58
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
Changes

Modified pollen.rkt from [295a2ae6] to [10bc504c].

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

(require pollen/decode
         txexpr
         yarn/markup
         yarn/string
         yarn/tools)

(provide
 (all-defined-out)
 (all-from-out yarn/markup))

(module+ setup
  (provide block-tags)
  (define block-tags blocks-elements))

;; Customized paragraph decoder replaces single newlines within paragraphs
;; with single spaces instead of <br> tags. Allows for “semantic line wrapping”.
(define (decode-hardwrapped-paragraphs xs)
  (define (no-linebreaks xs)
    (decode-linebreaks xs " "))
  (decode-paragraphs xs 'paragraph #:linebreak-proc no-linebreaks))

(define (root . elems)
  (validate-txexpr `(test ,@elems))
  (check-title elems)
  `(document ,@(decode-hardwrapped-paragraphs elems)))

(define (check-title elems)
  (cond
    [(and (not (meta-set? 'title))
          ((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 (first-words elems 5))]))


<
<
|
<
<








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2


3


4
5
6
7
8
9
10
11





















#lang racket/base



(require yarn/markup)



(provide
 (all-defined-out)
 (all-from-out yarn/markup))

(module+ setup
  (provide block-tags)
  (define block-tags blocks-elements))





















Added yarn-lib/info.rkt version [9654899d].























>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
#lang info

(define collection "yarn")
(define version "0.9")

(define pkg-desc "implementation part of \"yarn\"")
(define license 'BlueOak-1.0.0)
(define deps '("base"
               "pollen"
               "threading-lib"
               "txexpr"))

Modified yarn-lib/markup.rkt from [44b41b90] to [e117b7ce].

1
2
3
4
5
6
7
8
9
10


11
12
13

14
15
16
























17
18
19
20
21
22
23
#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


         "index.rkt"
         "string.rkt"
         "tools.rkt")


(provide (all-defined-out))

























;; Yarn AST:
;;  (document Block-Contents)
;;  Footnote definitions, index entry keys are stored in the metas

;;  Block-Content := 
;;    (heading #:level Inline-Contents)
;;    | (paragraph Inline-Contents)










>
>


|
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
#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)
106
107
108
109
110
111
112













(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





















>
>
>
>
>
>
>
>
>
>
>
>
>
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
(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)
    ""))

Added yarn-lib/path.rkt version [6ad5fb98].

























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

(require pollen/core
         pollen/file
         pollen/setup
         racket/path)

(provide here-source-path
         here-output-path)

(define (identity v) v)

;; Return the path to the current Pollen source, relative to project root
(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 "."]))

;; Return the path to the output filename for the current Pollen source,
;; relative to project root
(define (here-output-path #:string? [string? #t])
  (define proc (if string? path->string identity))
  (proc (->output-path (here-source-path #:string? #f))))

Modified yarn-lib/render/html.rkt from [db6d2a1b] to [cf9a317e].

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
#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









>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#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"
         "../path.rkt"
         koyo/haml
         pollen/core
         pollen/decode
         racket/function
         racket/list
         racket/match
         racket/string
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
  `(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))))







|








148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
  `(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))))

Modified yarn-lib/string.rkt from [73b950a7] to [c7e401e6].

19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
    [(? 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))








|
|

|
|
|
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    [(? 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 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 (first-words txprs words-needed)
  (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))

Modified yarn-lib/tools.rkt from [349befab] to [b56e0b6a].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#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 ‘-’




<
<
<
|
|







1
2
3
4



5
6
7
8
9
10
11
12
13
#lang racket/base

(require file/sha1
         pollen/core



         racket/file
         racket/list
         racket/string
         threading
         txexpr)

(provide (all-defined-out))

;; Convert a string into all lowercase, delete all non-alphanum chars, replace spaces with ‘-’
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






































              (~> (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)))













































<
<
<
<
<
<
|
<
<
<
>







>
>
>
>

















|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
              (~> (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))







;;



;; Meta tools ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(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 (update-meta key proc default)
  (let ([updated (proc (hash-ref (current-metas) key default))])
    (set-meta key updated)))

(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) t (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)))

;; “Notes”, in addition to being attached to/contained in articles, are also
;; shown alongside articles in the chronological feed. To make building this
;; mixed chronological feed faster, articles and notes create files in a
;; “serialize” subfolder at compile time:
;;   * The filenames are prefixed with the thing’s YMD date.
;;   * Note-files contain a datum of the entire note.
;;   * Article-files contain only the path to the article’s source.
;; 
;; This way building the chrono feed is simple and doesn’t require loading
;; and sorting the docs/metas of the entire article set.

(define serialize-folder "compiled/.serialized")

(define (current-serialize-folder-path)
  (and~> (hash-ref (current-metas) 'here-path #f)
         explode-path
         (drop-right 1)
         (append (list serialize-folder))
         (apply build-path _)))

;; 
;; TODO: Possible speed gains by spawning a thread to do this
(define (serialize-article-placeholder)
  (let* ([ser-folder (current-serialize-folder-path)]
         [filename (format "~a.article" (hash-ref (current-metas) 'published))]
         [placeholder (build-path ser-folder filename)])
    (unless (directory-exists? ser-folder) (make-directory ser-folder))
    (unless (file-exists? placeholder)
      (write-to-file (hash-ref (current-metas) 'here-path)
                     (build-path ser-folder filename)
                     #:exists 'truncate))))

(define (serialize-note note num)
  (let ([ser-folder (current-serialize-folder-path)]
        [filename (format "~a_~a.note" (attr-ref note 'date) num)])
    (unless (directory-exists? ser-folder) (make-directory ser-folder))
    (write-to-file note (build-path ser-folder filename) #:exists 'truncate)))