-
Notifications
You must be signed in to change notification settings - Fork 297
/
terse.clj
204 lines (168 loc) · 8.39 KB
/
terse.clj
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
; Copyright 2013 Relevance, Inc.
; Copyright 2014-2019 Cognitect, Inc.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0)
; which can be found in the file epl-v10.html at the root of this distribution.
;
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
;
; You must not remove this notice, or any other, from this software.
(ns io.pedestal.http.route.definition.terse
(:require [io.pedestal.http.route.definition :as route.definition]
[io.pedestal.http.route.definition.verbose :as verbose]
[io.pedestal.interceptor :as interceptor]
[io.pedestal.log :as log]))
(defn- unexpected-vector-in-route [spec]
(format "The route specification probably has too many levels of nested vectors: %s" spec))
(defn- unmatched-type-in-constraint [spec]
(format "Cannot expand '%s' as a route. Expected a verb map or path string, but found a %s instead" spec (type spec)))
(defn- invalid-handler [handler original]
(format "While parsing a verb map, found a %s as a handler. It must be a symbol that resolves to an interceptor or an actual interceptor. The full vector is %s" (type handler) original))
(defn- missing-handler [handler original]
(format "When parsing a verb map, tried in vain to find a handler (as the first symbol that resolves to an interceptor or interceptor map in a vector). Looking in %s" vector))
(defn- leftover-declarations [vector original]
(format "This vector for the verb map has extra elements. The leftover elements are %s from the original data %s" vector original))
(declare expand-path)
(declare expand-query-constraint)
(defmulti expand-constraint
"Expand into additional nodes which reflect `constraints` and apply
them to specs. "
(fn [[constraint & specs]] (type constraint)))
(defmethod expand-constraint String [path-spec]
(expand-path path-spec))
(defmethod expand-constraint clojure.lang.APersistentMap [query-constraint-spec]
(expand-query-constraint query-constraint-spec))
(defmethod expand-constraint clojure.lang.PersistentVector [spec]
(assert false (unexpected-vector-in-route spec)))
(defmethod expand-constraint :default [unmatched]
(assert false (unmatched-type-in-constraint unmatched)))
(defprotocol ExpandableVerbAction
(expand-verb-action [expandable-verb-action]
"Expand `expandable-verb-action` into a verbose-form verb-map."))
(def valid-handler? (some-fn seq? symbol? interceptor/interceptor?))
(def interceptor-vector? (every-pred vector? (comp :interceptors meta)))
(def constraint-map? (every-pred map? (comp :constraints meta)))
(extend-protocol ExpandableVerbAction
clojure.lang.Symbol
(expand-verb-action [symbol] symbol)
clojure.lang.IPersistentList
(expand-verb-action [l] (expand-verb-action (eval l)))
clojure.lang.APersistentVector
(expand-verb-action [vector]
;; Take this apart by hand so we can provide nice error
;; messages. Exceptions from destructuring are opaque to users.
(let [original vector
route-name (when (keyword? (first vector)) (first vector))
vector (if (keyword? (first vector)) (next vector) vector)
interceptors (vec (apply concat (filter interceptor-vector? vector)))
vector (remove interceptor-vector? vector)
handler (first vector)
vector (next vector)
_ (assert (valid-handler? handler) (invalid-handler handler original))]
(assert handler (missing-handler handler original))
(assert (empty? vector) (leftover-declarations vector original))
{:route-name route-name
:handler handler
:interceptors interceptors}))
io.pedestal.interceptor.Interceptor
(expand-verb-action [interceptor]
{:handler interceptor}))
(defn- expand-verbs
"Expand tersely specified verb-map into a verbose verb-map."
[verb-map]
(into {}
(map (fn [[k v]] [k (expand-verb-action v)])
verb-map)))
(defn- expand-abstract-constraint
"Expand all of the directives in specs, adding them to routing-tree-node."
[routing-tree-node specs]
(let [vectors (filter vector? specs)
maps (filter map? specs)
children (filter (comp not :interceptors meta) vectors)
interceptors (filter interceptor-vector? specs)
verbs (reduce merge {} (filter (comp not :constraints meta) maps))
constraints (reduce merge {} (filter constraint-map? specs))]
(cond-> routing-tree-node
(not (empty? verbs)) (assoc :verbs (expand-verbs verbs))
(not (empty? constraints)) (assoc :constraints constraints)
(not (empty? interceptors)) (assoc :interceptors (vec (apply concat interceptors)))
(not (empty? children)) (assoc :children (map expand-constraint children)))))
(defn- expand-path
"Expand a path node in the routing tree to a node specifying its
path, constraints, verbs, and children."
[[path & specs]]
(expand-abstract-constraint {:path path} specs))
(defn- expand-query-constraint
"Expand a query constraint node in the routing tree to a node
specifying its constraints, verbs, and children."
[specs]
(expand-abstract-constraint {:constraints {} #_query-constraint} specs))
(defn- extract-children
"Return the children, if present, from route-domain."
[route-domain]
(filter vector? route-domain))
(defn- add-children
"Add the :children key to verbose-map from route-domain, if appropriate."
[route-domain verbose-map]
(if-let [children (extract-children route-domain)]
(assoc verbose-map :children (map expand-constraint children))
verbose-map))
(defn first-of [p coll] (first (filter p coll)))
(defn- extract-port
"Return the port, if present, from route-domain."
[route-domain]
(first-of number? route-domain))
(defn- extract-host
"Return the host, if present, from route-domain."
[route-domain]
(first-of string? route-domain))
(defn- extract-scheme
"Return the scheme, if present, from route-domain."
[route-domain]
(first-of #(and (keyword? %) (route.definition/schemes %)) route-domain))
(defn- extract-app-name
"Return the app name, if present, from route-domain."
[route-domain]
(first-of #(and (keyword? %) (not (route.definition/schemes %))) route-domain))
(defn map-routes->vec-routes
"Given a map-based route description,
return Pedestal's terse, vector-based routes, with interceptors correctly setup.
These generated routes can be consumed by `expand-routes`"
[route-map]
(reduce (fn [acc [k v :as route]]
(let [verbs (select-keys v [:get :post :put :delete :any])
interceptors (:interceptors v)
constraints (:constraints v)
subroutes (map #(apply hash-map %) (select-keys v (filter string? (keys v))))
subroute-vecs (mapv map-routes->vec-routes subroutes)]
(into acc (filter seq (into
[k verbs
(when (seq interceptors)
(with-meta interceptors
{:interceptors true}))
(when (seq constraints)
(with-meta constraints
{:constraints true}))]
subroute-vecs)))))
[] route-map))
(defn dissoc-when
"Dissoc those keys from m whose values in m satisfy pred."
[pred m]
(apply dissoc m (filter #(pred (m %)) (keys m))))
(def preamble? (some-fn number? string? keyword?))
(defn flatten-terse-app-routes
"Return a vector of maps that are equivalent to the terse routing syntax, but
expanded for consumption by the verbose route parser."
[route-spec]
(let [[preamble routes] (split-with preamble? route-spec)]
(assert (count routes) "There should be at least one route in the application vector")
(log/debug :app-name (extract-app-name preamble) :route-count (count routes))
(->> {:app-name (extract-app-name preamble)
:host (extract-host preamble)
:scheme (extract-scheme preamble)
:port (extract-port preamble)}
(dissoc-when nil?)
(add-children routes))))
(defn terse-routes [route-spec]
(verbose/expand-verbose-routes (map flatten-terse-app-routes route-spec)))