-
Notifications
You must be signed in to change notification settings - Fork 10
/
pull.cljc
226 lines (193 loc) · 7.91 KB
/
pull.cljc
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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
(ns datalog.parser.pull
(:require [datalog.parser.impl.util :as util
#?(:cljs :refer-macros :clj :refer) [raise forv]])
(:refer-clojure :rename {pos? core-pos?}))
#?(:clj (set! *warn-on-reflection* true))
(defn- pos? [n]
(and (number? n) (core-pos? n)))
(defrecord PullSpec [wildcard? attrs])
(defrecord PullAttrName [attr])
(defrecord PullReverseAttrName [attr rattr])
(defrecord PullLimitExpr [attr limit])
(defrecord PullDefaultExpr [attr value])
(defrecord PullWildcard [])
(defrecord PullRecursionLimit [limit])
(defrecord PullMapSpecEntry [attr porrl])
(defrecord PullAttrWithOpts [attr opts])
(defprotocol IPullSpecComponent
(-as-spec [this]))
(extend-protocol IPullSpecComponent
PullAttrName
(-as-spec [this]
[(:attr this) {:attr (:attr this)}])
PullReverseAttrName
(-as-spec [this]
[(:rattr this) {:attr (:attr this)}])
PullLimitExpr
(-as-spec [this]
(-> (-as-spec (:attr this))
(assoc-in [1 :limit] (:limit this))))
PullDefaultExpr
(-as-spec [this]
(-> (-as-spec (:attr this))
(assoc-in [1 :default] (:value this))))
PullRecursionLimit
(-as-spec [this]
[:recursion (:limit this)])
PullMapSpecEntry
(-as-spec [this]
(-> (-as-spec (:attr this))
(update 1 conj (-as-spec (:porrl this)))))
PullAttrWithOpts
(-as-spec [this]
(-> (-as-spec (:attr this))
(update 1 merge (:opts this)))))
(defn- aggregate-specs [res part]
(if (instance? PullWildcard part)
(assoc res :wildcard? true)
(update res :attrs conj! (-as-spec part))))
(defrecord PullPattern [specs]
IPullSpecComponent
(-as-spec [this]
(let [init (PullSpec. false (transient {}))
spec (reduce aggregate-specs init specs)]
[:subpattern (update spec :attrs persistent!)])))
(declare parse-pattern)
(def ^:private wildcard? #{'* :* "*"})
(defn- parse-wildcard [spec]
(when (wildcard? spec)
(PullWildcard.)))
(defn- parse-attr-name [spec]
(when (or (keyword? spec) (string? spec))
(if (util/reverse-ref? spec)
(PullReverseAttrName. (util/reverse-ref spec) spec)
(PullAttrName. spec))))
(def ^:private unlimited-recursion? #{'... "..."})
(defn- parse-recursion-limit [spec]
(cond
(unlimited-recursion? spec) (PullRecursionLimit. nil)
(pos? spec) (PullRecursionLimit. spec)))
(defn- maybe-attr-expr? [spec]
(and (sequential? spec) (= 3 (count spec))))
(def ^:private limit? #{'limit :limit "limit"})
(defn- parse-limit-expr [spec]
(let [[limit-sym attr-name-spec pos-num] spec]
(when (limit? limit-sym)
(if-let [attr-name (and (or (nil? pos-num) (pos? pos-num))
(parse-attr-name attr-name-spec))]
(PullLimitExpr. attr-name pos-num)
(raise "Expected [\"limit\" attr-name (positive-number | nil)]"
{:error :parser/pull, :fragment spec})))))
(def ^:private default? #{'default :default "default"})
(defn- parse-default-expr [spec]
(let [[default-sym attr-name-spec default-val] spec]
(when (default? default-sym)
(if-let [attr-name (parse-attr-name attr-name-spec)]
(PullDefaultExpr. attr-name default-val)
(raise "Expected [\"default\" attr-name any-value]"
{:error :parser/pull, :fragment spec})))))
(defn- parse-map-spec-entry [[k v]]
(if-let [attr-name (or (parse-attr-name k)
(when (maybe-attr-expr? k)
(parse-limit-expr k)))]
(if-let [pattern-or-rec (or (parse-recursion-limit v)
(parse-pattern v))]
(PullMapSpecEntry. attr-name pattern-or-rec)
(raise "Expected (pattern | recursion-limit)"
{:error :parser/pull, :fragment [k v]}))
(raise "Expected (attr-name | limit-expr)"
{:error :parser/pull, :fragment [k v]})))
(defn- parse-map-spec [spec]
(when (map? spec)
(assert (= 1 (count spec)) "Maps should contain exactly 1 entry")
(parse-map-spec-entry (first spec))))
(let [opt? #{:as :limit :default}]
(defn- parse-attr-with-opts [spec]
(when (sequential? spec)
(let [[attr-name-spec & opts-spec] spec]
(when-some [attr-name (parse-attr-name attr-name-spec)]
(when (and (even? (count opts-spec))
(every? opt? (take-nth 2 opts-spec)))
(PullAttrWithOpts. attr-name (apply array-map opts-spec))))))))
(defn- parse-attr-expr [spec]
(when (maybe-attr-expr? spec)
(or (parse-limit-expr spec)
(parse-default-expr spec))))
(defn- parse-attr-spec [spec]
(or (parse-attr-name spec)
(parse-wildcard spec)
(parse-map-spec spec)
(parse-attr-with-opts spec)
(parse-attr-expr spec)
(raise "Cannot parse attr-spec, expected: (attr-name | wildcard | map-spec | attr-expr)"
{:error :parser/pull, :fragment spec})))
(defn- pattern-clause-type [clause]
(cond
(map? clause) :map
(wildcard? clause) :wildcard
:else :other))
(defn- expand-map-clause [clause]
(forv [[k v] clause]
{k v}))
(let [wildcarded? (comp not-empty :wildcard)]
(defn- simplify-pattern-clauses [pattern]
(let [groups (group-by pattern-clause-type pattern)
base (cond-> [] (wildcarded? groups) (conj '*))]
(into base
(concat
(:other groups)
(mapcat expand-map-clause (:map groups)))))))
(defn parse-pattern
"Parse an EDN pull pattern into a tree of records using the following
grammar:
```
pattern = [attr-spec+]
attr-spec = attr-name | wildcard | map-spec | attr-expr
attr-name = an edn keyword that names an attr
wildcard = \"*\" or '*'
map-spec = { ((attr-name | limit-expr) (pattern | recursion-limit))+ }
attr-with-opts = [attr-name attr-options+]
attr-options = :as any-value | :limit (positive-number | nil) | :default any-value
attr-expr = limit-expr | default-expr
limit-expr = [\"limit\" attr-name (positive-number | nil)]
default-expr = [\"default\" attr-name any-value]
recursion-limit = positive-number | '...'
```"
[pattern]
(when (sequential? pattern)
(->> pattern
simplify-pattern-clauses
(mapv parse-attr-spec)
(PullPattern.))))
(defn pattern->spec
"Convert a parsed tree of pull pattern records into a `PullSpec` instance,
a record type containing two keys:
* `:wildcard?` - a boolean indicating if the pattern contains a wildcard.
* `:attrs` - a map of attribute specifications.
The attribute specification map consists of keys which will become the keys
in the result map, and values which are themselves maps describing the
attribute:
* `:attr` (required) - The attr name to pull; for reverse attributes
this will be the normalized attribute name.
* `:as` (optional) - Alias, any
* `:limit` (optional) - If present, specifies a custom limit for this
attribute; Either `nil`, indicating no limit,
or a positive integer.
* `:default` (optional) - If present, specifies a default value for this
attribute
* `:recursion` (optional) - If present, specifies a recursion limit for this
attribute; Either `nil`, indicating no limit, or
a positive integer.
* `:subpattern` (optional) - If present, specifies a sub `PullSpec` instance
to be applied to entities matched by this
attribute."
[pattern]
(second (-as-spec pattern)))
(defn parse-pull
"Parse EDN pull `pattern` specification (see `parse-pattern`), and
convert the resulting tree into a `PullSpec` instance (see `pattern->spec`).
Throws an error if the supplied `pattern` cannot be parsed."
[pattern]
(or (some-> pattern parse-pattern pattern->spec)
(raise "Cannot parse pull pattern, expected: [attr-spec+]"
{:error :parser/pull, :fragment pattern})))