gem300/gem300.rkt

#lang racket

(require openssl)
(require net/url)

(struct text (str))
(struct link (url str))
(struct preformatted (str))

(define (parse-url line)
  (let ([split (string-split (substring line 2))])
    ;; there are necessarily at least two elements
    ;; in the split (the => and the URL) otherwise
    ;; its just text.
    (if (>= (length split) 2)
        (link (second split)
              ;; if there are at least three elements in the split,
              ;; that means that everything after the URL is text.
              (if (>= (length split) 3)
                  (string-join (drop split 2))
                  #f))
        (text line))))


(define (gemtext-parse lines)
  (define (iter document lines state)
    ;; 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))))
                       document)
                 (cdr lines)
                 'normal)]

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

          ;; rest of this is normal mode

          ;; link lines
          [(string-prefix? (car lines) "=>")
           (iter (cons (parse-url (car lines))
                       document)
                 (cdr lines)
                 'normal)]

          ;; preformatting toggle lines
          [(string-prefix? (car lines) "```")
           ;; add preformatted block to document and toggle mode
           (iter (cons (preformatted (list)) document)
                 (cdr lines)
                 'preformatted)]

          [else
           (iter (cons (text (car lines))
                       document)
                 (cdr lines)
                 'normal)])))

  (displayln (iter (list) lines 'normal)))

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

  (println status)
  (println 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)])))))

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

  ;; join each sublist into one string, and display one string per
  ;; line
  (for-each displayln
   (map string-join (outer-iter (list) (string-split paragraph)))))

(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 (repl)
  (display "G300> ")
  (dispatch-command (read-line))
  (repl))