From c94fcd17d11fc9fb05b6ec820f2a85ac28a7ab73 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Josef=20Pospi=CC=81s=CC=8Cil?= <josef.pospisil@laststar.eu>
Date: Mon, 30 Aug 2021 13:31:55 +0200
Subject: [PATCH] Move to shawn acts and add release

---
 panearth/acts.janet | 372 +++++++++++++++++++++-----------------------
 panearth/init.janet |  21 +--
 2 files changed, 187 insertions(+), 206 deletions(-)

diff --git a/panearth/acts.janet b/panearth/acts.janet
index 4189bb1..f54a927 100644
--- a/panearth/acts.janet
+++ b/panearth/acts.janet
@@ -1,5 +1,4 @@
-(import shawn :prefix "")
-(import shawn/act :prefix "")
+(use shawn shawn/act shawn/acts)
 (import shawn/cocoon)
 (import chidi)
 (import /mendoza/markup)
@@ -12,140 +11,123 @@
 (temple/add-loader)
 (markup/add-loader)
 
-(defact Empty (make {}))
+(define-effect Present [_ {:site-title t} _]
+  (print t " construction starts"))
 
-(defact Present
-  {:effect
-   (fn [_ {:site-title t} _]
-     (print t " construction starts"))})
-
-(defact SetDev
-  {:update (fn [_ e] (put e :dev true))})
+(define-update SetDev [_ e] (put e :dev true))
 
 (defn log [& msgs]
   (make {:effect (fn [&] (eprint ;msgs))}))
 
 (defn save-content [file content]
-  (make
-    {:effect
-     (fn [_ {:content c :public p} _]
-       (def nf
-         (->> file
-              (string/replace c p)
-              (string/replace "mdz" "html")))
-       (def dir (path/dirname nf))
-       (if (not (os/stat dir)) (os/mkdir dir))
-       (spit nf content)
-       (print "Rendered " file " to " nf))}))
+  (make-effect
+    (fn [_ {:content c :public p} _]
+      (def nf
+        (->> file
+             (string/replace c p)
+             (string/replace "mdz" "html")))
+      (def dir (path/dirname nf))
+      (if (not (os/stat dir)) (os/mkdir dir))
+      (spit nf content)
+      (print "Rendered " file " to " nf))
+    (. "save-content-" file)))
 
 (defn render-content-file [file]
-  (make
-    {:watch
-     (fn [_ e _]
-       (try
-         (do
-           (def {:site-title st :dev dev} e)
-           (put module/cache file nil)
-           (def m (require file))
-           (def fc @"")
-           (with-dyns [:out fc]
-             ((get-in m [:template 'render-dict :value])
-               (merge m
-                      {:content (render/render (m :content) @"")
-                       :site-title st
-                       :css (process-css e)
-                       :file file
-                       :dev dev})))
-           (save-content file fc))
-         ([e] (log "Error: " e " when rendering file: " file))))}))
+  (make-watch
+    (fn [_ e _]
+      (try
+        (do
+          (def {:site-title st :dev dev} e)
+          (put module/cache file nil)
+          (def m (require file))
+          (def fc @"")
+          (with-dyns [:out fc]
+            ((get-in m [:template 'render-dict :value])
+              (merge m
+                     {:content (render/render (m :content) @"")
+                      :site-title st
+                      :css (process-css e)
+                      :file file
+                      :dev dev})))
+          (save-content file fc))
+        ([e] (log "Error: " e " when rendering file: " file))))
+    (. "render-content-file" file)))
 
 (defn save-markup [file markup]
-  (make
-    {:update
-     (fn [_ e]
-       (put-in e [:markups file] markup))}))
+  (make-update
+    (fn [_ e]
+      (put-in e [:markups file] markup))
+    (. "save-markup" file)))
 
 (defn markup-blog-file [file]
-  (make
-    {:watch
-     (fn [&]
-       (put module/cache file nil)
-       (save-markup file (require file)))}))
+  (make-watch
+    (fn [&]
+      (put module/cache file nil)
+      (save-markup file (require file)))
+    (. "markup-blog-file" file)))
 
 (defn index? [file]
   (string/find "index" file))
 
 (defn render-blog-file [file]
-  (make
-    {:watch
-     (fn [_ e _]
-       (try
-         (do
-           (def {:site-title st :dev dev :markups ms
-                 :files {:blog bfiles}} e)
-           (def m (ms file))
-           (def fc @"")
-           (with-dyns [:out fc]
-             ((get-in m [:template 'render-dict :value])
-               (merge m
-                      {:content (render/render (m :content) @"")
-                       :site-title st
-                       :css (process-css e)
-                       :file file
-                       :dev dev}
-                      (if index?
-                        {:markups ms
-                         :posts (as-> bfiles fs
-                                      (filter |(not (index? $)) fs)
-                                      (sort fs
-                                            (fn [a b]
-                                              (let [mad (get-in ms [a :date])
-                                                    mbd (get-in ms [b :date])]
-                                                (> mad mbd)))))}
-                        {}))))
-           (save-content file fc))
-         ([e] (log "Error: " e " when rendering file: " file))))}))
-
-(defact RenderContent
-  {:watch
-   (fn [_ {:files {:content cf}} _]
-     (seq [f :in cf]
-       (render-content-file f)))})
-
-(defact RenderPosts
-  {:watch
-   (fn [_ {:files {:blog bf}} _]
-     (seq [f :in bf]
-       (render-blog-file f)))})
-
-(defact MarkupPosts
-  {:watch
-   (fn [_ {:files {:blog bf}} _]
-     (seq [f :in bf]
-       (markup-blog-file f)))})
+  (make-watch
+    (fn [_ e _]
+      (try
+        (do
+          (def {:site-title st :dev dev :markups ms
+                :files {:blog bfiles}} e)
+          (def m (ms file))
+          (def fc @"")
+          (with-dyns [:out fc]
+            ((get-in m [:template 'render-dict :value])
+              (merge m
+                     {:content (render/render (m :content) @"")
+                      :site-title st
+                      :css (process-css e)
+                      :file file
+                      :dev dev}
+                     (if index?
+                       {:markups ms
+                        :posts (as-> bfiles fs
+                                     (filter |(not (index? $)) fs)
+                                     (sort fs
+                                           (fn [a b]
+                                             (let [mad (get-in ms [a :date])
+                                                   mbd (get-in ms [b :date])]
+                                               (> mad mbd)))))}
+                       {}))))
+          (save-content file fc))
+        ([e] (log "Error: " e " when rendering file: " file))))
+    (. "render-blog-file" file)))
+
+(define-watch RenderContent [_ {:files {:content cf}} _]
+  (seq [f :in cf] (render-content-file f)))
+
+(define-watch RenderPosts [_ {:files {:blog bf}} _]
+  (seq [f :in bf] (render-blog-file f)))
+
+(define-watch MarkupPosts [_ {:files {:blog bf}} _]
+  (seq [f :in bf] (markup-blog-file f)))
 
 (defn copy-file [file ftype]
-  (make
-    {:effect
-     (fn [_ e _]
-       (def {:public p :static s} e)
-       (def dir
-         (path/join p (get e ftype "")))
-       (if-not (os/stat dir) (os/mkdir dir))
-       (def nf
-         (string/replace s p file))
-       (spit nf (slurp file))
-       (print "Copied " file " to " nf))}))
-
-(defact CopyFiles
-  {:watch
-   (fn [_ {:files {:css cf}} _]
-     (seq [f :in cf]
-       (copy-file f :css)))})
+  (make-effect
+    (fn [_ e _]
+      (def {:public p :static s} e)
+      (def dir
+        (path/join p (get e ftype "")))
+      (if-not (os/stat dir) (os/mkdir dir))
+      (def nf
+        (string/replace s p file))
+      (spit nf (slurp file))
+      (print "Copied " file " to " nf))
+    (. "copy-file-" file "-" ftype)))
+
+(define-watch CopyFiles [_ {:files {:css cf}} _]
+  (seq [f :in cf] (copy-file f :css)))
 
 (defn save-files [dir files]
-  (make {:update
-         (fn [_ e] (put-in e [:files dir] files))}))
+  (make-update (fn [_ e] (put-in e [:files dir] files))
+               (. "save-files" dir)))
 
 (defn list-mdzs [dir]
   (->> dir
@@ -153,21 +135,15 @@
        (map |(path/join dir $))
        (filter |(string/has-suffix? "mdz" $))))
 
-(defact ListContent
-  {:watch
-   (fn [_ {:content cd} _]
-     (save-files :content (list-mdzs cd)))})
+(define-watch ListContent [_ {:content cd} _]
+  (save-files :content (list-mdzs cd)))
 
-(defact ListPosts
-  {:watch
-   (fn [_ {:blog cd} _]
-     (save-files :blog (list-mdzs cd)))})
+(define-watch ListPosts [_ {:blog cd} _]
+  (save-files :blog (list-mdzs cd)))
 
-(defact ListCss
-  {:watch
-   (fn [_ {:static s :css cd} _]
-     (save-files :css (map |(path/join s cd $)
-                           (os/dir (path/join s cd)))))})
+(define-watch ListCss [_ {:static s :css cd} _]
+  (save-files :css (map |(path/join s cd $)
+                        (os/dir (path/join s cd)))))
 
 (defn notify-modify [what]
   (def p
@@ -179,55 +155,45 @@
        (string/replace " MODIFY " "")
        string/trim))
 
-(defact TemplatesMonitor
-  {:watch
-   (fn [_ {:templates t} _]
-     (cocoon/give
-       (forever
-         (def lc (notify-modify t))
-         (cocoon/emerge
-           (make {:watch (fn [&] RenderContent)
-                  :effect (fn [&]
-                            (put module/cache lc nil)
-                            (print "Modified " lc))})))))})
-
-(defact ContentMonitor
-  {:watch
-   (fn [_ {:content c} _]
-     (cocoon/give
-       (forever
-         (def lc (notify-modify c))
-         (cocoon/emerge
-           (make {:watch (fn [&] (render-content-file lc))
-                  :effect (fn [&] (print "Modified " lc))})))))})
-
-(defact BlogMonitor
-  {:watch
-   (fn [_ {:blog b} _]
-     (cocoon/give
-       (forever
-         (def lc (notify-modify b))
-         (cocoon/emerge
-           (make {:watch (fn [&] [(markup-blog-file lc)
-                                  (render-blog-file lc)])
-                  :effect (fn [&] (print "Modified " lc))})))))})
-
-(defact CssMonitor
-  {:watch
-   (fn [_ {:css c :static s} _]
-     (cocoon/give
-       (forever
-         (def lc (notify-modify (path/join s c)))
-         (cocoon/emerge
-           (make {:watch (fn [&] [(copy-file lc :css)])
-                  :effect (fn [&] (print "Modified " lc))})))))})
-
-(defact CopyLogo
-  {:watch
-   (fn [_ {:static s :logo logo} _]
-     (copy-file (path/join s logo) ""))})
-
-(defact StartChidi
+(define-watch TemplatesMonitor [_ {:templates t} _]
+  (cocoon/give
+    (forever
+      (def lc (notify-modify t))
+      (cocoon/emerge
+        (make-act {:watch (fn [&] RenderContent)
+                   :effect (fn [&]
+                             (put module/cache lc nil)
+                             (print "Modified " lc))})))))
+
+(define-watch ContentMonitor [_ {:content c} _]
+  (cocoon/give
+    (forever
+      (def lc (notify-modify c))
+      (cocoon/emerge
+        (make-act {:watch (fn [&] (render-content-file lc))
+                   :effect (fn [&] (print "Modified " lc))})))))
+
+(define-watch BlogMonitor [_ {:blog b} _]
+  (cocoon/give
+    (forever
+      (def lc (notify-modify b))
+      (cocoon/emerge
+        (make-act {:watch (fn [&] [(markup-blog-file lc)
+                                   (render-blog-file lc)])
+                   :effect (fn [&] (print "Modified " lc))})))))
+
+(define-watch CssMonitor [_ {:css c :static s} _]
+  (cocoon/give
+    (forever
+      (def lc (notify-modify (path/join s c)))
+      (cocoon/emerge
+        (make-act {:watch (fn [&] [(copy-file lc :css)])
+                   :effect (fn [&] (print "Modified " lc))})))))
+
+(define-watch CopyLogo [_ {:static s :logo logo} _]
+  (copy-file (path/join s logo) ""))
+
+(define-act StartChidi
   {:watch
    (fn [_ e _]
      (def {:chidi {:host host :port port}} e)
@@ -243,22 +209,36 @@
    (fn [_ {:chidi {:host host :port port}} _]
      (print "Chidi Present on " host ":" port))})
 
-(defact Monitor
-  {:watch
-   (fn [&]
-     [ContentMonitor
-      BlogMonitor
-      TemplatesMonitor
-      CssMonitor])})
-
-(defact InitRendering
-  {:watch
-   (fn [&]
-     [ListCss
-      CopyFiles
-      CopyLogo
-      ListContent
-      ListPosts
-      RenderContent
-      MarkupPosts
-      RenderPosts])})
+(define-watch Monitor [&]
+  [ContentMonitor
+   BlogMonitor
+   TemplatesMonitor
+   CssMonitor])
+
+(define-watch InitRendering [&]
+  [ListCss
+   CopyFiles
+   CopyLogo
+   ListContent
+   ListPosts
+   RenderContent
+   MarkupPosts
+   RenderPosts])
+
+(define-watch Development [&]
+  [Present
+   SetDev
+   InitRendering
+   StartChidi
+   Monitor])
+
+(define-watch Production [&]
+  [Present
+   InitRendering])
+
+(define-effect Release [_ {:server-name sn :server-path sp :html-path hp
+                           :executable-name en} _]
+  (os/execute
+    ["ssh" sn
+     (string/format
+       "cd %s; git pull; jpm -l deps; jpm -l exec ./%s prod ;cp -r public/* %s" sp en hp)] :p))
diff --git a/panearth/init.janet b/panearth/init.janet
index 23421ec..aa570ab 100644
--- a/panearth/init.janet
+++ b/panearth/init.janet
@@ -10,17 +10,18 @@
                 :blog "content/posts"
                 :public "public"
                 :templates "templates"
-                :chidi {:host "0.0.0.0" :port 7777}}))
+                :chidi {:host "0.0.0.0" :port 7777}
+                :server-name "neil"
+                :server-path "/root/Code/pan.earth/"
+                :html-path "/var/www/html/pan.earth/"
+                :executable-name "pe"}))
 
 (def env-init
-  {"dev" [Present
-          SetDev
-          InitRendering
-          StartChidi
-          Monitor]
-   "prod" [Present
-           InitRendering]})
+  {"dev" Development
+   "prod" Production
+   "rel" Release})
 
-(defn start [env]
-  (:confirm shawn ;(env-init env))
+(defn start [&opt env]
+  (default env "dev")
+  (:confirm shawn (env-init env))
   (:admit shawn))
-- 
2.45.2