Skip to content
This repository has been archived by the owner on Mar 18, 2019. It is now read-only.

Multi-arity featurec #118

Merged
merged 18 commits into from
Apr 1, 2016
Merged

Multi-arity featurec #118

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
18 commits
Select commit Hold shift + click to select a range
8799e4d
Add test for linking events
lvh Mar 28, 2016
e3d60d2
Add test for find-free-vars with linked events
lvh Mar 28, 2016
c7aba62
Test multiple consistent literals
lvh Mar 28, 2016
bcc6aa9
Add dsl-literal?
lvh Mar 28, 2016
68a44ec
Refactor commutative featurec
lvh Mar 28, 2016
f02aaa2
Multiple literals should just always error
lvh Mar 28, 2016
14f8abc
Add some fake gensym to make the test work
lvh Mar 28, 2016
7d9b318
Make the tests pass
lvh Mar 28, 2016
27280e0
Move fake gensym out into a macro
lvh Mar 28, 2016
e381297
Add test for multiple terms unified with literal
lvh Mar 28, 2016
84be0ee
Multi-arity featurec
lvh Mar 28, 2016
8bd4cc7
Code golf
lvh Mar 29, 2016
44935ce
Add negative test for multi-arity featurec
lvh Mar 29, 2016
ff40552
Add positive test for multi-arity featurec
lvh Mar 29, 2016
16277a1
Test multi-arity features without a literal
lvh Mar 29, 2016
7edbed8
Add assertion message
lvh Mar 30, 2016
197bb4f
Add assertion message; make IPs visually distinct
lvh Mar 30, 2016
f5a1a96
Merge branch 'master' into multi-arity-features
lvh Mar 31, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 13 additions & 7 deletions src/desdemona/query.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -58,18 +58,24 @@
(finally
(in-ns (ns-name old-ns)))))))

(def dsl-literal?
"Is this a literal in the DSL?"
string?)

(defn ^:private dsl->logic
"Given a DSL query, compile it to the underlying logic (miniKanren)
expressions."
[dsl-query]
(m/match [dsl-query]
[((= ((attr lvar) :seq) value) :seq)]
(let [lvar (free-sym lvar)]
`(l/featurec ~lvar {~attr ~value}))

[((= value ((attr lvar) :seq)) :seq)]
(let [lvar (free-sym lvar)]
`(l/featurec ~lvar {~attr ~value}))
[(('= & terms) :seq)]
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I should consider testing the negative case where some of the terms are bogus, seeing what the error message is, and seeing if I can improve it by introducing a predicate on the terms.

(let [{literals true attr-terms false} (group-by dsl-literal? terms)
feature (fn [value [attr lvar]]
`(l/featurec ~(free-sym lvar) {~attr ~value}))]
(m/match [(count literals) (count attr-terms)]
[1 1] (feature (first literals) (first attr-terms))
[1 _] `(l/all ~@(map (partial feature (first literals)) attr-terms))
[0 _] (let [u (gensym)]
`(l/fresh [~u] ~@(map (partial feature u) attr-terms)))))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it's pretty great that even though this adds clear features compared to the previous version and yet it is only 2 lines longer; the only reason it's longer is because it generates the same code for old samples; if it was OK to always generate a fresh form, it could be just as long as possibly even shorter.


[(('and & terms) :seq)]
(let [logic-terms (map dsl->logic terms)]
Expand Down
60 changes: 57 additions & 3 deletions test/desdemona/query_test.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,20 @@

#{'x}
(#'q/dsl->logic '(and (= (:ip x) "10.0.0.1")
(= (:type x) "egress")))))
(= (:type x) "egress")))

#{'x 'y}
(#'q/dsl->logic '(= (:ip x) (:ip y)))))

(defmacro with-fake-gensym
[& body]
`(let [gensym-count# (atom 0)
fake-gensym# (fn [& args#]
(->> (swap! gensym-count# inc)
(str "fake-gensym-")
(symbol)))]
(with-redefs [clojure.core/gensym fake-gensym#]
~@body)))

(deftest dsl->logic-tests
(is (thrown? IllegalArgumentException
Expand Down Expand Up @@ -84,7 +97,27 @@
[(clojure.core.logic/featurec x {:type "egress"})]
[(clojure.core.logic/featurec x {:ip "10.0.0.1"})])
(#'q/dsl->logic '(or (= (:type x) "egress")
(= (:ip x) "10.0.0.1")))))))
(= (:ip x) "10.0.0.1"))))))
(testing "multiple literals"
(is (thrown? IllegalArgumentException
(#'q/dsl->logic '(= (:ip x) "10.0.0.1" "10.0.0.1")))
"repeated but consistent literal")
(is (thrown? IllegalArgumentException
(#'q/dsl->logic '(= (:ip x) "1.1.1.1" "8.8.8.8")))
"repeated inconsistent literal"))
(testing "multiple terms unified with a literal"
(is (= '(clojure.core.logic/all
(clojure.core.logic/featurec x {:ip "10.0.0.1"})
(clojure.core.logic/featurec y {:ip "10.0.0.1"}))
(#'q/dsl->logic '(= (:ip x) (:ip y) "10.0.0.1"))
(#'q/dsl->logic '(= (:ip x) "10.0.0.1" (:ip y)))
(#'q/dsl->logic '(= "10.0.0.1" (:ip x) (:ip y))))))
(testing "linking events"
(with-fake-gensym
(is (= '(clojure.core.logic/fresh [fake-gensym-1]
(clojure.core.logic/featurec x {:ip fake-gensym-1})
(clojure.core.logic/featurec y {:ip fake-gensym-1}))
(#'q/dsl->logic '(= (:ip x) (:ip y))))))))

(def events
[{:ip "10.0.0.1"}
Expand Down Expand Up @@ -164,7 +197,28 @@
[{:ip "10.0.0.2" ;; ip clause succeeded
:type "egress"}]
[{:ip "10.0.0.2" ;; ip clause succeeded
:type "ingress"}]])))
:type "ingress"}]]))
(testing "multi-arity featurec with literal"
(are [query results] (= results (q/run-dsl-query 10 query events))
'(= (:ip x) (:ip y) "1.2.3.4")
[]

'(= (:ip x) (:ip y) "10.0.0.1")
[[{:ip "10.0.0.1"}
{:ip "10.0.0.1"}]]))
(testing "multi-arity features without literal"
(are [query results] (= results (q/run-dsl-query 10 query events))
'(= (:ip x) (:ip y))
[[{:ip "10.0.0.1"}
{:ip "10.0.0.1"}]
[{:ip "10.0.0.2" :type "egress"}
{:ip "10.0.0.2" :type "egress"}]
[{:ip "10.0.0.2" :type "egress"}
{:ip "10.0.0.2" :type "ingress"}]
[{:ip "10.0.0.2" :type "ingress"}
{:ip "10.0.0.2" :type "egress"}]
[{:ip "10.0.0.2" :type "ingress"}
{:ip "10.0.0.2" :type "ingress"}]])))

(deftest run-logic-query-tests
(are [query results] (= results (#'q/run-logic-query query events))
Expand Down