~mrlee/www.kamelasa.dev

ref: 2beda01aa6df5215cd26a7a90e78c2c4681eaea3 www.kamelasa.dev/pollen.rkt -rw-r--r-- 4.6 KiB
2beda01aLee Meichin Migrate pollen rewrite 3 months ago
                                                                                
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
#lang racket

(provide (all-defined-out))

(require txexpr pollen/pagetree pollen/core pollen/setup pollen/decode pollen/cache pollen/file racket/string pollen/tag pollen/unstable/pygments)

(provide highlight)

(module setup racket/base
  (provide (all-defined-out))
  (define poly-targets '(html)))

(define (root . elements)
  (add-footnotes (decode (txexpr 'root empty elements)
    #:txexpr-elements-proc smart-paragraphs
    #:string-proc (compose1 smart-ellipses smart-quotes smart-dashes)
    #:exclude-tags '(pre code))))

(define (smart-paragraphs elements)
  (decode-paragraphs elements
    #:linebreak-proc (λ (elems) (decode-linebreaks elems #f))))

(define (include-files folder extension)
   (map (λ (str) (string->symbol (path->string (simplify-path (format "~a/~a" folder (string-replace str extension "html"))))))
        (filter (λ (str) (string-suffix? str extension))
                (map path->string (directory-list folder)))))

(define (this-pagetree folder) `(@ ,@(include-files folder "poly.pm")))

(define (latest-posts)
  (sort (children 'posts (get-pagetree "index.ptree"))
        #:key post->date
        string>?))

(define (post->path post) (get-source (path->complete-path (symbol->string post) (current-project-root))))
(define (post->title post) (select-from-metas 'title post))
(define (post->date post) (select-from-metas 'date post))
(define (post->published? post) (select-from-metas 'published post))
(define (post->size post) (number->string (file-size (post->path post))))

(define average-word-length 4.7)
(define words-per-minute 250)
(define (post->ert post)  (exact-round (/ (/ (string->number (post->size post)) average-word-length) words-per-minute)))

(define posthistory '())
(define (post->history [post null])
    (when (empty? posthistory)
      (let ([gitlog (string-split (with-output-to-string 
                                  (λ () (system (format "git log --format='~a' --max-count=~a -- ~a"
                                                        "%h;%s;%ai"
                                                        10
                                                        (if (null? post) "." (post->path post))))))
                                "\n")])
      (for/list ([logline (in-list gitlog)])
        (let ([log (string-split logline ";")])
          (set! posthistory 
                (append posthistory 
                        (list `#hash([commit . ,(first log)] 
                                     [message . ,(second log)] 
                                     [date . ,(third log)]))))))))
    posthistory)
(define (log->giturl log) (format "https://git.sr.ht/~~mrlee/www.kamelasa.dev/commit/~a" (hash-ref log 'commit)))
(define (log->commit log) (hash-ref log 'commit))
(define (log->message log) (hash-ref log 'message))
(define (log->date log) (hash-ref log 'date))

(define (q author date . body) `(blockquote ,@body (p ,(format "--~a, ~a" author date))))
(define (<> url) `(a ((href ,url)) ,url))
(define tag-time (default-tag-function 'time))

(define footnotes '())

(define (add-footnotes tx) 
  (txexpr (get-tag tx) (get-attrs tx) 
    `(,@(get-elements tx)
        (hr)
        (section ((class "footnotes"))
          (ol ,(for/splice ([footnote (in-list footnotes)])
                  `(li ((id ,(format "fn~a" (car footnote)))) 
                       ,@(second footnote)
                       (a ((class "footnote-back")
                           (role "doc-backlink")
                           (href ,(format "#fnref~a" (car footnote))))
                            "↩︎"))))))))

(define (^ ref-num . footnote)
  (if (empty? footnote) 
    `(a ((class "footnote-ref") 
        (role "doc-noteref") 
        (id ,(format "fnref~a" ref-num))
        (href ,(format "#fn~a" ref-num)))
        (sup ,(number->string ref-num)))
      (set! footnotes (append footnotes (list (list ref-num footnote))))))

(define-syntax (for/s stx)
  (syntax-case stx ()
    [(_ thing listofthings result-expr ...)
     #'(for/splice ([thing (in-list listofthings)]) result-expr ...)]))

(define (page-url pagenode)
  (string-replace (symbol->string pagenode) "\\" "/"))

(define-syntax (for/published-posts stx)
  (syntax-case stx ()
    [(_ #:as binding result-expr ...)
      #'(for/splice
          ([binding (in-list (latest-posts))] #:when (post->published? binding))
          result-expr ...)]))

(define-syntax (codeblock stx)
  (syntax-case stx ()
    [(_ lang code ...)
      #'(highlight #:python-executable (if (equal? (system-type) 'windows) "python.exe" "python3") 
                   #:line-numbers? #f lang code ...)]))