~pepe/pan.earth

c94fcd17d11fc9fb05b6ec820f2a85ac28a7ab73 — Josef Pospíšil a month ago 03f71a7
Move to shawn acts and add release
2 files changed, 187 insertions(+), 206 deletions(-)

M panearth/acts.janet
M panearth/init.janet
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))