git.fiddlerwoaroof.com
araneus.lisp
d9d5a3d6
 ;; This is a minimal web-framework built on ningle that attempts to decouple
 ;; views from controllers and make life more interesting.
 (in-package :araneus)
 
af4b9cc9
 (defclass mixin ()
   ())
 
3c51ee64
 (defgeneric run-route (name params &rest r)
   (:documentation "specialized on NAME with an EQL-specializer. This generic
                    function defines the way a specific route is to be processed"))
 
 (defgeneric controller (name params &key)
   (:documentation "specialized on NAME with an EQL-specializer. This generic function
                    picks out the model that the view renders for the user. Normally,
                    this is specialized using the DEFINE-CONTROLLER macro."))
 
 (defgeneric view (name model)
   (:documentation "specialized on NAME with an EQL-specializer. This generic function
6ed6ab82
                    renders the model picked out by the controller. Normally, this is
3c51ee64
                    specialized using the DEFINE-VIEW macr"))
d9d5a3d6
 
3ada8198
 (define-condition view-error (error)
   ((%message :initarg :msg :reader msg))
   (:default-initargs :msg "something's wrong")
   (:report (lambda (condition stream)
              (format stream "Error in view: ~a" (msg condition)))))
b1a33cd9
 
 (defgeneric styles (route)
   (:documentation "if you use class-based roues, this method provides
   a hook for generating CSS files with the most specific selectors
   last: it returns a list via the APPEND method complication, suitable
   for use with a system like lass <https://shinmera.github.io/LASS>")
   (:method-combination append :most-specific-last))
 
b6de1afc
 (defgeneric routes (app)
b1a33cd9
   (:documentation "defines routes for some object that represents an
   app: PROGN method combination, with an around method that ensures
   that this returns the app.")
b6de1afc
   (:method-combination progn)
   (:method :around (app)
     (call-next-method)
     app))
af4b9cc9
 (defmethod initialize-instance :after ((instance mixin) &key)
   (araneus:routes instance))
b6de1afc
 
d9d5a3d6
 (defmacro defroutes (app &body routes)
3c51ee64
   "Define a set of routes for given paths. the ROUTES parameter expects this format:
    ((\"/path/to/{route}\" :method :POST) route-callback) the AS-ROUTE macro helps one
    avoid binding function values to the route for flexibility."
d9d5a3d6
   (alexandria:once-only (app)
b1a33cd9
     `(setf ,@(loop for ((target &key method) callback) in routes
                    append `((ningle:route ,app ,target :method ,(or method :GET)) ,callback)))))
d9d5a3d6
 
6ed6ab82
 
 (defvar *view-name*)
793e7a22
 (defun call-current-view (model)
   "Call the currently running view with a new model.
af4b9cc9
 
793e7a22
    Useful if one view name is specialized many times on different model classes: the controller can
    pass the container and then the view can recall itself on the contained items."
3ada8198
   (if (boundp '*view-name*)
       (view *view-name* model)
       (error 'view-error :msg "Must call CALL-CURRENT-VIEW within a view")))
793e7a22
 
d9d5a3d6
 (defmacro as-route (name &rest r &key &allow-other-keys)
3c51ee64
   "Create a lambda directing requests to the route for NAME.  This uses the
    generic function RUN-ROUTE internally whose default implementation relies on
    appropriate implementations of CONTROLLER and VIEW. The RUN-ROUTE method receives
    the parameters ningle passes to other functions as a first parameter, and then it
    receives a bunch of arguments according to the arguments passed to this macro."
6ed6ab82
   (alexandria:once-only (name)
     `(lambda (params)
        (run-route ,name params ,@r))))
 
 (defun %compose-route (controller controller-args view)
   (declare (optimize (debug 3) (speed 0) (space 0) (safety 3)))
   (lambda (params)
     (declare (optimize (debug 3) (speed 0) (space 0) (safety 3)))
669e477c
     (let ((*view-name* view))
       (apply #'view
 	     (list view
 		   (apply #'controller
 			  (list* controller
 				 params
 				 controller-args)))))))
6ed6ab82
 
 (defmacro compose-route ((controller &rest controller-args) view)
   `(%compose-route ',controller ,controller-args ',view))
d9d5a3d6
 
6ed6ab82
 (defun switch-view (view-name)
   (format t "~&Switching view to: ~a~&" view-name)
   (alexandria:if-let ((switch-view-restart (find-restart 'switch-view)))
     (invoke-restart switch-view-restart view-name)
     (cerror "ignore this error"
             "Can only call switch-view while the route is being processed")))
d9d5a3d6
 
 (defmethod run-route (name params &rest r)
6ed6ab82
   (let ((*view-name* name))
4cc1c130
     (let* ((* (list* name params r))
            (*
              (restart-bind
                  ((switch-view
                     (lambda (new-view)
                       (format t "~%SWITCHING VIEW: ~a" new-view)
                       (setf *view-name* new-view))))
                (apply #'controller *))))
       (let ((* (funcall 'view *view-name* *)))
         *))))
d9d5a3d6
 
3c51ee64
 ; The default controller just passes its parameters directly to the view
d9d5a3d6
 (defmethod controller (name params &key)
   params)
 
c9be2b56
 (defmacro define-controller (name (params &rest r) &body body)
d9d5a3d6
   `(defmethod controller ((name (eql ',name)) ,params &key ,@r)
      ,@body))
 
 (defmacro define-view (name (model) &body body)
   `(defmethod view ((name (eql ',name)) ,model)
      ,@body))
 
 (defun render-mustache (fn data)
   (with-open-file (s (truename fn))
     (let ((template (make-string (file-length s))))
       (read-sequence template s)
       (mustache:render* template data))))
 
 
793e7a22
 (defmacro define-spinneret-view (name (model) &body body)
   (let* ((declarations (when (eq (caar body) 'declare) (car body)))
          (body (if declarations (cdr body) body)))
     `(define-view ,name (,model)
        ,declarations
        (spinneret:with-html-string
          ,@body))))
 
d9d5a3d6
 (defmacro mustache ((template lambda-list data) &body body)
   "Template specifies the template to be render, lambda-list is used to destructure data
    and body transforms the destructured data into an alist for use in the template"
   (alexandria:once-only (template)
     `(destructuring-bind ,lambda-list ,data
        (render-mustache ,template
                         (list
                           ,@(loop for (k v) on body by #'cddr
                                   if (or k v)
                                   collect `(cons ,k ,v)))))))
 
 (defmacro mustache-view (name lambda-list template &body body)
3c51ee64
   "Define a view that renders a mustache template."
   (alexandria:once-only (name lambda-list)
     (alexandria:with-gensyms (model)
       `(define-view ,name (,model)
          (mustache (,template ,lambda-list ,model)
af4b9cc9
            ,@body)))))