1  (in-package :ami.admin)
 2  
 3  (defun format-route (control-string &rest args)
 4    (let ((extended-ctrl-string (format nil "~~@[/~~a~~]~a" control-string)))
 5      (apply #'format 
 6             (append 
 7              (list nil extended-ctrl-string (when (get-config :is-development)
 8                                               "cheapcharminghouses.com"))
 9              args))))
10  
11  (defmethod create-route ((mdef ami.modeling:model-definition))
12    (format-route "/admin/~(~a~)/new" (ami.modeling:model-name mdef)))
13  
14  (defmethod update-route ((m ami.modeling:model))
15    (let ((mdef (ami.modeling:model-definition m)))
16      (format-route "/admin/~(~a~)/~a"
17                    (ami.modeling:model-name mdef)
18                    (ami.modeling:model-id m))))
19  
20  (defmethod edit-route ((m ami.modeling:model))
21    (let ((mdef (ami.modeling:model-definition m)))
22      (format-route "/admin/~(~a~)/~a/edit"
23                    (ami.modeling:model-name mdef)
24                    (ami.modeling:model-id m))))
25  
26  (defmethod list-route ((mdef ami.modeling:model-definition))
27    (let ((mname (ami.modeling:model-name mdef)))
28      (format nil "~@[/~a~]/~(~a~)s" (if T "cheapcharminghouses.com") mname)))
29  
30  (defun render-form-field (field mdef &optional obj)
31    (let ((accessor (alexandria:format-symbol 
32                     (ami.modeling:model-package mdef) "~a-~a" (ami.modeling:model-name mdef) field))
33  	(fdef (gethash field (ami.modeling:model-fields mdef))))
34      (ami.modeling:render-form fdef
35                   (when obj (funcall accessor obj)))))
36  
37  (defun render-view-field (field mdef obj)
38    (let* ((fdef (if (symbolp field)
39                     (gethash field (ami.modeling:model-fields mdef))
40                   field))
41  	 (accessor (ami.modeling:get-accessor mdef fdef)))
42      (html
43       (:div
44        :id (ami.modeling:field-domid fdef obj) 
45        (ami.modeling:render-view
46         fdef
47         (funcall accessor obj))))))
48  
49  (defmethod new ((mdef ami.modeling:model-definition))
50    (html
51     (:form
52      :id (format nil "~a-new" (ami.modeling:name-as-string mdef))
53      (dolist (field (alexandria:hash-table-keys (ami.modeling:model-fields mdef)))
54        (render-form-field field mdef))
55      (:input :hx-swap "outerHTML"
56  	    :hx-post (create-route mdef)
57  	    :hx-push-url (list-route mdef)
58  	    :hx-target "#content"
59  	    :hx-select "#content"
60  	    :type "submit"
61  	    :value "Create"))))
62  
63  (defmethod edit ((obj ami.modeling:model))
64     (let* ((mdef (ami.modeling:model-definition obj)))
65       (html
66        (:form
67         :id (ami.modeling:domid obj)
68         :class "flex flex-col p-1.5"
69         (dolist (field (alexandria:hash-table-keys (ami.modeling:model-fields mdef)))
70   	(render-form-field field mdef obj))
71         (:input :hx-swap "outerHTML"
72          :hx-target (ami.modeling:domid obj :for-selector t) 
73          :hx-select (ami.modeling:domid obj :for-selector t) 
74          :hx-patch (update-route obj)
75          :class "flex w-full justify-center rounded bg-primary p-3 font-medium text-gray-100 hover:bg-opacity-90"
76          :type "submit"
77          :value "Save")))))
78  
79  (defmethod view ((obj ami.modeling:model))
80     (let* ((mdef (ami.modeling:model-definition obj)))
81       (html
82        (:div
83         :class "w-[75%] rounded-sm border border-stroke bg-white shadow-default dark:border-strokedark dark:bg-boxdark"
84         (:div
85          :id (ami.modeling:domid obj) 
86          :class "flex flex-col p-1.5"
87          (dolist (field (alexandria:hash-table-keys (ami.modeling:model-fields mdef)))
88            (render-view-field field mdef obj))
89          (:button :hx-swap "outerHTML"
90           :hx-target (ami.modeling:domid obj :for-selector t) 
91           :hx-select (ami.modeling:domid obj :for-selector t)
92           :data-hx-get (edit-route obj)
93           "Edit"))))))