~subsetpark/bagatto

c22c5b081d01751c3ed14046b11ffff11cebbfa6 — Zach Smith 9 months ago d6a048f
Cache path creation
5 files changed, 47 insertions(+), 25 deletions(-)

M bagatto.janet
M main.janet
M src/threads.janet
M src/util.janet
M src/writers.janet
M bagatto.janet => bagatto.janet +3 -2
@@ 400,9 400,10 @@
  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [writer-specs]
  [writer-specs output-dir]
  (-> writer-specs
     (threads/demand-pipeline writers/handle-writes)))
     (threads/demand-pipeline writers/writer-init
                              (writers/handle-writes output-dir))))

#
# TEMPLATE

M main.janet => main.janet +4 -1
@@ 72,4 72,7 @@
                            (core/produce-writer-specs site-spec data)))

        
        (threads/demand-pipeline writer-specs (writers/handle-writes output-dir))))))
        (threads/demand-pipeline writer-specs
                                 writers/writer-init
                                 (writers/handle-writes output-dir)
                                 (min threads/default-pool-size (length writer-specs)))))))

M src/threads.janet => src/threads.janet +17 -14
@@ 10,19 10,29 @@
###
### Both producers have a fixed job timeout of 30 seconds.

(def pool-size 6)
(def default-pool-size 6)
(def worker-mailbox 16)
(def timeout 30)

(defn print
  ```
  Mimic the behaviour of `print`, but concatenate the newline to the
  string and then write, rather than writing both in sequence. Ensures
  that threaded output won 't be interleaved.
  ```
  [& xs]
  (prin (string ;xs "\n")))

(defn- demand-worker
  [thread-id f]
  [thread-id init f]
  (fn [parent]
    (def state (init))
    (while true
      (:send parent thread-id)
      (let [msg (thread/receive)]
        # `f` has to handle a `:die` message or this will never
        # terminate.
        (f msg)))))
        (f msg state)))))

(defn demand-pipeline
  ```


@@ 33,15 43,15 @@
  main thread will send them a writer-spec to complete. When the queue
  is empty, the main thread sends a kill message to all writers.
  ```
  [specs handler]
  [specs init handler &opt pool-size]
  
  (def pool @{})
  (def pool-size pool-size)
  (default pool-size default-pool-size)

  (print "Starting worker pool with " pool-size " workers...")
  
  (loop [t-id :range [0 pool-size]]
    (let [f (demand-worker t-id handler)
    (let [f (demand-worker t-id init handler)
          t (thread/new f worker-mailbox)]
      (put pool t-id t)))
  


@@ 87,11 97,4 @@
    (print "Finished jobs.")
    res))

(defn print
  ```
  Mimic the behaviour of `print`, but concatenate the newline to the
  string and then write, rather than writing both in sequence. Ensures
  that threaded output won 't be interleaved.
  ```
  [& xs]
  (prin (string ;xs "\n")))


M src/util.janet => src/util.janet +7 -4
@@ 1,17 1,20 @@
# Stolen from
# https://github.com/pyrmont/ecstatic/blob/master/src/ecstatic/utilities.janet
(defn mkpath
  [dirpath]
  [dirpath cache]
  (when (not (empty? dirpath))
    (let [path @""]
      (each dir (string/split "/" dirpath)
        (if (not (empty? path))
          (buffer/push-string path "/"))
        (buffer/push-string path dir)
        (os/mkdir (string path))))))
        (let [s (string path)]
          (unless (in cache s)
            (os/mkdir s)
            (put cache s true)))))))

(defn copy-file
  [source dest]
  [source dest cache]
  (case ((os/stat source) :mode)
    :file (spit dest (slurp source))
    :directory (mkpath dest)))
    :directory (mkpath dest cache)))

M src/writers.janet => src/writers.janet +16 -4
@@ 3,22 3,34 @@
(import src/util)
(import src/threads)

(defn writer-init
  "Return an empty table to be used as path cache"
  [] @{})

(defn handle-writes
  [output-dir]
  (fn [msg]
  (fn [msg path-cache]
    (defn ensure-path [path]
      (let [s (string path)]
        (unless (in path-cache s)
          (util/mkpath s path-cache)
          (put path-cache s true))))
    
    (match msg
      :die (thread/exit)
      
      [:consume [:write path contents]]
      (let [path (if output-dir (path/join output-dir path) path)
            ppath (path/dirname path)]
        
        (threads/print "[WRITE] " path)
        (util/mkpath ppath)
        (ensure-path ppath)
        (spit path contents))
      
      [:consume [:copy from to]]
      (let [to (if output-dir (path/join output-dir to) to)
            ppath (path/dirname to)]
        
        (threads/print "[COPY] " to)
        (util/mkpath ppath)
        (util/copy-file from to)))))
        (ensure-path ppath)
        (util/copy-file from to path-cache)))))