168 lines
5.0 KiB
Racket
168 lines
5.0 KiB
Racket
#lang racket
|
|
|
|
(require openssl)
|
|
(require net/url)
|
|
|
|
(struct text (str))
|
|
(struct link (url str))
|
|
(struct preformatted (str))
|
|
|
|
(define (parse-url line)
|
|
(let ([split (string-split (substring line 2))])
|
|
;; there are necessarily at least two elements
|
|
;; in the split (the => and the URL) otherwise
|
|
;; its just text.
|
|
(if (>= (length split) 2)
|
|
(link (second split)
|
|
;; if there are at least three elements in the split,
|
|
;; that means that everything after the URL is text.
|
|
(if (>= (length split) 3)
|
|
(string-join (drop split 2))
|
|
#f))
|
|
(text line))))
|
|
|
|
|
|
(define (gemtext-parse lines)
|
|
(define (iter document lines state)
|
|
;; when there are no more lines, we have finished parsing.
|
|
(if (empty? lines)
|
|
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) "```")))
|
|
|
|
(iter document
|
|
(cdr lines)
|
|
'normal)]
|
|
|
|
;; 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 (preformatted (cons (car lines)
|
|
(preformatted-str (car document))))
|
|
(cdr document))
|
|
(cdr lines)
|
|
'preformatted)]
|
|
|
|
;; rest of this is normal mode
|
|
|
|
;; link lines
|
|
[(string-prefix? (car lines) "=>")
|
|
(iter (cons (parse-url (car lines))
|
|
document)
|
|
(cdr lines)
|
|
'normal)]
|
|
|
|
;; preformatting toggle lines
|
|
[(string-prefix? (car lines) "```")
|
|
;; add preformatted block to document and toggle mode
|
|
(iter (cons (preformatted (list)) document)
|
|
(cdr lines)
|
|
'preformatted)]
|
|
|
|
[else
|
|
(iter (cons (text (car lines))
|
|
document)
|
|
(cdr lines)
|
|
'normal)])))
|
|
|
|
(displayln (iter (list) lines 'normal)))
|
|
|
|
(define (request url-str)
|
|
(define url (string->url url-str))
|
|
(define-values (c-in c-out)
|
|
(ssl-connect (url-host url)
|
|
(or (url-port url) 1965)))
|
|
|
|
(write-string url-str c-out)
|
|
(write-string "\r\n" c-out)
|
|
|
|
(define-values (status header)
|
|
(read-response c-in))
|
|
|
|
(println status)
|
|
(println header)
|
|
|
|
c-in)
|
|
|
|
(define (read-response (c-in (current-input-port)))
|
|
(define maxlen 1027)
|
|
|
|
(let ([header (peek-string maxlen 0 c-in)])
|
|
|
|
(if (not (string-contains? header "\r\n"))
|
|
(error "header exceeds maximum length")
|
|
|
|
(let ([header (read-line c-in 'return-linefeed)])
|
|
(define-values (status meta)
|
|
(let ([status-meta (string-split header " ")])
|
|
(values (car status-meta)
|
|
(string-join (cdr status-meta)))))
|
|
|
|
(cond
|
|
[(> (string-length status) 2)
|
|
(error "status code exceeds maximum length")]
|
|
|
|
[(andmap (compose not char-numeric?) (string->list status))
|
|
(error "status code is not numeric")]
|
|
|
|
[else
|
|
(values (string->number status) meta)])))))
|
|
|
|
;; 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))))
|
|
|
|
;; join each sublist into one string, and display one string per
|
|
;; line
|
|
(for-each displayln
|
|
(map string-join (outer-iter (list) (string-split paragraph)))))
|
|
|
|
(define commands
|
|
(list
|
|
(cons "default" (lambda (line) (void)))
|
|
(cons "go" (lambda (line)
|
|
(request line)))))
|
|
|
|
(define (dispatch-command line)
|
|
(let ([split (string-split line " ")])
|
|
|
|
(let ([cmd (assoc (cond [(null? split) "default"]
|
|
[else (first split)])
|
|
commands)])
|
|
(if cmd
|
|
((cdr cmd) (string-join (cdr split)))
|
|
(displayln "no such command")))))
|
|
|
|
|
|
(define (repl)
|
|
(display "G300> ")
|
|
(dispatch-command (read-line))
|
|
(repl))
|