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
(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)
(if (non-empty-string? url)
(let ()
(when (not (string-contains? 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))]
[(db-in db-out) (make-pipe #f)])

53
gmi.rkt
View File

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

27
net.rkt
View File

@@ -1,6 +1,6 @@
#lang racket
(provide get)
(provide request)
(require openssl)
(require net/url-string)
@@ -9,7 +9,7 @@
;; 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 (request url-str)
(define url (string->url url-str))
(define-values (c-in c-out)
(ssl-connect (url-host url)
@@ -46,26 +46,3 @@
[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))