145 lines
4.6 KiB
Racket
145 lines
4.6 KiB
Racket
#lang racket
|
|
|
|
(provide parse render)
|
|
|
|
;; a gemtext document is represented as a list of structs, a struct
|
|
;; for each type of item in a document.
|
|
(struct text (str))
|
|
(struct link (url str ord))
|
|
(struct pre (str))
|
|
|
|
;;;
|
|
;;; PARSING
|
|
;;;
|
|
|
|
(define (parse-url line link-#)
|
|
(let ([split (string-split (substring line 2))])
|
|
(if (empty? split)
|
|
(text line)
|
|
(link (car split)
|
|
(if (>= (length split) 2)
|
|
(string-join (cdr split))
|
|
(car split))
|
|
link-#))))
|
|
|
|
(define (parse lines)
|
|
(define (iter document lines state link-#)
|
|
;; when there are no more lines, we have finished parsing.
|
|
(if (empty? lines)
|
|
;; consing inherently makes everything backwards
|
|
(reverse document)
|
|
|
|
;; otherwise, we have a state machine to traverse.
|
|
(cond
|
|
;; turn off preformatted mode
|
|
[(and (symbol=? 'preformatted state)
|
|
(or (empty? (cdr lines))
|
|
(string-prefix? (car lines) "```")))
|
|
|
|
;; also hard to follow. at this point:
|
|
;; 1. the car of the document is necessarily a preformatted block
|
|
;; and the contents of that block are backwards
|
|
;; 2. take those contents, reverse them, append them to the
|
|
;; cdr of the document
|
|
(iter (cons (pre (reverse (pre-str (car document))))
|
|
(cdr document))
|
|
(cdr lines)
|
|
'normal
|
|
link-#)]
|
|
|
|
;; add line to most recent preformat block
|
|
[(symbol=? 'preformatted state)
|
|
;; little bit hard to follow: take the existing
|
|
;; preformatted blocks content, cons the new line;
|
|
;; then, cons the new preformatted block to the cdr of
|
|
;; the document
|
|
(iter (cons (pre (cons (car lines)
|
|
(pre-str (car document))))
|
|
(cdr document))
|
|
(cdr lines)
|
|
'preformatted
|
|
link-#)]
|
|
|
|
;; rest of this is normal mode
|
|
|
|
;; link lines
|
|
[(string-prefix? (car lines) "=>")
|
|
(let ([parsed (parse-url (car lines) link-#)])
|
|
(iter (cons parsed document)
|
|
(cdr lines)
|
|
'normal
|
|
(if (link? parsed)
|
|
(add1 link-#)
|
|
link-#)))]
|
|
|
|
;; preformatting toggle lines
|
|
[(string-prefix? (car lines) "```")
|
|
;; add preformatted block to document and toggle mode
|
|
(iter (cons (pre (list)) document)
|
|
(cdr lines)
|
|
'preformatted
|
|
link-#)]
|
|
|
|
[else
|
|
(iter (cons (text (car lines))
|
|
document)
|
|
(cdr lines)
|
|
'normal
|
|
link-#)])))
|
|
|
|
(iter (list) lines 'normal 1))
|
|
|
|
;;;
|
|
;;; RENDERING
|
|
;;;
|
|
|
|
;; takes one long string and reflows it within an 80 character wide
|
|
;; column
|
|
(define (render-paragraph paragraph)
|
|
;; collects from one list of words into another such that the new
|
|
;; list does not exceed 80 characters when joined, and returns the
|
|
;; new list and remainder of the first list
|
|
(define (inner-iter acc rst)
|
|
(let ([line (string-join acc)])
|
|
(if (or (empty? rst)
|
|
(> (string-length line) 80))
|
|
(values acc rst)
|
|
(inner-iter (append acc (list (car rst)))
|
|
(cdr rst)))))
|
|
|
|
;; collects from a list of words into sublists of words such that
|
|
;; each sublist is no greater than 80 characters when joined
|
|
(define (outer-iter acc rst)
|
|
(if (empty? rst)
|
|
acc
|
|
(let-values ([(inner-acc inner-rst)
|
|
(inner-iter (list) rst)])
|
|
(outer-iter (append acc (list inner-acc)) inner-rst))))
|
|
|
|
;; the algorithm implemented here does not work for empty
|
|
;; paragraphs. thus, they are handled as a special case here.
|
|
(if (non-empty-string? paragraph)
|
|
;; join each sublist into one string, and display one string per
|
|
;; line
|
|
(for-each displayln
|
|
(map string-join (outer-iter (list) (string-split paragraph))))
|
|
(newline)))
|
|
|
|
;; given a document, which is a list of structs, render it out into
|
|
;; the current output port exactly as it will be shown to the user
|
|
(define (render document)
|
|
(for-each
|
|
(λ (line)
|
|
(cond
|
|
[(text? line)
|
|
(render-paragraph (text-str line))]
|
|
|
|
[(pre? line)
|
|
(for-each (λ (line)
|
|
(displayln line))
|
|
(pre-str line))]
|
|
|
|
[(link? line)
|
|
(printf "[~a] ~a\n" (link-ord line) (link-str line))]))
|
|
document))
|