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