~subsetpark/bagatto

38335683a141402f16ca4dcddce8328819d63083 — Zach Smith 5 months ago 7e7db4f
Some simplification of threading code
M bagatto.janet => bagatto.janet +3 -51
@@ 1,14 1,11 @@
(import sh)
(import temple)
(import markable)
(import moondown)
(import path)
(import jdn)
(import json)

(import src/multimarkdown)
(import src/core)
(import src/writers)
(import src/threads)

(defn- set-error-context!
  [k v]


@@ 360,51 357,6 @@
# REPL
#

(defn eval-data
  ```
  Evaluate an object according to the Bagatto *site data specification*.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [data]
  (core/load-data data @{}))

(defn eval-loader
  ```
  Evaluate a loader fiber to view the list of filenames, or filename
  and contents, it produces.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [fiber]
  (seq [res :generate fiber] res))

(defn eval-site
  ```
  Evaluate an object according to the Bagatto *site generation specification*,
  given a site data object as context.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [site data]
  (core/produce-writer-specs site data @{}))

(defn write-site
  ```
  Given the output of a site generation specification, trigger the
  actual file generation.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [writer-specs output-dir]
  (-> writer-specs
      (threads/demand-pipeline writers/writer-init
                               (writers/handle-writes output-dir))))

#
# TEMPLATE
#


@@ 440,7 392,8 @@
  "Render a markdown string into HTML."
  [md &opt opts]
  (default opts [:footnotes :smart])
  (markable/markdown->html (string md) [:footnotes]))
  # TODO: Use markable when this bug is fixed: https://github.com/pyrmont/markable/issues/2
  (moondown/render (string md)))

(defn mmarkdown->html
  ```


@@ 452,7 405,6 @@

  (requires the presence of the multimarkdown executable.)
  ```
  :foo
  [md &keys {:smart smart}]
  (multimarkdown/snippet md smart))


M demo/basic-site/index.janet => demo/basic-site/index.janet +2 -1
@@ 104,6 104,7 @@
## paths. Here we specify a path that looks like this:
## "pages/{{ (slugify (item :basename)) }}.html".
(def page-path (bagatto/%p "pages" '%i :basename '% ".html"))
(def page-renderer (bagatto/renderer "templates/page" {:root "../"}))

(def site {# :index is a single file whose path we can specify as a
           # literal string.


@@ 134,5 135,5 @@
           # of the generate web page.
           :pages {:each :pages
                   :dest page-path
                   :out (bagatto/renderer "templates/page" {:root "../"})}})
                   :out page-renderer}})


M main.janet => main.janet +3 -12
@@ 5,23 5,14 @@
(import src/error)
(import src/env)

(def bagatto
  ```
  An environment populated by the "stdlib" we want to expose to
  template and index module authors.
  ```
  (require "bagatto-require"))

(defn- index-value
  [env sym index]
  (try ((env sym) :value)
    ([err fib] (error/eval-error sym index))))
       ([err fib] (error/eval-error sym index))))

(defn- prepare-env [index]
  (-> index
      (dofile)
      (merge-into bagatto)
      (env/add-exec-blacklist)))
      (dofile)))

(def argparse-params ["A transparent, extensible static site generator."
                      "repl" {:kind :flag


@@ 32,7 23,7 @@
                                :required true}])

(defn main [& args]
  (merge-into root-env bagatto)
  (merge-into root-env core/bagatto)

  (when-let [args (argparse ;argparse-params)]
    (let [index (args :default)

M project.janet => project.janet +1 -0
@@ 4,6 4,7 @@
  :dependencies ["https://github.com/andrewchambers/janet-sh.git"
                 "https://git.sr.ht/~bakpakin/temple"
                 "https://github.com/pyrmont/markable"
                 "https://github.com/joy-framework/moondown.git"
                 "https://github.com/janet-lang/path.git"
                 "https://github.com/andrewchambers/janet-jdn.git"
                 "https://github.com/janet-lang/json.git"

A repl.janet => repl.janet +45 -0
@@ 0,0 1,45 @@

(defn eval-data
  ```
  Evaluate an object according to the Bagatto *site data specification*.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [data]
  (core/load-data data @{}))

(defn eval-loader
  ```
  Evaluate a loader fiber to view the list of filenames, or filename
  and contents, it produces.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [fiber]
  (seq [res :generate fiber] res))

(defn eval-site
  ```
  Evaluate an object according to the Bagatto *site generation specification*,
  given a site data object as context.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [site data]
  (core/produce-writer-specs site data @{}))

(defn write-site
  ```
  Given the output of a site generation specification, trigger the
  actual file generation.

  Not necessary to define a module, but can be useful to debug your
  configuration from within the REPL.
  ```
  [writer-specs output-dir]
  (-> writer-specs
      (threads/demand-pipeline writers/writer-init
                               (writers/handle-writes output-dir))))

M src/core.janet => src/core.janet +25 -17
@@ 1,4 1,5 @@
(import path)
(import temple)

(import src/util)
(import src/error)


@@ 7,6 8,21 @@
(import src/generators)
(import src/writers)

(def bagatto
  ```
  An environment populated by the "stdlib" we want to expose to
  template and index module authors.
  ```
  (require "bagatto-require"))

(defn thread-init
  [f]
  (thread/new (fn [parent]
                (temple/add-loader)
                (merge-into root-env bagatto)
                (f parent))
              1 :hc))

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



@@ 14,7 30,6 @@
  (table/setproto (struct->table spec)
                  (struct->table (dyn :bagatto-defaults))))


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


@@ 49,25 64,22 @@
                     transform-f (or (spec :transform) identity)]
                 (match with-defaults
                   ({:src loader :attrs parser} (function? loader))
                   (loaders/from-file-spec-loader env
                                                  spec-name
                   (loaders/from-file-spec-loader spec-name
                                                  loader
                                                  parser
                                                  transform-f)

                   ({:src path :attrs parser} (string? path))
                   (loaders/from-path-loader env
                                             spec-name
                   (loaders/from-path-loader spec-name
                                             path
                                             parser)

                   {:attrs attrs}
                   (loaders/bare-attr-loader env
                                             spec-name
                   (loaders/bare-attr-loader spec-name
                                             attrs)

                   _ (error/data-error with-defaults))))]
    (threads/distribute jobs)))
    (threads/distribute jobs thread-init)))

(defn produce-writer-specs
  ```


@@ 90,8 102,7 @@
                   {:each site-selector
                    :dest path-generator
                    :out renderer}
                   (generators/render-each-generator env
                                                     data
                   (generators/render-each-generator data
                                                     spec-name
                                                     filter
                                                     site-selector


@@ 100,8 111,7 @@

                   {:each site-selector
                    :dest path-generator}
                   (generators/copy-each-generator env
                                                   data
                   (generators/copy-each-generator data
                                                   spec-name
                                                   filter
                                                   site-selector


@@ 109,23 119,21 @@

                   {:dest path-generator
                    :out renderer}
                   (generators/render-generator env
                                                data
                   (generators/render-generator data
                                                spec-name
                                                path-generator
                                                renderer)

                   {:some site-selector
                    :dest path-generator}
                   (generators/copy-some-generator env
                                                   data
                   (generators/copy-some-generator data
                                                   spec-name
                                                   site-selector
                                                   path-generator)

                   _ (error/site-error with-defaults))))]

    (let [segments (-> (threads/distribute jobs) (values))]
    (let [segments (-> (threads/distribute jobs thread-init) (values))]
      (array/concat ;segments))))

(defn evaluate-writer-specs

M src/env.janet => src/env.janet +2 -1
@@ 44,9 44,10 @@

(defn prepare-environment!
  [env]
  (prepare-syspath!)
  (temple/add-loader)
  # Monkey-patch the temple environment with the functions defined
  # in the index module.
  (merge-into temple/base-env env)
  (setdyn :executable-blacklist (env :executable-blacklist)))

(defn thread-env [bagatto])

M src/generators.janet => src/generators.janet +13 -16
@@ 5,8 5,7 @@
(import src/error)
(import src/env)

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

(defn- maybe-apply [f args]


@@ 22,24 21,22 @@
      (error/renderer-error err f args-type))))

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

    (threads/print "Rendering " spec-name "...")
    (set-cxt! 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])))
      (when (filter data item)
        (let [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
  [env data spec-name filter site-selector path-generator]
  [data spec-name filter site-selector path-generator]
  (fn [parent]
    (set-cxt! env spec-name)
    (set-cxt! spec-name)

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


@@ 52,9 49,9 @@
    (:send parent [:res spec-name res])))

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

    (threads/print "Rendering " spec-name "...")
    (def res @[])


@@ 65,9 62,9 @@
    (:send parent [:res spec-name res])))

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

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

M src/loaders.janet => src/loaders.janet +7 -8
@@ 2,8 2,7 @@
(import src/threads)
(import src/env)

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

(defn- make-attrs [parser filename &opt file-contents]


@@ 18,9 17,9 @@
  A loader that takes either a single file spec or a sequence of file
  specs and sends back a list of attributes.
  ```
  [env spec-name loader parser transform-f]
  [spec-name loader parser transform-f]
  (fn [parent]
    (set-cxt! env spec-name)
    (set-cxt! spec-name)
    (threads/print "Loading " spec-name "...")

    (let [loader-specs (try (loader)


@@ 46,9 45,9 @@
  A loader that takes a literal file path and generates file
  attributes.
  ```
  [env spec-name path parser]
  [spec-name path parser]
  (fn [parent]
    (set-cxt! env spec-name)
    (set-cxt! spec-name)
    (threads/print "Loading " spec-name " (" path ")...")

    (let [file-contents (slurp path)


@@ 59,8 58,8 @@
  ```
  A loader that takes an attributes literal and returns it.
  ```
  [env spec-name attrs]
  (set-cxt! env spec-name)
  [spec-name attrs]
  (set-cxt! spec-name)

  (fn [parent]
    (threads/print "Loaded " spec-name)

M src/threads.janet => src/threads.janet +2 -6
@@ 70,10 70,6 @@

  (print "Terminated worker pool."))

(defn- one-time-worker
  [f]
  (thread/new (fn [parent] (f parent)) 1 :h))

(defn distribute
  ```
  Process, in parallel, a sequence of jobs.


@@ 84,11 80,11 @@

  Returns a mapping from `k` to `v`.
  ```
  [jobs]
  [jobs thread-init]

  (print "Beginning " (length jobs) " jobs...")

  (let [workers (seq [job :in jobs] (one-time-worker job))
  (let [workers (seq [job :in jobs] (thread-init job))
        res @{}]
    (var got-back 0)


M test/loaders.janet => test/loaders.janet +6 -6
@@ 7,13 7,13 @@
  @{:send (fn [self res] (put self :res res))})

(deftest path-loader
  (let [loader (loaders/from-path-loader {} "path test" "test/support/test.txt" bagatto/parse-base)
  (let [loader (loaders/from-path-loader "path test" "test/support/test.txt" bagatto/parse-base)
        [_ _ {:path path :contents contents}] ((loader (parent)) :res)]
    (is (= "test/support/test.txt" path))
    (is (== @"test file contents\n" contents))))

(deftest non-existent
  (let [loader (loaders/from-path-loader {} "path test" "test/support/not-there.txt" bagatto/parse-base)]
  (let [loader (loaders/from-path-loader "path test" "test/support/not-there.txt" bagatto/parse-base)]
    (assert-thrown (loader (parent)))))

(deftest invalid-loader


@@ 22,24 22,24 @@

(deftest loader-arity
  (let [single-spec (fn [x] :wrong)
        loader (loaders/from-file-spec-loader {} "spec test" single-spec bagatto/parse-base identity)]
        loader (loaders/from-file-spec-loader "spec test" single-spec bagatto/parse-base identity)]
    (assert-thrown (loader (parent)))))

(deftest some-spec-loader
  (let [single-spec (fn [] {:some ["spec-path" "spec-contents"]})
        loader (loaders/from-file-spec-loader {} "spec test" single-spec bagatto/parse-base identity)
        loader (loaders/from-file-spec-loader "spec test" single-spec bagatto/parse-base identity)
        [_ _ {:path path :contents contents}] ((loader (parent)) :res)]
    (is (= "spec-path" path))
    (is (= "spec-contents" contents))))

(deftest each-spec-loader
  (let [multi-spec (fn [] {:each ["path only" ["spec-path" "spec-contents"]]})
        loader (loaders/from-file-spec-loader {} "spec test" multi-spec bagatto/parse-base identity)
        loader (loaders/from-file-spec-loader "spec test" multi-spec bagatto/parse-base identity)
        [_ _ res] ((loader (parent)) :res)]
    (is (== @[@{:path "path only"} @{:path "spec-path" :contents "spec-contents"}] res))))

(deftest attr-loader
  (let [loader (loaders/bare-attr-loader {} "attr loader" {:test-attr "test value"})
  (let [loader (loaders/bare-attr-loader "attr loader" {:test-attr "test value"})
        [_ _ res] ((loader (parent)) :res)]
    (is (== {:test-attr "test value"} res))))