docstrings and exported functions

2 files changed, 229 insertions, 166 deletions

diff --git a/flexo.lisp b/flexo.lisp
index 63f3b36..d9db7d1 100644
--- a/flexo.lisp
+++ b/flexo.lisp
@@ -2,12 +2,128 @@
 
 (in-package #:flexo)
 
-;;; CONTENT
+;;; DYNAMIC VARS
+
+(defvar *auto-refresh-key* nil
+  "Set when interactively building a site with auto-refresh turned on.")
+
+(defvar *development-acceptor* nil
+  "Hunchentoot acceptor for the dev server.")
 
 (defvar *content* nil
   "Dynamic hash-table, bound before building a site.  All instances of
   subclasses of content are automatically inserted into this index.")
 
+(defvar *site* nil
+  "Dynamic hash-table, bound before building a site. A collection of
+  artifacts, indexed by the url path of the artifact.")
+
+;;; HACKING ON A SITE
+
+(defun make-auto-refresh-key ()
+  (symbol-name (gensym "auto-refresh-")))
+
+(defun mark-autorefresh-true (directory)
+  (when *auto-refresh-key*
+    (alexandria:write-string-into-file
+     "true"
+     (format nil "~a/~a.json" directory *auto-refresh-key*)
+     :if-exists :supersede )))
+
+(defun mark-autorefresh-false (directory)
+  (when *auto-refresh-key*
+    (alexandria:write-string-into-file
+     "false"
+     (format nil "~a/~a.json" directory *auto-refresh-key*)
+     :if-exists :supersede )))
+
+(defun inject-autorefresh-into-spinneret-body (spinneret-template-form)
+  (labels ((inject-into-body (tree)
+             (cond
+               ((and (consp tree) (eql :body (first tree)))
+                (list* :body '(flexo::auto-refresh-script) (rest tree)))
+
+               ((consp tree)
+                (mapcar #'inject-into-body tree))
+
+               (t tree))))
+    (inject-into-body spinneret-template-form)))
+
+(defun auto-refresh-script ()
+  (when *auto-refresh-key*
+    (with-html 
+      (:script
+       (ps:ps
+         (let ((poll-url (+ "/" (ps:lisp flexo::*auto-refresh-key*) ".json")))
+           (set-interval
+            (lambda ()
+              (let ((fetched (fetch poll-url)))
+                (ps:chain fetched
+                          (then (lambda (resp) (ps:chain resp (json))))
+                          (then (lambda (json)
+                                  (when json (ps:chain location (reload))))))))
+            1000)))))))
+
+(defun table-subset-p (tab1 tab2 &key (test 'equal))
+  "TEST compares values"
+  (loop :for key :being :the :hash-key :of tab1
+        :when (or (not (gethash key tab2))
+                  (not (funcall test
+                                (gethash key tab1)
+                                (gethash key tab2))))
+          :do (return nil)
+        :finally (return t)))
+
+(defun tables-equal-p (tab1 tab2 &key (test 'equal))
+  (and (table-subset-p tab1 tab2 :test test)
+       (table-subset-p tab2 tab1 :test test)))
+
+(defun site-changed-p (backup)
+  "A site has changed since backed up if either the asset table or the
+artifact tables have changed."
+  (not (tables-equal-p backup *site*)))
+
+(defun run-recipe (recipe)
+  "Runs the recipe in a fresh context and returns the site hash table it built."
+  (let ((*site* (make-hash-table))
+        (*content* (make-hash-table)))
+    (funcall recipe)
+    *site*))
+
+(defun hack-on
+    (recipe location &key (port 4242) (rebuild-freqeuncy 1) (auto-refresh t) log-to-repl)
+  (setf *development-acceptor*
+        (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor
+                                          :port port
+                                          :document-root location
+                                          :access-log-destination log-to-repl)))
+  (bt:make-thread
+   (lambda () 
+     (let ((*auto-refresh-key* (when auto-refresh (make-auto-refresh-key)))
+           (the-site (run-recipe recipe)))
+       (format t "Start Hacking on localhost port ~a~%" port)
+       (loop :while (hunchentoot:started-p  *development-acceptor*)
+             :do
+                (let ((candidate-site (run-recipe recipe)))
+                  (cond
+                    ((site-changed-p the-site candidate-site)
+                     (setf the-site candidate-site)
+                     (publish-site the-site  location)
+                     (mark-autorefresh-true location))
+
+                    (*auto-refresh-key*
+                     (mark-autorefresh-false location)))
+
+                  (sleep rebuild-freqeuncy)))
+       (format t "Stopped Hacking~%")))))
+
+(defun stop-hacking ()
+  "Stop the deveopment server."
+  (hunchentoot:stop *development-acceptor*))
+
+
+;;; CONTENT
+
 (defclass content ()
   ((keywords
     :reader content-keywords
@@ -40,6 +156,49 @@
     (setf (gethash (filepath content) *content*)
           content)))
 
+;;; ARTIFACTS
+
+(defclass artifact ()
+  ((url
+    :accessor artifact-url-path
+    :initarg :url
+    :initform (error "An artifact needs a url")
+    :documentation "A URL path, relative to the site root, from where
+    this artifact is to be served."))
+  (:documentation
+   "ARTIFACT instances represent what flexo publishes: i.e. pages and
+   files to be served from some web root."))
+
+(defmethod initialize-instance :after ((artifact artifact) &key)
+  (when *site*
+    (setf (gethash (artifact-url-path artifact) *site*)
+          artifact)))
+
+(defclass template-generated-text (artifact)
+  ((text
+    :reader generated-text
+    :initarg :text
+    :initform (error "TEXT content required")
+    :documentation "A UTF8 formatted string holding content generated
+    from a template."))
+  (:documentation "A class that represents content that has been
+  generated by some kind of lisp template. e.g. spinenret, lass,
+  paranscript. "))
+
+(defclass spinneret-page (template-generated-text) ()
+  (:documentation "An artifact generated from a spinneret template
+  representing an entire web page.."))
+
+(defclass ps-script (template-generated-text) ()
+  (:documentation "An artifact generated from a collection of
+  parenscript expressions holding a javascript script."))
+
+(defclass lass-sheet (template-generated-text) ()
+  (:documentation "An artifact generated from LASS expressions that
+  holds CSS content."))
+
+;;; CONTENT AND ARTIFACT RETRIEVAL PROTOCOL
+
 (defun content-with-tags (&rest tags)
   "Content utility function to locate all content with all of the
    supplied keyword tags"
@@ -59,7 +218,7 @@
             :collect instance)))
 
 (defun lookup-content (key)
-  "Looks up KEY in *CONTENT*."
+  "Looks up KEY in *CONTENT*.  key cna be a PATHNAME or a KEYWORD"
   (when *content*
     (gethash key *content*)))
 
@@ -71,12 +230,6 @@
      (and (typep content 'file)
           (ppcre:scan regex (namestring (filepath content)))))))
 
-;;; ARTIFACTS
-
-(defvar *site* nil
-  "Dynamic hash-table, bound before building a site. A collection of
-  artifacts, indexed by the url path of the artifact.")
-
 (defun find-artifacts (pred)
   "Generic artifact query. PRED is a preedicate of one argument, and is
    passed an ARTIFACT instance. Returns a list of instances for which
@@ -96,42 +249,13 @@
    supplied regex."
   (find-artifacts
    (lambda (artifact)
-     (ppcre:scan regex (url-path artifact)))))
-
-(defclass artifact ()
-  ((url
-    :accessor url-path
-    :initarg :url
-    :initform (error "An artifact needs a url")
-    :documentation "A URL path, relative to the site root, from where
-    this artifact is to be served."))
-  (:documentation
-   "ARTIFACT instances represent what flexo publishes: i.e. pages and
-   files to be served from some web root."))
+     (ppcre:scan regex (artifact-url-path artifact)))))
 
-(defmethod initialize-instance :after ((artifact artifact) &key)
-  (when *site*
-    (setf (gethash (url-path artifact) *site*)
-          artifact)))
-
-(defclass template-generated-text (artifact)
-  ((text
-    :reader generated-text
-    :initarg :text
-    :initform (error "TEXT content required")
-    :documentation "A UTF8 formatted string holding content generated
-    from a template."))
-  (:documentation "A class that represents content that has been
-  generated by some kind of lisp template. e.g. spinenret, lass,
-  paranscript. "))
-
-(defclass spinneret-page (template-generated-text) ()
-  (:documentation "An artifact generated from a spinneret template
-  representing an entire web page.."))
+;;; ARTIFACT TEMPLATE AND CREATION MACROS
 
 (defmacro spinneret-page (url &body body)
-  "Creates a page instance with the given url path and expdning the
-spinneret template in BODY."
+  "Creates a SPINNERET-PAGE instance with the given url path by
+   expanding the SPINNERET template in BODY."
   (let ((body (inject-autorefresh-into-spinneret-body body)))
     `(make-instance
       'spinneret-page
@@ -140,43 +264,54 @@ spinneret template in BODY."
 
 (defmacro define-spinneret-template
     (template-name (url-arg &rest lambda-list-def) &body template-body)
-  "Defines a function that creates an instance of PAGE from a reusable template."
+  "Defines a function that creates an instance of SPINNERET-PAGE from a
+   reusable template."
   `(defun ,template-name (,url-arg ,@lambda-list-def)
      (spinneret-page ,url-arg
        ,@template-body)))
 
-(defclass ps-script (template-generated-text) ()
-  (:documentation "An artifact generated from a collection of
-  parenscript expressions holding a javascript script."))
-
 (defmacro ps-script (url &body body)
+  "Creates a PS-SCRIPT instance with given URL by expanding the
+   PARENSCRIPT template in BODY."
   `(make-instance
     'ps-script
     :url ,url
     :text (ps:ps ,@body)))
 
-(defclass lass-css (template-generated-text) ()
-  (:documentation "An artifact generated from LASS expressions that
-  holds CSS content."))
-
-(defmacro lass-css (url &body body)
+(defmacro lass-sheet (url &body body)
+  "Creates a LASS-SHEET instance with URL by expanding the LASS template in BODY."
   `(make-instance
-    'lass-css
+    'lass-sheet
     :url ,url
     :text (lass:compile-and-write ,@body)))
 
 (defmacro define-lass-template
     (template-name (url-arg &rest keyword-args) &body template-body)
+  "Defines a function that produces an instance of LASS-SHEET from a
+   reusable template. 
+
+   The KEYWORD-ARGS must be a list of pairs of the sort that would
+   appear after &KEY in a DEFUN's lambda list.  Single variables are
+   not allowed, only pairs.  Moreover, string, symbol, and numeric
+   literals are the only permitted values.
+
+   Example:
+   (define-lass-template my-style (url (bg \"#fab\") (size \"1.2em\")) 
+     (body 
+       :background #(bg) 
+       :font-size #(size)))  
+   "
   (let ((arg-names
           (mapcar #'first keyword-args)))
     `(defun ,template-name (,url-arg &key ,@keyword-args)
-       (lass-css ,url-arg
+       (lass-sheet ,url-arg
          (list* :let (mapcar #'list ',arg-names (list ,@arg-names))
                 ',template-body)))))
 
-;;; "ABSTRACT" CLASSES
-
-(defclass file-artifact (artifact file) ())
+(defclass file-artifact (artifact file) ()
+  (:documentation
+   "Meant to be extended by all artifacts that are also files on
+    disk."))
 
 ;;; PUBLISH PROTOCOL
 
@@ -185,123 +320,25 @@ spinneret template in BODY."
 
 (defmethod publish ((artifact file-artifact) (location pathname))
   (uiop:copy-file (filepath artifact)
-                  (uiop:merge-pathnames* (url-path artifact) location)))
+                  (uiop:merge-pathnames* (artifact-url-path artifact) location)))
 
 (defmethod publish ((generated template-generated-text) (location pathname))
   (alexandria:write-string-into-file
    (generated-text generated)
-   (uiop:merge-pathnames* (url-path generated) location)
+   (uiop:merge-pathnames* (artifact-url-path generated) location)
    :if-exists :supersede
    :external-format :utf8))
 
 (defun publish-site (site location)
+  "SITE is a hashtable keyed by url paths whose values are ARTIFACT
+   intances. LOCATION is a publication location.  Calls PUBLISH under
+   the hood."
   (loop for artifact being the hash-value of site
         do (publish artifact location)))
 
-;;; hacking
-
-(defvar *auto-refresh-key* nil)
-
-(defun make-auto-refresh-key ()
-  (symbol-name (gensym "auto-refresh-")))
-
-(defun mark-autorefresh-true (directory)
-  (when *auto-refresh-key*
-    (alexandria:write-string-into-file
-     "true"
-     (format nil "~a/~a.json" directory *auto-refresh-key*)
-     :if-exists :supersede )))
-
-(defun mark-autorefresh-false (directory)
-  (when *auto-refresh-key*
-    (alexandria:write-string-into-file
-     "false"
-     (format nil "~a/~a.json" directory *auto-refresh-key*)
-     :if-exists :supersede )))
-
-(defun inject-autorefresh-into-spinneret-body (spinneret-template-form)
-  (labels ((inject-into-body (tree)
-             (cond
-               ((and (consp tree) (eql :body (first tree)))
-                (list* :body '(flexo::auto-refresh-script) (rest tree)))
-
-               ((consp tree)
-                (mapcar #'inject-into-body tree))
-
-               (t tree))))
-    (inject-into-body spinneret-template-form)))
-
-(defun auto-refresh-script ()
-  (when flexo::*auto-refresh-key*
-    (with-html 
-      (:script
-       (ps:ps
-         (let ((poll-url (+ "/" (ps:lisp flexo::*auto-refresh-key*) ".json")))
-           (set-interval
-            (lambda ()
-              (let ((fetched (fetch poll-url)))
-                (ps:chain fetched
-                          (then (lambda (resp) (ps:chain resp (json))))
-                          (then (lambda (json)
-                                  (when json (ps:chain location (reload))))))))
-            1000)))))))
-
-(defun table-subset-p (tab1 tab2 &key (test 'equal))
-  "TEST compares values"
-  (loop :for key :being :the :hash-key :of tab1
-        :when (or (not (gethash key tab2))
-                  (not (funcall test
-                                (gethash key tab1)
-                                (gethash key tab2))))
-          :do (return nil)
-        :finally (return t)))
-
-(defun tables-equal-p (tab1 tab2 &key (test 'equal))
-  (and (table-subset-p tab1 tab2 :test test)
-       (table-subset-p tab2 tab1 :test test)))
-
-(defun site-changed-p (backup)
-  "A site has changed since backed up if either the asset table or the
-artifact tables have changed."
-  (not (tables-equal-p backup *site*)))
-
-(defvar *development-acceptor* nil
-  "Hunchentoot acceptor for the dev server.")
-
-(defun run-recipe (recipe)
-  "Runs the recipe in a fresh context and returns the site hash table it built."
-  (let ((*site* (make-hash-table))
-        (*content* (make-hash-table)))
-    (funcall recipe)
-    *site*))
-
-(defun hack-on
-    (recipe location &key (port 4242) (rebuild-freqeuncy 1) (auto-refresh t) log-to-repl)
-  (setf *development-acceptor*
-        (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor
-                                          :port port
-                                          :document-root location
-                                          :access-log-destination log-to-repl)))
-  (bt:make-thread
-   (lambda () 
-     (let ((*auto-refresh-key* (when auto-refresh (make-auto-refresh-key)))
-           (the-site (run-recipe recipe)))
-       (format t "Start Hacking on localhost port ~a~%" port)
-       (loop :while (hunchentoot:started-p  *development-acceptor*)
-             :do
-                (let ((candidate-site (run-recipe recipe)))
-                  (cond
-                    ((site-changed-p the-site candidate-site)
-                     (setf the-site candidate-site)
-                     (publish-site the-site  location)
-                     (mark-autorefresh-true location))
-
-                    (*auto-refresh-key*
-                     (mark-autorefresh-false location)))
-
-                  (sleep rebuild-freqeuncy)))
-       (format t "Stopped Hacking~%")))))
-
-(defun stop-hacking ()
-  "Stop the deveopment server."
-  (hunchentoot:stop *development-acceptor*))
+(defun build-and-publish (recipe location)
+  "RECIPE is a function of zero arguments that builds a site in a
+   fresh context and, if successful, publishes that site to
+   LOCATION. Calls PUBLISH under the hood on each ARTIFACT created in
+   the recipe."
+  (publish-site (run-recipe recipe) location))
diff --git a/package.lisp b/package.lisp
index 130ce1b..30ea6e2 100644
--- a/package.lisp
+++ b/package.lisp
@@ -4,4 +4,30 @@
   (:use #:cl)
   (:import-from #:spinneret
                 #:with-html
-                #:with-html-string))
+                #:with-html-string)
+  (:export
+   #:artifact
+   #:artifacts-with-class
+   #:artifacts-with-urlpath-like
+   #:build-and-publish
+   #:content
+   #:content-keywords
+   #:content-with-filepath-like
+   #:content-with-tags
+   #:define-lass-template
+   #:define-spinneret-template
+   #:file
+   #:file-artifact
+   #:filepath
+   #:find-artifacts
+   #:find-content
+   #:hack-on
+   #:lass-sheet
+   #:lookup-content
+   #:ps-script
+   #:publish
+   #:publish-site
+   #:spinneret-page
+   #:stop-hacking
+   #:template-generated-text
+   #:url-path))