Add constructors for each node

common-doc.asd

@@ -19,6 +19,7 @@
                  (:file "error")
                  (:file "file")
                  (:file "classes")
+                 (:file "constructors")
                  (:file "macros")
                  (:file "format")
                  (:file "util")

contrib/split-paragraphs/split-paragraphs.lisp

@@ -63,7 +63,7 @@ leaving a paragraph marker between each string."
   "Return whether a list has paragraph markers."
   (if (member +paragraph-marker+ list) t))
 
-(defun make-paragraph (contents)
+(defun create-paragraph (contents)
   (cond
     ((null contents)
      nil)
@@ -84,7 +84,7 @@ paragraph nodes."
           (cond
             ((equal elem +paragraph-marker+)
              ;; End of the paragraph
-             (push (make-paragraph (reverse current-paragraph-contents))
+             (push (create-paragraph (reverse current-paragraph-contents))
                    output)
              (setf current-paragraph-contents nil))
             ((or (typep elem 'code-block)
@@ -94,15 +94,15 @@ paragraph nodes."
                  (typep elem 'table)
                  (typep elem 'section))
              ;; Another end of paragraph
-             (push (make-paragraph (reverse current-paragraph-contents))
+             (push (create-paragraph (reverse current-paragraph-contents))
                    output)
              (setf current-paragraph-contents nil)
              (push elem output))
             (t
              ;; Another node, so just push it in the paragraph
              (push elem current-paragraph-contents))))
         (when current-paragraph-contents
-          (push (make-paragraph (reverse current-paragraph-contents))
+          (push (create-paragraph (reverse current-paragraph-contents))
                 output))
         (remove-if #'null (reverse output)))
       list))

src/constructors.lisp

@@ -0,0 +1,145 @@
+(in-package :common-doc)
+
+;;; Utilities
+
+(defun construct (class children metadata)
+  "Instantiate a class with children and metadata."
+  (make-instance class :children children :metadata metadata))
+
+;;; Interface
+
+(defun make-meta (pairs)
+  "Create a metadata table from a list of pairs. If the list is empty, return an
+empty metadata table."
+  (let ((table (make-hash-table :test #'equal)))
+    (loop for pair in pairs do
+      (setf (gethash (first pair) table) (rest pair)))
+    table))
+
+(defun make-content (children &key metadata)
+  "Create a content node from its children."
+  (construct 'content-node children metadata))
+
+(defun make-text (string &key metadata)
+  "Create a text node from the contents of a string."
+  (make-instance 'text-node
+                 :text string
+                 :metadata metadata))
+
+(defun make-paragraph (children &key metadata)
+  "Create a paragraph node from its children."
+  (construct 'paragraph children metadata))
+
+(defun make-bold (children &key metadata)
+  "Create a bold node from its children."
+  (construct 'bold children metadata))
+
+(defun make-italic (children &key metadata)
+  "Create an italicized node from its children."
+  (construct 'italic children metadata))
+
+(defun make-underline (children &key metadata)
+  "Create an underlined node from its children."
+  (construct 'underline children metadata))
+
+(defun make-strikethrough (children &key metadata)
+  "Create an striked out node from its children."
+  (construct 'strikethrough children metadata))
+
+(defun make-code (children &key metadata)
+  "Create an inline code node from its children."
+  (construct 'code children metadata))
+
+(defun make-superscript (children &key metadata)
+  "Create a superscripted node from its children."
+  (construct 'superscript children metadata))
+
+(defun make-subscript (children &key metadata)
+  "Create a subscripted node from its children."
+  (construct 'subscript children metadata))
+
+(defun make-code-block (language children &key metadata)
+  "Create a code block node from its children and language."
+  (make-instance 'code-block
+                 :language language
+                 :children children
+                 :metadata metadata))
+
+(defun make-inline-quote (children &key metadata)
+  "Create an inline quote node from its children."
+  (construct 'inline-quote children metadata))
+
+(defun make-block-quote (children &key metadata)
+  "Create a block quote node from its children."
+  (construct 'block-quote children metadata))
+
+(defun make-document-link (document section children &key metadata)
+  "Create a document link from document and section references and its children."
+  (make-instance 'document-link
+                 :document-reference document
+                 :section-reference section
+                 :children children
+                 :metadata metadata))
+
+(defun make-web-link (uri children &key metadata)
+  "Create a web link."
+  (make-instance 'web-link
+                 :uri (quri:uri uri)
+                 :children children
+                 :metadata metadata))
+
+(defun make-list-item (children &key metadata)
+  (construct 'list-item children metadata))
+
+(defun make-definition (term definition &key metadata)
+  (make-instance 'definition
+                 :term term
+                 :definition definition
+                 :metadata metadata))
+
+(defun make-unordered-list (children &key metadata)
+  (construct 'unordered-list children metadata))
+
+(defun make-ordered-list (children &key metadata)
+  (construct 'ordered-list children metadata))
+
+(defun make-definition-list (children &key metadata)
+  (construct 'definition-list children metadata))
+
+(defun make-image (source &key description metadata)
+  (make-instance 'image
+                 :source source
+                 :description description
+                 :metadata metadata))
+
+(defun make-figure (image description &key metadata)
+  (make-instance 'figure
+                 :image image
+                 :description description
+                 :metadata metadata))
+
+(defun make-table (rows &key metadata)
+  (make-instance 'table
+                 :rows rows
+                 :metadata metadata))
+
+(defun make-row (cells &key metadata)
+  (make-instance 'row
+                 :cells cells
+                 :metadata metadata))
+
+(defun make-cell (children &key metadata)
+  (construct 'cell children metadata))
+
+(defun make-section (title &key children reference metadata)
+  (make-instance 'section
+                 :title title
+                 :reference reference
+                 :children children
+                 :metadata metadata))
+
+(defun make-document (title &key children keywords &allow-other-keys)
+  (make-instance 'document
+                 :title title
+                 :children children
+                 :keywords keywords))

src/operations/toc.lisp

@@ -79,9 +79,10 @@ call fill-unique-refs first."
                            (filter-depth list max-depth)
                            list))))
     (make-instance 'ordered-list
-                   :metadata (common-doc.util:make-meta (list (cons "class" "toc")))
+                   :metadata (make-meta (list (cons "class" "toc")))
                    :children (loop for child in (if (listp toc)
                                                     toc
                                                     (children toc))
                                    collecting
-                               (make-instance 'list-item :children (list child))))))
+                                   (make-instance 'list-item
+                                                  :children (list child))))))

src/packages.lisp

@@ -62,6 +62,35 @@
            :rights
            :version
            :created-on)
+  ;; Constructors
+  (:export :make-meta
+           :make-content
+           :make-text
+           :make-paragraph
+           :make-bold
+           :make-italic
+           :make-underline
+           :make-strikethrough
+           :make-code
+           :make-superscript
+           :make-subscript
+           :make-code-block
+           :make-inline-quote
+           :make-block-quote
+           :make-document-link
+           :make-web-link
+           :make-list-item
+           :make-definition
+           :make-unordered-list
+           :make-ordered-list
+           :make-definition-list
+           :make-image
+           :make-figure
+           :make-table
+           :make-row
+           :make-cell
+           :make-section
+           :make-document)
   ;; Node definition
   (:export :define-node
            :find-node
@@ -110,10 +139,7 @@
 
 (defpackage common-doc.util
   (:use :cl :common-doc)
-  (:export :doc
-           :make-meta
-           :make-text
-           :string-to-slug)
+  (:export :string-to-slug)
   (:documentation "CommonDoc utilities."))
 
 (defpackage common-doc.ops

src/util.lisp

@@ -1,53 +1,5 @@
 (in-package :common-doc.util)
 
-(defmacro doc (class args &rest children)
-  "Easily create a document or node.
-
-\\code[lang=lisp]{
-(doc subscript ())
-}
-
-is equivalent to:
-
-\\code[lang=lisp]{
-(make-instance 'subscript)
-}
-
-\\code[lang=lisp]{
-(doc document
-     (:title \"My Document\")
-     (text-node (:text \"...\")))
-}
-
-is equivalent to:
-
-\\code[lang=lisp]{
-(make-instance 'document
-               :title \"My Document\"
-               :children (list (make-instance 'text-node :text \"...\")))
-}"
-  (labels ((recur (args)
-             (destructuring-bind (class args &rest children) args
-               (if children
-                   `(make-instance ',class
-                                   ,@args
-                                   :children (list
-                                              ,@(loop for child in children collecting
-                                                  (recur child))))
-                   `(make-instance ',class ,@args)))))
-    (recur (cons class (cons args children)))))
-
-(defun make-meta (pairs)
-  "Create a metadata hash table from a list of cons cells."
-  (let ((table (make-hash-table :test #'equal)))
-    (loop for pair in pairs do
-      (setf (gethash (first pair) table) (rest pair)))
-    table))
-
-(defun make-text (string &optional metadata)
-  "Create a text node from the contents of a string."
-  (make-instance 'text-node :text string :metadata metadata))
-
 (defun string-to-slug (string)
   "Take a string, usually the name of a section, and create something that is
 more similar to an identifier, i.e. no spaces, same case, etc."

t/common-doc.lisp

@@ -1,27 +1,58 @@
 (in-package :cl-user)
 (defpackage common-doc-test
   (:use :cl :fiveam :common-doc)
-  (:import-from :common-doc.util
-                :doc
-                :make-text))
+  (:export :basic-tests))
 (in-package :common-doc-test)
 
-(def-suite tests
+(def-suite basic-tests
   :description "common-doc tests.")
-(in-suite tests)
+(in-suite basic-tests)
+
+(test constructors
+  (is-true
+   (typep (make-strikethrough nil) 'strikethrough))
+  (is-true
+   (typep (make-superscript nil) 'superscript))
+  (is-true
+   (typep (make-subscript nil) 'subscript))
+  (let ((node (make-code-block "lisp" nil)))
+    (typep node 'code-block)
+    (is (equal (language node) "lisp")))
+  (is-true
+   (typep (make-inline-quote nil) 'inline-quote))
+  (is-true
+   (typep (make-block-quote nil) 'block-quote))
+  (is-true
+   (typep (make-document-link "doc" "sec" nil)
+          'document-link))
+  (is-true
+   (typep (make-web-link "http://www.example.com" nil)
+          'web-link))
+  (is-true
+   (typep (make-list-item nil) 'list-item))
+  (is-true
+   (typep (make-unordered-list nil) 'unordered-list))
+  (is-true
+   (typep (make-ordered-list nil) 'ordered-list))
+  (let ((def (make-definition nil nil)))
+    (is-true
+     (typep def 'definition))
+    (is-true (make-definition-list (list def))
+             'definition-list)))
+
 
 (test simple-doc
-  (let ((document
-          (doc
-           document
-           (:title "My Document"
-            :creator "me"
-            :keywords (list "test" "test1"))
-           (paragraph
-            ()
-            (text-node
-             (:text "test"))))))
+  (let ((document (make-document
+                   "My Document"
+                   :creator "me"
+                   :keywords (list "test" "test1")
+                   :children
+                   (list
+                    (make-paragraph
+                     (list
+                      (make-text "test")))))))
     (is
-     (equal (keywords document) (list "test" "test1")))
+     (equal (keywords document)
+            (list "test" "test1")))
     (is (equal (common-doc.ops:collect-all-text document)
                "test"))))

t/contrib/contrib.lisp

@@ -1,8 +1,8 @@
 (in-package :cl-user)
 (defpackage common-doc-test.contrib
   (:use :cl :fiveam :common-doc)
-  (:import-from :common-doc.util
-                :doc
-                :make-text)
-  (:export :tests))
+  (:export :contrib))
 (in-package :common-doc-test.contrib)
+
+(def-suite contrib)
+(in-suite contrib)