M panearth/acts.janet => panearth/acts.janet +176 -196
@@ 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))
M panearth/init.janet => panearth/init.janet +11 -10
@@ 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))