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