Compare commits

..

2 Commits

Author SHA1 Message Date
37e19cb279 relocate "get" logic. see message
this stumped me for quite a minute. this procedure sometimes needs to
halt execution to get input, like a server requesting input, or the
client asking for permission to follow cross site redirects. the
problem is if the get procedure is thought of as being part of the net
interface, and compartmentalized from the program loop, actually doing
that would require heavy use of continuations to go back and forth
across the boundary

i -do- think that the way i ultimately want to go in the end is using
continuations to halt execution, catch it in the user interface to get
input, and then continue. however, its a lot simpler and more
immediate to change where i'm drawing the line in the separation of
concerns. the continuations-based approach is enough of a diversion
that i haven't managed to get anything done for the last couple of hours.
2025-09-05 15:11:28 -07:00
f5cfbe76ea improve nomenclature of gmi handling module somewhat? 2025-09-05 14:12:06 -07:00
3 changed files with 52 additions and 53 deletions

View File

@@ -15,13 +15,36 @@
;; global state for the url of the currently visited document ;; global state for the url of the currently visited document
(define current-url null) (define current-url null)
(define (get url-str)
(define (iter url-str depth)
(let-values ([(status header c-in) (net: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))
(define (go-cmd url) (define (go-cmd url)
(if (non-empty-string? url) (if (non-empty-string? url)
(let () (let ()
(when (not (string-contains? url "://")) (when (not (string-contains? url "://"))
(set! url (string-append "gemini://" url))) (set! url (string-append "gemini://" url)))
(let-values ([(status meta c-in) (net:get url)]) (let-values ([(status meta c-in) (get url)])
(let-values ([(doc) (gmi:parse (port->lines c-in))] (let-values ([(doc) (gmi:parse (port->lines c-in))]
[(db-in db-out) (make-pipe #f)]) [(db-in db-out) (make-pipe #f)])

53
gmi.rkt
View File

@@ -4,15 +4,15 @@
[render (-> document? void?)] [render (-> document? void?)]
[parse (-> (listof string?) document?)] [parse (-> (listof string?) document?)]
[match-link (-> document? integer? (or/c string? #f))] [match-link (-> document? integer? (or/c string? #f))]
[struct document ((structure (listof (or/c text? link? pre?))))])) [struct document ((items (listof (or/c text? link? pre?))))]))
;; a gemtext document is represented as a list of structs, a struct ;; a gemtext document is represented as a list of structs, a struct
;; for each type of item in a document. ;; for each type of item in a document.
(struct document (structure)) (struct document (items))
(struct text (str)) (struct text (line))
(struct link (url str ord)) (struct link (url line id))
(struct pre (str)) (struct pre (lines))
;;; ;;;
;;; PARSING ;;; PARSING
@@ -29,7 +29,7 @@
link-#)))) link-#))))
(define (parse lines) (define (parse lines)
(define (iter document lines state link-#) (define (iter document lines state link-id)
;; when there are no more lines, we have finished parsing. ;; when there are no more lines, we have finished parsing.
(if (empty? lines) (if (empty? lines)
;; consing inherently makes everything backwards ;; consing inherently makes everything backwards
@@ -47,11 +47,11 @@
;; and the contents of that block are backwards ;; and the contents of that block are backwards
;; 2. take those contents, reverse them, append them to the ;; 2. take those contents, reverse them, append them to the
;; cdr of the document ;; cdr of the document
(iter (cons (pre (reverse (pre-str (car document)))) (iter (cons (pre (reverse (pre-lines (car document))))
(cdr document)) (cdr document))
(cdr lines) (cdr lines)
'normal 'normal
link-#)] link-id)]
;; add line to most recent preformat block ;; add line to most recent preformat block
[(symbol=? 'preformatted state) [(symbol=? 'preformatted state)
@@ -60,23 +60,23 @@
;; then, cons the new preformatted block to the cdr of ;; then, cons the new preformatted block to the cdr of
;; the document ;; the document
(iter (cons (pre (cons (car lines) (iter (cons (pre (cons (car lines)
(pre-str (car document)))) (pre-lines (car document))))
(cdr document)) (cdr document))
(cdr lines) (cdr lines)
'preformatted 'preformatted
link-#)] link-id)]
;; rest of this is normal mode ;; rest of this is normal mode
;; link lines ;; link lines
[(string-prefix? (car lines) "=>") [(string-prefix? (car lines) "=>")
(let ([parsed (parse-url (car lines) link-#)]) (let ([parsed (parse-url (car lines) link-id)])
(iter (cons parsed document) (iter (cons parsed document)
(cdr lines) (cdr lines)
'normal 'normal
(if (link? parsed) (if (link? parsed)
(add1 link-#) (add1 link-id)
link-#)))] link-id)))]
;; preformatting toggle lines ;; preformatting toggle lines
[(string-prefix? (car lines) "```") [(string-prefix? (car lines) "```")
@@ -84,14 +84,14 @@
(iter (cons (pre (list)) document) (iter (cons (pre (list)) document)
(cdr lines) (cdr lines)
'preformatted 'preformatted
link-#)] link-id)]
[else [else
(iter (cons (text (car lines)) (iter (cons (text (car lines))
document) document)
(cdr lines) (cdr lines)
'normal 'normal
link-#)]))) link-id)])))
(document (iter (list) lines 'normal 1))) (document (iter (list) lines 'normal 1)))
@@ -135,25 +135,24 @@
;; the current output port exactly as it will be shown to the user ;; the current output port exactly as it will be shown to the user
(define (render document) (define (render document)
(for-each (for-each
(λ (line) (λ (item)
(cond (cond
[(text? line) [(text? item)
(render-paragraph (text-str line))] (render-paragraph (text-line item))]
[(pre? line) [(pre? item)
(for-each (λ (line) (for-each displayln (pre-lines item))]
(displayln line))
(pre-str line))]
[(link? line) [(link? item)
(printf "[~a] ~a\n" (link-ord line) (link-str line))])) (printf "[~a] ~a\n" (link-id item) (link-line item))]))
(document-structure document)))
(document-items document)))
(define (match-link document id) (define (match-link document id)
(define (iter next-structure) (define (iter next-structure)
(cond (cond
[(and (link? (car next-structure)) [(and (link? (car next-structure))
(= (link-ord (car next-structure)) id)) (= (link-id (car next-structure)) id))
(link-url (car next-structure))] (link-url (car next-structure))]
[(empty? (cdr next-structure)) [(empty? (cdr next-structure))
@@ -162,4 +161,4 @@
[else [else
(iter (cdr next-structure))])) (iter (cdr next-structure))]))
(iter (document-structure document))) (iter (document-items document)))

27
net.rkt
View File

@@ -1,6 +1,6 @@
#lang racket #lang racket
(provide get) (provide request)
(require openssl) (require openssl)
(require net/url-string) (require net/url-string)
@@ -9,7 +9,7 @@
;; and the input port for the rest of the body. ;; and the input port for the rest of the body.
;; this procedure will fail if the response is malformed, however, it ;; this procedure will fail if the response is malformed, however, it
;; is not up to it to validate the contents of the response. ;; is not up to it to validate the contents of the response.
(define (send-request url-str) (define (request url-str)
(define url (string->url url-str)) (define url (string->url url-str))
(define-values (c-in c-out) (define-values (c-in c-out)
(ssl-connect (url-host url) (ssl-connect (url-host url)
@@ -46,26 +46,3 @@
[else [else
(values (string->number status) meta)]))))) (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))