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

Login
About History Code Code Docs Road Map Issues
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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

1
2



3


4
5
6
7
8
9
10
11
























-
-
-
+
-
-








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#lang racket/base

(require pollen/decode
         txexpr
         yarn/markup
(require 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))]))

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

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")
         "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














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

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

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

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 (first-words txprs words-needed)
  (define punc-allowed-in-word '(#\- #\' #\% #\$ #\‘ #\’ #\# #\& #\/ #\. #\!))

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

1
2
3
4





5
6
7
8
9
10
11
12
13





-
-
-
-
-
+
+








#lang racket/base

(require file/sha1
         pollen/core
         pollen/file
         pollen/setup
         (only-in racket/function identity)
         racket/match
         racket/path
         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







































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

(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))))
;; 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) tags (list t)))
  (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)))











This page was generated in about
0.01s by
Fossil 2.19 [318ab802db] 2022-05-27 02:05:21