162 lines
5.3 KiB
Racket
162 lines
5.3 KiB
Racket
#lang racket
|
|
|
|
(provide (contract-out
|
|
[render (-> document? void?)]
|
|
[parse (-> input-port? document?)]
|
|
[match-link (-> document? integer? (or/c url? #f))]
|
|
[struct document ((items (listof (or/c text? link? pre?))))]))
|
|
|
|
(require net/url-string)
|
|
|
|
;; a gemtext document is represented as a list of structs, a struct
|
|
;; for each type of item in a document.
|
|
(struct document (items))
|
|
|
|
(struct text (line))
|
|
(struct link (url line id))
|
|
(struct pre (lines))
|
|
|
|
;;;
|
|
;;; PARSING
|
|
;;;
|
|
|
|
(define (parse-url line link-#)
|
|
(let ([split (string-split (substring line 2))])
|
|
(if (empty? split)
|
|
(text line)
|
|
(link (string->url (car split))
|
|
(if (>= (length split) 2)
|
|
(string-join (cdr split))
|
|
(car split))
|
|
link-#))))
|
|
|
|
(define (parse body-port)
|
|
(define (iter document lines state link-id)
|
|
;; 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-lines (car document))))
|
|
(cdr document))
|
|
(cdr lines)
|
|
'normal
|
|
link-id)]
|
|
|
|
;; 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-lines (car document))))
|
|
(cdr document))
|
|
(cdr lines)
|
|
'preformatted
|
|
link-id)]
|
|
|
|
;; rest of this is normal mode
|
|
|
|
;; link lines
|
|
[(string-prefix? (car lines) "=>")
|
|
(let ([parsed (parse-url (car lines) link-id)])
|
|
(iter (cons parsed document)
|
|
(cdr lines)
|
|
'normal
|
|
(if (link? parsed)
|
|
(add1 link-id)
|
|
link-id)))]
|
|
|
|
;; preformatting toggle lines
|
|
[(string-prefix? (car lines) "```")
|
|
;; add preformatted block to document and toggle mode
|
|
(iter (cons (pre (list)) document)
|
|
(cdr lines)
|
|
'preformatted
|
|
link-id)]
|
|
|
|
[else
|
|
(iter (cons (text (car lines))
|
|
document)
|
|
(cdr lines)
|
|
'normal
|
|
link-id)])))
|
|
|
|
(document (iter (list) (port->lines body-port) '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
|
|
(λ (item)
|
|
(cond
|
|
[(text? item)
|
|
(render-paragraph (text-line item))]
|
|
|
|
[(pre? item)
|
|
(for-each displayln (pre-lines item))]
|
|
|
|
[(link? item)
|
|
(render-paragraph
|
|
(let ([scheme (url-scheme (link-url item))])
|
|
(if (or (not scheme)
|
|
(string=? scheme "gemini"))
|
|
(format "[~a] ~a\n" (link-id item) (link-line item))
|
|
(format "[~a ~a] ~a\n" (link-id item) scheme (link-line item)))))]))
|
|
|
|
(document-items document)))
|
|
|
|
(define (match-link document id)
|
|
(let ([link (findf (λ (link) (= (link-id link) id))
|
|
(filter link? (document-items document)))])
|
|
(if link (link-url link) #f)))
|