totally redo the line interface, go and pagination commands

gem300.rkt

@@ -1,220 +1,53 @@
 #lang racket
 
-(require openssl)
-(require net/url)
+(require (prefix-in net: "net.rkt")
+         (prefix-in gmi: "gmi.rkt"))
 
-(struct text (str))
-(struct link (url str ord))
-(struct preformatted (str))
+;; global state variable which will be an input port containing the
+;; rendered out gemtext document as it shall be shown to the user
+(define document-buffer null)
 
-(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 (go-cmd url)
+  (if (non-empty-string? url)
+      (let-values ([(status meta c-in) (net:get url)])
+        (let-values ([(document) (gmi:parse (port->lines c-in))]
+                     [(db-in db-out) (make-pipe #f)])
 
-(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)
+          (set! document-buffer db-in)
+          (parameterize ([current-output-port db-out])
+            (gmi:render 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) "```")))
+          (let ([remaining (pipe-content-length db-in)])
+            (printf "document retrieved. ~a bytes\n" remaining))
 
-           ;; 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-#)]
+          (next-cmd)))
 
-          ;; 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-#)]
+      (displayln "go where?")))
 
-          ;; 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
-  (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 (next-cmd)
+  (define (iter depth)
+    (when (> depth 0)
+      (let ()
+        (displayln (read-line document-buffer))
+        (iter (sub1 depth)))))
 
+  (iter 10)
+  (newline)
+  (let ([remaining (pipe-content-length document-buffer)])
+     (printf "~a bytes remaining\n" remaining)))
 
 (define (repl)
-  (display "G300> ")
-  (dispatch-command (read-line))
+  (display "G-300 > ")
+
+  (let ([matches (regexp-match #px"(\\w+)\\s*(.*)" (read-line))])
+    (cond
+      ;; nothing was given. default command
+      [(not matches)
+       (next-cmd)]
+
+      ;; go command
+      [(string=? (cadr matches) "go")
+       (go-cmd (caddr matches))]))
+
+
   (repl))

gmi.rkt

@@ -0,0 +1,144 @@
+#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)))
+
+;; given a document, which is a list of structs, render it out into
+;; the current output port exactly as it will be shown to the user
+(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))

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