~zainab/blog

blog/src/pollen.rkt -rw-r--r-- 4.1 KiB
d9e5070ezainab-ali Add question aside 8 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
115
116
117
118
119
120
121
122
123
124
125
126
127
#lang racket

(require pollen/core)
(require pollen/tag)
(require racket/string)
(require racket/exn)
(require txexpr)
(require pollen/unstable/pygments)
(require (only-in "structure.rkt" page-internal-id))

(provide todo
         headline
         headline2
         headline3
         headline-link
         code-references
         items
         item
         snippet
         code-inline
         keyword
         note
         external-link
         image
         diagram
         abstract
         question-block)

(module setup racket/base
  (require racket/runtime-path)
  (provide (all-defined-out))
  (define-runtime-path structure "structure.rkt")
  (define-runtime-path favicon "favicon.rkt")
  (define cache-watchlist (list structure favicon)))

;;; Author’s comments
(define (todo . text) "")

;;; Sections

(define headline (default-tag-function 'h1))
(define headline2 (default-tag-function 'h2))
(define headline3 (default-tag-function 'h3))

(define (headline-link text)
  `(h2 ([id ,(page-internal-id text)]) ,text))

;;; Lists
(define code-references (default-tag-function 'ol #:class "code-references"))
(define items (default-tag-function 'ul))
(define item (default-tag-function 'li 'p))

;; Non-breaking code snippets
(define (clean str)
  (define replacements '(("-" . "‑")
                         (" " . " ")))
  (for/fold ([current-str str])
            ([pn replacements])
    (string-replace current-str (car pn) (cdr pn))))

(define (code-inline . text)
  `(code ((class "inline")) ,@(map clean text)))

(define (snippet #:name name)
  ;; Open the source file
  (define here (select-from-metas 'here-path (current-metas)))
  (define-values (dir file b) (split-path here))
  (define snippet-path (build-path dir "snippets" (string-append name ".snippet")))
  (define text (string-trim (port->string (open-input-file snippet-path))))
  `(div ((class "buffer"))
        ,(highlight 'scala
                    #:line-numbers? #f
                    #:css-class "scala"
                    text)))

(define (keyword . text)
  ;; Can we reference the keyword in a glossary?
  `(span ([class "keyword"]) ,@(map clean text)))

(define (note #:title title . text)
  `(aside ([class "note"])
        (header (h1 ,title))
        (p ,@text)))

(define (external-link #:href href . text)
  `(a ([class "external-link"] [href ,href] [target "_blank"] ) ,@text))

(define (image #:name name . text)
  `(img ([src ,(string-append "/assets/images/" name)]
         [alt ,(apply string-append text)])))

(define (diagram #:name name . text)
  `(img ([src ,(string-append "/assets/images/" name)]
         [alt ,(apply string-append text)]
         [class "diagram"])))


(define (abstract . text)
  `(p ([class "abstract"]) ,@text))

(define (question-block . contents)
  (let* (
         [question (car (filter-map (λ (sexpr) (and (pair? sexpr)
                                                    (equal? (car sexpr) 'question)
                                                    (cdr sexpr)))
                                    contents))]
         [question-str (string-join (map (λ (x) (format "~a" x)) question) "-")]
         [answers (filter-map (λ (sexpr)
                                (and (pair? sexpr)
                                     (equal? (car sexpr) 'answer)
                                     (cdr sexpr)))
                              contents)]
         [indexed-answers (for/list ([answer answers]
                                     [idx (in-naturals)])
                            `(div ([class "answer"])
                              (input ([id ,(string-append question-str "-" (number->string idx))]
                                      [name ,question-str]
                                      [type "radio"]))
                              (label ([for ,(string-append question-str "-" (number->string idx))]) ,@answer)))])
    `(aside ([class "question"])
            (header (h1 (img ([alt ""]
                              [src "/assets/question.svg"]))
                        (span "question")
                        (img ([alt ""]
                              [src "/assets/question.svg"]))))
          (p ,@question)
          ,@indexed-answers)))