From 41e092975dc9b1d58f1b0aaa9dacd4806412feeb Mon Sep 17 00:00:00 2001 From: w6vvn Date: Wed, 3 Sep 2025 20:04:05 -0700 Subject: [PATCH] cutting pasting and renaming as we start to define architectural boundaries --- gem300.rkt | 202 +---------------------------------------------------- gmi.rkt | 140 +++++++++++++++++++++++++++++++++++++ net.rkt | 71 +++++++++++++++++++ 3 files changed, 214 insertions(+), 199 deletions(-) create mode 100644 gmi.rkt create mode 100644 net.rkt diff --git a/gem300.rkt b/gem300.rkt index 3db3b5e..d79ba7d 100644 --- a/gem300.rkt +++ b/gem300.rkt @@ -1,207 +1,11 @@ #lang racket -(require openssl) -(require net/url) - -(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)) +(require (prefix-in net: "net.rkt") + (prefix-in gmi: "gmi.rkt")) (define commands (list - (cons "default" (lambda (line) (void))) - (cons "go" (lambda (line) - (request line))))) + (cons "default" (lambda (line) (void))))) (define (dispatch-command line) (let ([split (string-split line " ")]) diff --git a/gmi.rkt b/gmi.rkt new file mode 100644 index 0000000..9a1d6b4 --- /dev/null +++ b/gmi.rkt @@ -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)) diff --git a/net.rkt b/net.rkt new file mode 100644 index 0000000..594d81f --- /dev/null +++ b/net.rkt @@ -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))