(defpackage :net.acdw.clarence
  (:nicknames #:clarence)
  (:use :cl))
(in-package :net.acdw.clarence)

(defparameter *tags*
  '(("###" . :h3)
    ("##" . :h2)
    ("#" . :h1)
    ("=>" . :link)
    ("> " . :quote)
    ("* " . :list)
    ("```" . :verbatim))
  "Alist of source sigil to internal tags.")

(defclass gemtext ()
  ((tag :accessor tag
        :initarg :tag
        :initform nil
        :type (or null keyword))
   (text :accessor text
         :initarg :text
         :initform ""
         :type string))
  (:documentation "Base class of all gemtext types."))

(defclass line (gemtext)
  ((content :initform "")))

(defclass gemcollection ()
  ((content :accessor content
            :initarg :content
            :initform ())))

(defclass stanza (gemtext gemcollection))

(defclass document (gemtext gemcollection))

(defclass link (line)
  ((tag :initform :link)
   (href :initarg href
         :initform ""
         :type string)))

(defclass verbatim (stanza)
  ((tag :initform :verbatim)
   (alt :initarg alt
        :initform ""
        :type string)
   (open :initarg open
         :initform ""
         :type string)
   (close :initarg close
          :initform ""
          :type string)))

(defun parse-tag (string)
  "Return the tag of STRING by consulting *TAGS*."
  (loop for (sigil . tag) in *tags*
        when (uiop:string-prefix-p sigil string)
          do (return tag)))

(defgeneric blankp (x)
  (:documentation "Return wheter X is blank, i.e., it has no text.")
  (:method ((x gemtext))
    (or (tag-equal x :blank)
        (zerop (length (text x)))))
  )

(defgeneric tag-equal (a b)
  (:documentation "Return whether the tags of A and B are eq.")
  (:method ((a null) b) nil)
  (:method ((b null) a) nil)
  (:method ((a symbol) (b symbol))
    (eq a b))
  (:method ((a symbol) (b tagged-content))
    (eq a (slot-value b 'tag)))
  (:method ((a tagged-content) (b symbol))
    (eq (slot-value a 'tag) b))
  (:method ((a tagged-content) (b tagged-content))
    (eq (slot-value a 'tag) (slot-value b 'tag)))
  (:method ((a string) b)
    (tag-equal (parse-tag a) b))
  (:method (a (b string))
    (tag-equal a (parse-tag b))))

(defun parse-line (string &optional verbatimp)
  (let* ((tag (parse-tag string))
         (text (chomp (subseq string (length (car (rassoc tag *tags*)))))))
    (cond
      (verbatimp
       (make-instance 'line :tag :verbatim :text text))
      ((tag-equal tag :link)
       (let* ((%split-line (cl-ppcre:split "\\s" text))
              (href (chomp (car %split-line)))
              (text (if (cdr %split-line)
                        (chomp (format nil "~{~A~^ ~}" (cdr %split-line)))
                        href)))
         (make-instance 'link :href href :text text))))))