~subsetpark/bagatto

ref: 6ac2d6e6da139126e3abd7108d15395d030e29ed bagatto/src/core.janet -rw-r--r-- 6.5 KiB
6ac2d6e6 — Zach Smith Add some basic error handling 11 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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
(import path)

(import src/util)

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

(defn- apply-error
  [err f args-type ret-type]
  (error (string/format "%s;\nExpected %s function signature:\n(defn %s %s\n %s)"
                        err
                        (case ret-type :p "path" :c "contents")
                        (or (disasm f :name) "f")
                        (case args-type :d "[data]" :di "[data item]")
                        (case ret-type :p `"foo/bar/..."` :c `"<html>..."`))))

(defn- maybe-apply [f args args-type ret-type]
  (if (function? f)
    (try
      (f ;args)
      ([err fib] (apply-error err f args-type ret-type)))
    f))

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

(defn- attrs-error
  [err attrs-f]
  (error (string err
                 ";\n"
                 "Required parse function signature:\n"
                 "(defn " (or (disasm attrs-f :name) "f") " [src attrs]\n"
                 " ...\n"
                 " attrs)")))

(defn load-data [data-spec]
  ```
  First phase of main business logic. `data-spec` contains a
  specification of all the sources necessary to generate our `attrs`
  entries, which are the data structures to be used in generating the
  site.

  A data specification can be in one of four formats:
  
  1. A simple struct with only an :attrs field. The attrs generated
  will simply be the value at `:attrs`.
  2. A struct with a :src that's a string path to a file relative from
  the current directory, and an :attrs function that will be called on
  the contents of the file.
  3. A struct with a :src that's a 0-arity function that will return a
  [filename file-contents] tuple, and an :attrs function that will be
  called on the file-contents.
  4. A struct with a :src that returns a fiber which will yield some
  finite number of [filename file-contents] tuples, and an :attrs
  function that will be called on each file-contents.
  ```
  (def res @{})
  
  (defn make-attrs [filename &opt file-contents attrs-f]
    (default attrs-f (fn [_ x] x))
    (try
      (->> @{:path filename :src file-contents}
           (attrs-f file-contents))
      ([err fib] (attrs-error err attrs-f))))
  
  (loop [[entry spec] :pairs data-spec]
    (let [with-defaults (set-defaults spec)
          transform-f (or (spec :transform) identity)
          data (match with-defaults
                 
                 ({:src loader :attrs attrs-f} (fiber? loader))
                 (-> (seq [loader-out :generate loader]
                         (match loader-out
                           [filename file-contents]
                           (make-attrs filename file-contents attrs-f)
                           filename
                           (make-attrs filename)))
                    (transform-f))
                 
                 ({:src loader :attrs attrs-f} (function? loader))
                 (let [[filename file-contents] (loader)]
                   (make-attrs filename file-contents attrs-f))
                 
                 ({:src path :attrs attrs-f} (string? path))
                 (let [file-contents (slurp path)]
                   (make-attrs path file-contents attrs-f))
                 
                 {:attrs attrs}
                 attrs
                 
                 _
                 (error (string "Received invalid data spec: "
                                (string/format "%q" with-defaults)
                                "\n\n"
                                "Specification can be one of the following:\n"
                                "{:src (loader|path) :attrs attrs-f}\n"
                                "{:attrs attrs}\n")))]
      (put res entry data)))
  res)

(defn produce-writer-specs [site data]
  ``
  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.
  ``
  (def writers @[])
  
  (defn push-writer [type path contents]
    (array/push writers [type path contents]))
  
  (loop [[_entry spec] :pairs site]
    (let [with-defaults (set-defaults spec)
          filter (spec :filter)]
      (default filter (fn [_site _item] true))
      
      (match with-defaults
        
        {:each site-selector
         :path path-f
         :contents contents-f}
        (loop [item :in (data site-selector)]
          (if-let [_should-read (filter data item)
                   path (maybe-apply path-f [data item] :di :p)
                   contents (maybe-apply contents-f [data item] :di :c)]
            (push-writer :write path contents)))
        
        {:each site-selector
         :path path-f}
        (loop [item :in (data site-selector)]
          (if-let [_should-read (filter data item)
                   path (maybe-apply path-f [data item] :di :p)]
            (push-writer :copy (item :path) path)))
        
        {:path path-f
         :contents contents-f}
        (if-let [path (maybe-apply path-f [data] :d :p)
                 contents (maybe-apply contents-f [data] :d :c)]
          (push-writer :write path contents))
        
        {:some site-selector
         :path path-f}
        (if-let [item (data site-selector)
                 path (maybe-apply path-f [data] :d :p)]
          (push-writer :copy (item :path) path))

        _ (error (string "Received invalid site spec: "
                         (string/format "%q" with-defaults)
                         "\n\n"
                         "Specification can be one of the following:\n"
                         "{:each site-selector :path path-f :contents contents-f}\n"
                         "{:each site-selector :path path-f}\n"
                         "{:path path-f :contents contents-f}\n"
                         "{:some site-selector :path path-f}"))))) 
        
  writers)

(defn- new-writer [type x y]
  (let [f (case type
            :write (fn [path contents]
                     (let [ppath (path/dirname path)]
                       (print path)
                       (util/mkpath ppath)
                       (spit path contents)))
           
            :copy (fn [from to]
                    (let [ppath (path/dirname to)]
                      (print to)
                      (util/mkpath ppath)
                      (util/copy-file from to))))]
  
    (fiber/new (fn [] (f x y))))) 

(defn produce-writers [specs] (seq [spec :in specs] (new-writer ;spec)))

(defn resume-writers [writers] (each writer writers (resume writer)))