1 6b4d9ef2 2020-11-09 op (in-package #:phos/gemtext)
  2 6b4d9ef2 2020-11-09 op 
  3 6b4d9ef2 2020-11-09 op (defclass element ()
  4 6b4d9ef2 2020-11-09 op   ((text :initarg :text)))
  5 6b4d9ef2 2020-11-09 op 
  6 6b4d9ef2 2020-11-09 op (defclass title (element)
  7 6b4d9ef2 2020-11-09 op   ((level :initarg :level)))
  8 6b4d9ef2 2020-11-09 op 
  9 6b4d9ef2 2020-11-09 op (defclass link (element)
 10 6b4d9ef2 2020-11-09 op   ((url :initarg :url)))
 11 6b4d9ef2 2020-11-09 op 
 12 6b4d9ef2 2020-11-09 op (defclass item (element)
 13 6b4d9ef2 2020-11-09 op   ())
 14 6b4d9ef2 2020-11-09 op 
 15 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
 16 6b4d9ef2 2020-11-09 op   ())
 17 6b4d9ef2 2020-11-09 op 
 18 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
 19 6b4d9ef2 2020-11-09 op   ((alt :initarg :alt)))
 20 6b4d9ef2 2020-11-09 op 
 21 6b4d9ef2 2020-11-09 op (defun parse-title (s)
 22 6b4d9ef2 2020-11-09 op   "Parse a line into a title."
 23 6b4d9ef2 2020-11-09 op   (destructuring-bind (h text)
 24 6b4d9ef2 2020-11-09 op       (cl-ppcre:split "\\s+" s :limit 2)
 25 6b4d9ef2 2020-11-09 op     (make-instance 'title :level (length h)
 26 6b4d9ef2 2020-11-09 op                           :text text)))
 27 6b4d9ef2 2020-11-09 op 
 28 6b4d9ef2 2020-11-09 op (defun make-link (url &optional text)
 29 6b4d9ef2 2020-11-09 op   (make-instance 'link :url (quri:uri url)
 30 6b4d9ef2 2020-11-09 op                        :text text))
 31 6b4d9ef2 2020-11-09 op 
 32 6b4d9ef2 2020-11-09 op (defun parse-link (s)
 33 6b4d9ef2 2020-11-09 op   "Parse a line into link."
 34 6b4d9ef2 2020-11-09 op   (match (cl-ppcre:split "\\s+" s :limit 3)
 35 6b4d9ef2 2020-11-09 op     ((list _ url)      (make-link url))
 36 6b4d9ef2 2020-11-09 op     ((list _ url text) (make-link url text))))
 37 6b4d9ef2 2020-11-09 op 
 38 6b4d9ef2 2020-11-09 op (defun parse-item (s)
 39 6b4d9ef2 2020-11-09 op   "Parse a line into an item"
 40 6b4d9ef2 2020-11-09 op   (match (cl-ppcre:split "\\s+" s :limit 2)
 41 6b4d9ef2 2020-11-09 op     ((list _ text) (make-instance 'item :text text))))
 42 6b4d9ef2 2020-11-09 op 
 43 6b4d9ef2 2020-11-09 op (defun parse-line (s)
 44 6b4d9ef2 2020-11-09 op   (if (string= s "")
 45 6b4d9ef2 2020-11-09 op       (make-instance 'paragraph :text s)
 46 6b4d9ef2 2020-11-09 op       (case (char s 0)
 47 6b4d9ef2 2020-11-09 op         (#\# (parse-title s))
 48 6b4d9ef2 2020-11-09 op         (#\= (parse-link s))
 49 6b4d9ef2 2020-11-09 op         (#\* (parse-item s))
 50 6b4d9ef2 2020-11-09 op         (otherwise (make-instance 'paragraph :text s)))))
 51 6b4d9ef2 2020-11-09 op 
 52 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
 53 6b4d9ef2 2020-11-09 op   `(uiop:string-prefix-p "```" ,line))
 54 6b4d9ef2 2020-11-09 op 
 55 6b4d9ef2 2020-11-09 op (defun parse (in)
 56 6b4d9ef2 2020-11-09 op   "Parse gemtext from the stream IN."
 57 6b4d9ef2 2020-11-09 op   (loop with doc = nil
 58 6b4d9ef2 2020-11-09 op         for line = (read-line in nil)
 59 6b4d9ef2 2020-11-09 op         unless line
 60 6b4d9ef2 2020-11-09 op           return (nreverse doc)
 61 6b4d9ef2 2020-11-09 op         do (push
 62 6b4d9ef2 2020-11-09 op             (if (markerp line)
 63 6b4d9ef2 2020-11-09 op                 (loop with label = (subseq line 3)
 64 6b4d9ef2 2020-11-09 op                       with content = nil
 65 6b4d9ef2 2020-11-09 op                       for line = (read-line in nil)
 66 6b4d9ef2 2020-11-09 op                       unless line
 67 6b4d9ef2 2020-11-09 op                         do (error "non-closed verbatim")
 68 6b4d9ef2 2020-11-09 op                       when (markerp line)
 69 6b4d9ef2 2020-11-09 op                         return (make-instance 'verbatim
 70 6b4d9ef2 2020-11-09 op                                               :alt label
 71 6b4d9ef2 2020-11-09 op                                               :text (format nil "~{~A~%~^~}" content))
 72 6b4d9ef2 2020-11-09 op                       do (push line content))
 73 6b4d9ef2 2020-11-09 op                 (parse-line line))
 74 6b4d9ef2 2020-11-09 op             doc)))
 75 6b4d9ef2 2020-11-09 op 
 76 6b4d9ef2 2020-11-09 op (defun parse-string (str)
 77 6b4d9ef2 2020-11-09 op   (with-input-from-string (s str)
 78 6b4d9ef2 2020-11-09 op     (parse s)))
 79 6b4d9ef2 2020-11-09 op 
 80 6b4d9ef2 2020-11-09 op ;; (unparse
 81 6b4d9ef2 2020-11-09 op ;;  (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi")
 82 6b4d9ef2 2020-11-09 op ;;    (parse stream))
 83 6b4d9ef2 2020-11-09 op ;;  *standard-output*)
 84 6b4d9ef2 2020-11-09 op 
 85 6b4d9ef2 2020-11-09 op (defgeneric unparse (obj stream)
 86 6b4d9ef2 2020-11-09 op   (:documentation "Print a textual representation of OBJ onto STREAM."))
 87 6b4d9ef2 2020-11-09 op 
 88 6b4d9ef2 2020-11-09 op (defmethod unparse ((l list) stream)
 89 6b4d9ef2 2020-11-09 op   (dolist (item l)
 90 6b4d9ef2 2020-11-09 op     (unparse item stream)))
 91 6b4d9ef2 2020-11-09 op 
 92 6b4d9ef2 2020-11-09 op (defmethod unparse ((title title) stream)
 93 6b4d9ef2 2020-11-09 op   (with-slots (text level) title
 94 6b4d9ef2 2020-11-09 op     (dotimes (_ level)
 95 6b4d9ef2 2020-11-09 op       (format stream "#"))
 96 6b4d9ef2 2020-11-09 op     (format stream " ~a~%" text)))
 97 6b4d9ef2 2020-11-09 op 
 98 6b4d9ef2 2020-11-09 op (defmethod unparse ((link link) stream)
 99 6b4d9ef2 2020-11-09 op   (with-slots (url text) link
100 6b4d9ef2 2020-11-09 op     (format stream "=> ~a ~a~%" url text)))
101 6b4d9ef2 2020-11-09 op 
102 6b4d9ef2 2020-11-09 op (defmethod unparse ((item item) stream)
103 6b4d9ef2 2020-11-09 op   (with-slots (text) item
104 6b4d9ef2 2020-11-09 op     (format stream "* ~a" text)
105 6b4d9ef2 2020-11-09 op     (terpri)))
106 6b4d9ef2 2020-11-09 op 
107 6b4d9ef2 2020-11-09 op (defmethod unparse ((p paragraph) stream)
108 6b4d9ef2 2020-11-09 op   (with-slots (text) p
109 6b4d9ef2 2020-11-09 op     (format stream "~a" text)
110 6b4d9ef2 2020-11-09 op     (terpri)))
111 6b4d9ef2 2020-11-09 op 
112 6b4d9ef2 2020-11-09 op (defmethod unparse ((v verbatim) stream)
113 6b4d9ef2 2020-11-09 op   (with-slots (alt text) v
114 6b4d9ef2 2020-11-09 op     (format stream "```~a~%~a```~%" alt text)))