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