~subsetpark/bagatto

ref: 2521a3c63024bb9957d74bfcf7e60f8b9bc87c85 bagatto/src/generators.janet -rw-r--r-- 3.6 KiB
2521a3c6 — Zach Smith Add mago 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
### 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! [spec-name]
  (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]
      (propagate (error/path-error err f args-type) fib))))

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

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

    (loop [item :in (data site-selector)]
      (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- render-generator
  [data spec-name path-generator renderer]
  (fn [parent]
    (set-cxt! 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-each-generator
  [data spec-name filter site-selector path-generator]
  (fn [parent]
    (set-cxt! spec-name)

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

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

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

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

    (let [item (data site-selector)]
      (unless (and item (item :path))
        (error/copy-error spec-name site-selector item))
      (let [from (item :path)
            to (apply-path path-generator [data] :d)]
        (array/push res [:copy from to])))
    (:send parent [:res spec-name res])))

(defn from-spec
  [spec spec-name data]
  (let [filter (spec :filter)]
    (default filter (fn [_site _item] true))
    (match spec
      {:each site-selector
       :dest path-generator
       :out renderer}
      (render-each-generator data
                             spec-name
                             filter
                             site-selector
                             path-generator
                             renderer)

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

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

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

      _ (error/site-error spec))))