templates and multiple-inheritance artifact classes

1 files changed, 80 insertions, 9 deletions

diff --git a/flexo.lisp b/flexo.lisp
index 64a2203..182c24f 100644
--- a/flexo.lisp
+++ b/flexo.lisp
@@ -114,15 +114,20 @@
     (setf (gethash (url-path artifact) *site*)
           artifact)))
 
-(defclass page (artifact)
+
+
+(defclass html ()
   ((html
-    :accessor page-html
+    :reader html
     :initarg :html
-    :initform (error "A PAGE must have some HTML")
-    :documentation
-    "A utf8 encoded string holding the html content of this page artifact.")))
+    :initform (error "HTML content required")
+    :documentation "A UTF8 formatted string holding HTML content.")))
 
-(defmacro page (url &body body)
+(defclass spinneret-page (artifact html) ()
+  (:documentation "An artifact generated from a spinneret template
+  representing an entire web page.."))
+
+(defmacro spinneret-page (url &body body)
   "Creates a page instance with the given url path and expdning the
 spinneret template in BODY."
   `(make-instance
@@ -130,10 +135,76 @@ spinneret template in BODY."
    :url ,url
    :html (with-html-string ,@body)))
 
-(defmacro define-page-template (template-name (url-arg &rest lambda-list-def) &body template-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."
   `(defun ,template-name (,url-arg ,@lambda-list-def)
-     (page ,url-arg
+     (spinneret-page ,url-arg
        ,@template-body)))
 
-;;; 
+(defclass javascript ()
+  ((javascript
+    :reader javascript
+    :initarg :javascript
+    :initform (error "JAVASCRIPT content required")
+    :documentation "A UTF8 strign holding textual Javascript.")))
+
+(defclass ps-script (artifact javascript) ()
+  (:documentation "An artifact generated from a collection of
+  parenscript expressions holding a javascript script."))
+
+(defmacro ps-script (url &body body)
+  `(make-instance
+    'ps-script
+    :url ,url
+    :javascript (ps:ps ,@body)))
+
+(defclass css ()
+  ((css
+    :reader css
+    :initarg :css
+    :initform (error "CSS content required.")
+    :documentation "A UTF8 string holding textual css content.")))
+
+(defclass lass-css (artifact css) ()
+  (:documentation "An artifact generated from LASS expressions that
+  holds CSS content."))
+
+(defmacro lass-css (url &body body)
+  `(make-instance
+    'lass-css
+    :url ,url
+    :css (lass:compile-and-write ,@body)))
+
+(defmacro define-lass-template
+    (template-name (url-arg &rest keyword-args) &body template-body)
+  (let ((arg-names
+          (mapcar #'first keyword-args)))
+    `(defun ,template-name (,url-arg &key ,@keyword-args)
+       (lass-css ,url-arg
+         (list* :let (mapcar #'list ',arg-names (list ,@arg-names))
+                ',template-body)))))
+
+;;; "ABSTRACT" CLASSES
+
+(defclass file-artifact (artifact file) ())
+
+;;; PUBLISH PROTOCOL
+
+(defgeneric publish (artifact location)
+  (:documentation "Publish the given artifact in the given location."))
+
+(defmethod publish ((artifact file-artifact) (location pathname))
+  (uiop:copy-file (filepath artifact)
+                  (uiop:merge-pathnames* (url-path artifact) location)))
+
+(defmethod publish ((page page) (location pathname))
+  (alexandria:write-string-into-file
+   (page-html page)
+   (uiop:merge-pathnames* (url-path page) location)
+   :if-exists :supersede
+   :external-format :utf8))
+
+(defun publish-site-to (location)
+  (dolist (a *artifacts*)
+    (publish a location)))