w6vvn/gem300
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cutting pasting and renaming as we start to define architectural boundaries

Browse Source
This commit is contained in:
w6vvn
2025-09-03 20:04:05 -07:00
parent c80d07befb
commit 41e092975d
3 changed files with 214 additions and 199 deletions
Download Patch File Download Diff File Expand all files Collapse all files

202
gem300.rkt
View File

@@ -1,207 +1,11 @@
#lang racket #lang racket
(require openssl) (require (prefix-in net: "net.rkt")
(require net/url) (prefix-in gmi: "gmi.rkt"))
(struct text (str))
(struct link (url str ord))
(struct preformatted (str))
(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 (gemtext-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 (preformatted (reverse (preformatted-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 (preformatted (cons (car lines)
(preformatted-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 (preformatted (list)) document)
(cdr lines)
'preformatted
link-#)]
[else
(iter (cons (text (car lines))
document)
(cdr lines)
'normal
link-#)])))
(iter (list) lines 'normal 1))
;; sends a request to a gemini server, and returns the status, header,
;; and the input port for the rest of the body.
;; this procedure will fail if the response is malformed, however, it
;; is not up to it to validate the contents of the response.
(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))
(values status header c-in))
(define (go-cmd url-str)
(define (iter url-str depth)
(let-values ([(status header c-in) (request url-str)])
;; TODO there are bunch of other status codes to deal with for
;; compliance
(cond
;; clients MUST reject status codes outside of the 10-69 range
[(or (< status 10)
(> status 69))
(error "server returned invalid status code")]
;; 30-39 redirection
[(and (>= status 30)
(<= status 39))
(if (> depth 5)
(error "maximum redirection depth exceeded")
(iter header (sub1 depth)))]
[else
(values status header c-in)])))
(let-values ([(status header c-in) (iter url-str 5)])
(render-gemtext (gemtext-parse (port->lines 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))))
;; 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)))
(define (render-gemtext document)
(for-each (λ (line)
(cond [(text? line)
(render-paragraph (text-str line))]
[(preformatted? line)
(for-each (λ (line)
(displayln line))
(preformatted-str line))]
[(link? line)
(printf "[~a] ~a\n" (link-ord line) (link-str line))]))
document))
(define commands (define commands
(list (list
(cons "default" (lambda (line) (void))) (cons "default" (lambda (line) (void)))))
(cons "go" (lambda (line)
(request line)))))
(define (dispatch-command line) (define (dispatch-command line)
(let ([split (string-split line " ")]) (let ([split (string-split line " ")])

140
gmi.rkt Normal file
View File

@@ -0,0 +1,140 @@
#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)))
(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))

71
net.rkt Normal file
View File

@@ -0,0 +1,71 @@
#lang racket
(provide get)
(require openssl)
(require net/url)
;; sends a request to a gemini server, and returns the status, header,
;; and the input port for the rest of the body.
;; this procedure will fail if the response is malformed, however, it
;; is not up to it to validate the contents of the response.
(define (send-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))
(values status 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)])))))
(define (get url-str)
(define (iter url-str depth)
(let-values ([(status header c-in) (send-request url-str)])
;; TODO there are bunch of other status codes to deal with for
;; compliance
(cond
;; clients MUST reject status codes outside of the 10-69 range
[(or (< status 10)
(> status 69))
(error "server returned invalid status code")]
;; 30-39 redirection
[(and (>= status 30)
(<= status 39))
(if (> depth 5)
(error "maximum redirection depth exceeded")
(iter header (sub1 depth)))]
[else
(values status header c-in)])))
(iter url-str 5))