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