◊(Local Yarn Code "Artifact [cf9a317e]")

Artifact cf9a317eb131a906e14e5b6f42f588a9242ad6ef70dedfd56ce15c6270b7e8fc:


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

(provide doc->html)

;; TODO: most of this should all go into the template code
(define (doc->html doc)
  (define-values (title-type class)
    (if (meta-set? 'title-supplied?)
        (values 'given "with-title")
        (values 'generated "no-title")))
  (haml
   (:article.h-entry
    [[:class class]]
    ,@(heading/permlink title-type)
    (:section.entry-content
     ,@(decode-elements #:block-txexpr-proc render-block
                        #:inline-txexpr-proc render-inline
                        (cdr doc))))))

;; TODO: This should really go into the template code
(define (heading/permlink title-type)
  (define m (current-metas))
  (define p (hash-ref m 'published))
  (case title-type
    [(given)
     (haml
      (:h1.entry-title ,@(hash-ref m 'title))
      (:p.time
       (:a.rel-bookmark
        [[:href (string-append "/" (here-output-path))]]
        (:time.published [[:datetime p]] (ymd->english p)))))]
    [(generated)
     (haml
      (:h1
       (:a.rel-bookmark
        [[:href (string-append "/" (here-output-path))]]
        (:time.entry-title [[:datetime p]] (ymd->english p)))))]))

;;  Block-Content := 
;;    ✅ (heading level Inline-Contents)
;;    | ✅ (paragraph Inline-Contents)
;;    | ✅ (thematic-break style)
;;    | ✅ (codeblock info Inline-Contents)
;;    | ✅ (blockquote items := (item Block-Contents))
;;    | ✅ (poetry title style Block-Contents)
;;    | ✅ (itemization style start Block-Contents)
;;    | ✅ (dialogue speeches := (speech interlocutor Block-Contents))
;;    | ✅ (figure source caption)
;;    | (margin-note Block-Contents)

(define (render-block e)
  (match e
    [(list 'heading (list (list 'level lev)) elems ...) (render-heading lev elems)]
    [(list 'paragraph elems ...) `(p ,@elems)]
    [(list 'thematic-break style) `(hr [[class ,style]])]
    [(list 'blockquote elems ...) `(blockquote ,@elems)]
    [(txexpr 'poetry attrs elems) (render-poetry attrs elems)]
    [(txexpr 'codeblock attrs elems) (render-codeblock attrs elems)]
    [(txexpr 'itemization attrs elems) (render-itemization attrs elems)]
    [(txexpr 'dialogue _ elems) `(dl ,@elems)]
    [(list 'speech interlocutor elems ...)
     `(@ (dt ,interlocutor (span [[class "x"]] ": ")) (dd ,@elems))]
    [(txexpr 'figure attrs elems) (render-figure (car elems) (cdr elems))]
    [else (raise-argument-error 'render-block "block-content" e)]))

;;  Inline-Content :=
;;    string?
;;    |  ✅ (italic Inline-Contents) 
;;    |  ✅ (bold Inline-Contents)
;;    |  ✅ (link destination Inline-Contents)
;;    |  ✅ (monospace Inline-Contents)  
;;    |  ✅ (strikethrough Inline-Contents)
;;    |  ✅ (caps Inline-Contents)
;;    | (image description source)
;;    | ✅ (xref type dest-key Inline-Contents)
;;    | ✅ (footnote-ref label)
;;    | line-break

(define (render-inline e)
  (match e
    [(list 'italic elems ...) `(i ,@elems)]
    [(list 'bold elems ...) `(b ,@elems)]
    [(list 'monospace elems ...) `(samp ,@elems)]
    [(list 'strikethrough elems ...) `(del ,@elems)]
    [(list 'caps elems ...) `(span [[class "caps"]] ,@elems)]
    [(list 'link dest elems ...) (render-link dest elems)]
    [(list 'xref type key elems ...) (render-xref type key elems)]
    [(list 'footnote-ref ref) (render-footnote-ref ref)]
    [(list 'item elems ...) `(li ,@elems)]
    [else e]))

(define (render-link dest elems)
  (define url
    (or (get-metas-subhash 'urls dest)
        (format "#Missing_Reference_~a" dest)))
  `(a [[href ,url]] ,@elems))

(define (render-heading level elems)
  (define tag (string->symbol (format "h~a" level)))
  `(,tag ,@elems))

(define (render-poetry attrs elems)
  (define title
    (match (attr-ref attrs 'title attrs #f)
      [(? string? t) `(p [[class "verse-heading"]] ,t)]
      [_ ""]))
  (define pre-attrs
    (cond
      [(string-contains? (attr-ref attrs 'style "") "italic")
       '((style "font-style: italic"))]
      [else '()]))
  `(div [[class "poem"]] ,title (pre [[class "verse"] ,@pre-attrs] ,@elems)))

(define (render-codeblock attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(non-empty-string? file) `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))

(define (render-itemization attrs elems)
  (define tag (if (attr-ref attrs 'start #f) 'ol 'ul))
  `(,tag ,attrs ,@elems))
  
(define (render-figure source elems)
  `(figure [[class "fullwidth"]]
           (img [[src ,source]] [[alt ,(->text elems)]])
           (figcaption ,@elems)))

;; The AST guarantees that they key will already be URI-safe
(define (render-xref type key elems)
  `(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))))