~subsetpark/bagatto

01c5c03746c008f8eb6258b31aa20dc63a26b268 — Zach Smith 9 months ago c22c5b0
Run generators in threads
6 files changed, 182 insertions(+), 93 deletions(-)

M bagatto.janet
M main.janet
M src/core.janet
A src/env.janet
A src/generators.janet
M src/threads.janet
M bagatto.janet => bagatto.janet +3 -1
@@ 388,9 388,11 @@

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.

  # TODO : To make this work again, expose the generator functions in a non-threaded context.
  ```
  [site data]
  (core/produce-writer-specs site data))
  (core/produce-writer-specs site data @{} @{}))

(defn write-site
  ```

M main.janet => main.janet +7 -33
@@ 3,8 3,7 @@

(import src/core)
(import src/error)
(import src/writers)
(import src/threads)
(import src/env)

(def bagatto
  ```


@@ 13,22 12,6 @@
  ```
  (require "bagatto-require"))

# Monkey-patch the temple environment with our additional functions.
(merge-into temple/base-env bagatto)

(defn- load-file 
  ```
  Given the filename of our index module, evaluate it in the execution
  environment with our "stdlib" in it. This will give index module
  authors access to its additional namespaces without having to import
  them (and, as the environment was created at compile time, without
  those libraries having to be present when the index module is
  written).
  ```
  [index]
  (temple/add-loader)
  (dofile index))

(defn- index-value
  [env sym index]
  (try ((env sym) :value)


@@ 43,18 26,13 @@
                                :required true}])

(defn main [& args]
  (merge-into root-env bagatto)
  
  (match (os/getenv "JANET_PATH")
    nil :ok
    janet-path (put root-env :syspath janet-path))
  (env/prepare-env-with-bagatto! bagatto)

  (let [args (argparse ;argparse-params)
        index (args :default)
        env (load-file index)]
    # Monkey-patch the temple environment with the functions defined
    # in the index module.
    (merge-into temple/base-env env)
        env (dofile index)]

    (env/prepare-env-with-index! env)

    (if (args "repl")
      # REPL mode: Enter a REPL to experiment with the contents of the


@@ 63,16 41,12 @@
      # Normal mode: evaluate index module and write site.
      (do
        (setdyn :bagatto-defaults (env :bagatto-defaults))
        (def output-dir (env :bagatto-output-dir))

        (def data (let [data-spec (index-value env 'data index)]
                    (core/load-data data-spec)))
        
        (def writer-specs (let [site-spec (index-value env 'site index)]
                            (core/produce-writer-specs site-spec data)))
                            (core/produce-writer-specs site-spec data env bagatto)))

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

M src/core.janet => src/core.janet +74 -58
@@ 2,28 2,19 @@

(import src/util)
(import src/error)
(import src/loaders)
(import src/threads)
(import src/loaders)
(import src/generators)
(import src/writers)

(defn- struct->table [s]
  (->> (or s @{}) (kvs) (splice) (table)))

(defn- maybe-apply [f args]
  (if (function? f) (f ;args) f))

(defn- apply-path [f args args-type]
  (try (maybe-apply f args)
       ([err fib] (error/path-error err f args-type))))

(defn- apply-renderer [f args args-type]
  (try (maybe-apply f args)
       ([err fib]
        (error/renderer-error err f args-type))))

(defn- set-defaults [spec]
  (table/setproto (struct->table spec)
                  (struct->table (dyn :bagatto-defaults))))


(defn load-data
  ```
  First phase of main business logic. `data-spec` contains a


@@ 49,6 40,8 @@
  
  (let [data-pairs (pairs data-spec)
        jobs (seq [[spec-name spec] :in data-pairs]

                  (threads/print "Reading " spec-name " data spec...")
                        
                  (setdyn :error-context {:spec-name spec-name})



@@ 70,56 63,79 @@
(defn produce-writer-specs 
  ```
  Second phase of main business logic. `site` contains a specification
  for generating a website and `data` is all the source data we have to
  do it with. Here we generate a new writer fiber for each file in the
  website.
  for generating a website and `data` is all the source data we have
  to do it with. Here we generate a new writer specification (a tuple
  of path and contents) for each file in the website.
  ```
  [site data]
  (def writers @[])
  
  (defn push-writer [type path contents]
    (array/push writers [type path contents]))
  
  (loop [[spec-name spec] :pairs site]
    (threads/print "Handling " spec-name "...")
    (let [with-defaults (set-defaults spec)
          filter (spec :filter)]
      (default filter (fn [_site _item] true))
  [site data bagatto env]
  (let [site-pairs (pairs site)
        jobs (seq [[spec-name spec] :in site-pairs]
               
                  (threads/print "Reading " spec-name " site spec...")
               
                  (let [with-defaults (set-defaults spec)
                        filter (spec :filter)]
                    (default filter (fn [_site _item] true))
      
      (setdyn :error-context {:spec-name spec-name})
      
      (match with-defaults
        {:each site-selector
         :dest path-generator
         :out renderer}
        (loop [item :in (data site-selector)]
          (if-let [_should-read (filter data item)
                   path (apply-path path-generator [data item] :di)
                   contents (apply-renderer renderer [data item] :di)]
            (push-writer :write path contents)))
                    (match with-defaults
                      {:each site-selector
                       :dest path-generator
                       :out renderer}
                      (generators/render-each-generator bagatto
                                                        env
                                                        data
                                                        spec-name
                                                        filter
                                                        site-selector
                                                        path-generator
                                                        renderer)
        
        {:each site-selector
         :dest path-generator}
        (loop [item :in (data site-selector)]
          (if-let [_should-read (filter data item)
                   from (item :path)
                   to (apply-path path-generator [data item] :di)]
            (push-writer :copy from to)))
                      {:each site-selector
                       :dest path-generator}
                      (generators/copy-each-generator bagatto
                                                      env
                                                      data
                                                      spec-name
                                                      filter
                                                      site-selector
                                                      path-generator)
        
        {:dest path-generator
         :out renderer}
        (if-let [path (apply-path path-generator [data] :d)
                 contents (apply-renderer renderer [data] :d)]
          (push-writer :write path contents))
                      {:dest path-generator
                       :out renderer}
                      (generators/render-generator bagatto
                                                   env
                                                   data
                                                   spec-name
                                                   path-generator
                                                   renderer)
        
        # TODO: When is this necessary? 
        {:some site-selector
         :dest path-generator}
        (if-let [item (data site-selector)
                 from (item :path)
                 to (apply-path path-generator [data] :d)]
          (push-writer :copy from to))
                      # TODO: When is this necessary? 
                      {:some site-selector
                       :dest path-generator}
                      (generators/copy-some-generator bagatto
                                                      env
                                                      data
                                                      spec-name
                                                      site-selector
                                                      path-generator)
                      

        _ (error/site-error with-defaults)))) 
                      _ (error/site-error with-defaults))))]
        
  writers)
    (let [segments  (-> (threads/distribute jobs) (values))]
      (array/concat ;segments))))

(defn evaluate-writer-specs
  ```
  Third phase of business logic : given a list of writer specs, render
  them into new files.
  ```
  [env writer-specs]
  
  (def output-dir (env :bagatto-output-dir))

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

A src/env.janet => src/env.janet +18 -0
@@ 0,0 1,18 @@
(import temple)

(defn prepare-env-with-bagatto! [bagatto]
  (temple/add-loader)
  (match (os/getenv "JANET_PATH")
    nil :ok
    janet-path (put root-env :syspath janet-path))
  (merge-into root-env bagatto) )

(defn prepare-env-with-index! [env]
  # Monkey-patch the temple environment with the functions defined
  # in the index module.
  (merge-into temple/base-env env))

(defn prepare-environment!
  [bagatto env]
  (prepare-env-with-bagatto! bagatto)
  (prepare-env-with-index! env))

A src/generators.janet => src/generators.janet +79 -0
@@ 0,0 1,79 @@
### Thread-closure creation for generator functions, ie, functions
### which take site data and a site spec and return one or more writer
### specs.
(import src/threads)
(import src/error)
(import src/env)

(defn- set-cxt! [bagatto env spec-name]
  (env/prepare-environment! bagatto env)
  (setdyn :error-context {:spec-name spec-name}))

(defn- maybe-apply [f args]
  (if (function? f) (f ;args) f))

(defn- apply-path [f args args-type]
  (try (maybe-apply f args)
       ([err fib] (error/path-error err f args-type))))

(defn- apply-renderer [f args args-type]
  (try (maybe-apply f args)
       ([err fib]
        (error/renderer-error err f args-type))))

(defn render-each-generator
  [bagatto env data spec-name filter site-selector path-generator renderer]
  (fn [parent]
    (set-cxt! bagatto env spec-name)
    
    (threads/print "Rendering " spec-name "...")
    (def res @[])
    
    (loop [item :in (data site-selector)]
      (if-let [_should-read (filter data item)
               path (apply-path path-generator [data item] :di)
               contents (apply-renderer renderer [data item] :di)]
        (array/push res [:write path contents])))
    (:send parent [:res spec-name res])))

(defn copy-each-generator
  [bagatto env data spec-name filter site-selector path-generator]
  (fn [parent]
    (set-cxt! bagatto env spec-name)

    (threads/print "Generating paths for " spec-name "...")
    (def res @[])

    (loop [item :in (data site-selector)]
      (if-let [_should-read (filter data item)
               from (item :path)
               to (apply-path path-generator [data item] :di)]
        (array/push res [:copy from to])))
    (:send parent [:res spec-name res])))

(defn render-generator
  [bagatto env data spec-name path-generator renderer]
  (fn [parent]
    (set-cxt! bagatto env spec-name)

    (threads/print "Rendering " spec-name "...")
    (def res @[])
          
    (if-let [path (apply-path path-generator [data] :d)
             contents (apply-renderer renderer [data] :d)]
      (array/push res [:write path contents]))
    (:send parent [:res spec-name res])))

(defn copy-some-generator
  [bagatto env data spec-name site-selector path-generator]
  (fn [parent]
    (set-cxt! bagatto env spec-name)

    (threads/print "Generating path for " spec-name "...")
    (def res @[])
    
    (if-let [item (data site-selector)
             from (item :path)
             to (apply-path path-generator [data] :d)]
      (array/push res [:write from to]))
    (:send parent [:res spec-name res])))

M src/threads.janet => src/threads.janet +1 -1
@@ 12,7 12,7 @@

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

(defn print
  ```