diff --git a/src/asami/query.cljc b/src/asami/query.cljc index 7d2c613..b69ea5d 100644 --- a/src/asami/query.cljc +++ b/src/asami/query.cljc @@ -176,9 +176,9 @@ (not (get varmap arg))) arg)) -(def Fn (s/pred #(or (fn? %) (var? %)))) +(def Fcn (s/pred #(or (fn? %) (var? %)))) -(s/defn resolve-op :- (s/maybe Fn) +(s/defn resolve-op :- (s/maybe Fcn) "Resolves a symbol to an associated function. Symbols without a namespace are presumed to be in clojure.core" [s :- s/Symbol] (when (or *override-restrictions* @@ -187,7 +187,7 @@ (sandbox/allowed-fns s))) (fn-for s))) -(s/defn retrieve-op :- Fn +(s/defn retrieve-op :- Fcn "Retrieves a function for a provided operation. An op can be a variable, a function, a symbol for a function, or a string" [op var-map part] (or @@ -217,10 +217,11 @@ (constantly (nth args i)))) args) filter-fn (if (vartest? op) - (let [op-idx (var-map op)] + (if-let [op-idx (var-map op)] (fn [a] (let [callable-op (retrieve-op (nth a op-idx) var-map part)] - (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes))))) + (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes)))) + (throw (ex-info (str "Unknown variable: " op) {:op op}))) (let [callable-op (retrieve-op op var-map part)] (fn [a] (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes)))))] @@ -245,14 +246,15 @@ arg-indexes (keep-indexed #(when-not (zero? %1) (var-map %2 (- %1))) expr) expr (vec expr) binding-fn (if (vartest? op) - (let [op-idx (var-map op)] + (if-let [op-idx (var-map op)] (fn [row] (let [o (retrieve-op (nth row op-idx) var-map part)] (concat row [(apply o (map #(if (neg? %) (nth expr (- %)) (nth row %)) - arg-indexes))])))) + arg-indexes))]))) + (throw (ex-info (str "Unknown variable: " op) {:op op}))) (let [callable-op (retrieve-op op var-map part)] (fn [row] (concat row diff --git a/test/asami/test_core_query.cljc b/test/asami/test_core_query.cljc index 1440de1..4eb4eb5 100644 --- a/test/asami/test_core_query.cljc +++ b/test/asami/test_core_query.cljc @@ -391,53 +391,95 @@ ["Purely Functional Data Structures"]} (set r3))))) - (deftest test-sandbox-queries - (let [st (-> empty-graph (assert-data data)) - r1 (binding [*override-restrictions* true] - (q '[:find ?title ?cost - :where [?book :title ?title] - [?book :price ?price] - [?book :profit ?profit] - [(read-string "-") ?minus] - [(?minus ?price ?profit) ?cost]] - st)) - r2 (q '[:find ?title ?cost - :in $ ?rs - :where [?book :title ?title] - [?book :price ?price] - [?book :profit ?profit] - [(?rs "-") ?minus] - [(?minus ?price ?profit) ?cost]] - st read-string) - r3 (binding [*env* {'rs read-string}] - (q '[:find ?title ?cost - :where [?book :title ?title] - [?book :price ?price] - [?book :profit ?profit] - [(rs "-") ?minus] - [(?minus ?price ?profit) ?cost]] - st))] - (is (thrown-with-msg? - ExceptionInfo #"Unsupported operation: read-string" - (q '[:find ?title ?cost - :where [?book :title ?title] - [?book :price ?price] - [?book :profit ?profit] - [(read-string "-") ?minus] - [(?minus ?price ?profit) ?cost]] - st))) - (is (= #{["The Art of Computer Programming" 35.66] - ["Basic Category Theory for Computer Scientists" 26.17] - ["Purely Functional Data Structures" 32.77]} - (set r1))) - (is (= #{["The Art of Computer Programming" 35.66] - ["Basic Category Theory for Computer Scientists" 26.17] - ["Purely Functional Data Structures" 32.77]} - (set r2))) - (is (= #{["The Art of Computer Programming" 35.66] - ["Basic Category Theory for Computer Scientists" 26.17] - ["Purely Functional Data Structures" 32.77]} - (set r3)))))) + #?(:clj + (deftest test-sandbox-queries + (let [st (-> empty-graph (assert-data data)) + r1 (binding [*override-restrictions* true] + (q '[:find ?title ?cost + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(read-string "-") ?minus] + [(?minus ?price ?profit) ?cost]] + st)) + r2 (q '[:find ?title ?cost + :in $ ?rs + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(?rs "-") ?minus] + [(?minus ?price ?profit) ?cost]] + st read-string) + r3 (binding [*env* {'rs read-string}] + (q '[:find ?title ?cost + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(rs "-") ?minus] + [(?minus ?price ?profit) ?cost]] + st))] + (is (thrown-with-msg? + ExceptionInfo #"Unsupported operation: read-string" + (q '[:find ?title ?cost + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(read-string "-") ?minus] + [(?minus ?price ?profit) ?cost]] + st))) + (is (= #{["The Art of Computer Programming" 35.66] + ["Basic Category Theory for Computer Scientists" 26.17] + ["Purely Functional Data Structures" 32.77]} + (set r1))) + (is (= #{["The Art of Computer Programming" 35.66] + ["Basic Category Theory for Computer Scientists" 26.17] + ["Purely Functional Data Structures" 32.77]} + (set r2))) + (is (= #{["The Art of Computer Programming" 35.66] + ["Basic Category Theory for Computer Scientists" 26.17] + ["Purely Functional Data Structures" 32.77]} + (set r3))))) + + ;; ClojureScript is already sandboxed, so this is just testing mechanism + :cljs + (deftest test-sandbox-queries + (let [st (-> empty-graph (assert-data data)) + r1 (q '[:find ?title ?cost + :in $ ?atom + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(?atom ?price) ?p] + [(deref ?p) ?p2] + [(- ?p2 ?profit) ?cost]] + st atom) + r2 (binding [*env* {'atom atom}] + (q '[:find ?title ?cost + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(atom ?price) ?p] + [(deref ?p) ?p2] + [(- ?p2 ?profit) ?cost]] + st))] + (is (thrown-with-msg? + ExceptionInfo #"Unsupported operation: atom" + (q '[:find ?title ?cost + :where [?book :title ?title] + [?book :price ?price] + [?book :profit ?profit] + [(atom ?price) ?p] + [(deref ?p) ?p2] + [(- ?p2 ?profit) ?cost]] + st))) + (is (= #{["The Art of Computer Programming" 35.66] + ["Basic Category Theory for Computer Scientists" 26.17] + ["Purely Functional Data Structures" 32.77]} + (set r1))) + (is (= #{["The Art of Computer Programming" 35.66] + ["Basic Category Theory for Computer Scientists" 26.17] + ["Purely Functional Data Structures" 32.77]} + (set r2))))))) (let [pa (nn) paa (nn)