Merge branch 'master' of github.com:threatgrid/naga into issue-42

Author: Paula Gearon

.travis.yml

@@ -1 +1,13 @@
 language: clojure
+
+install:
+ - lein deps
+
+script:
+ - lein kibit
+ - lein test
+
+notifications:
+ email:
+ on_success: change
+ on_failure: change

README.md

@@ -114,7 +114,7 @@ This may eventually be split out into its own project.
 
 ## License
 
-Copyright © 2016 Cisco Systems
+Copyright © 2016-2017 Cisco Systems
 
 Copyright © 2011-2016 Paula Gearon
 

doc/NagaFramework.png

@@ -10,4 +10,5 @@
  [the/parsatron "0.0.7"]
  [cheshire "5.6.3"]
  [com.datomic/datomic-free "0.9.5544"]]
+ :profiles {:dev {:plugins [[lein-kibit "0.1.3"]]}}
  :main naga.cli)

project.clj

@@ -33,14 +33,15 @@
 
 (defn usage
  [{summary :summary}]
- (->> ["Executes Naga on a program."
- ""
- "Usage: naga [filename]"
- ""
- summary
- (str "Store types: " (into [] stores))
- ""]
- (string/join \newline)))
+ (string/join
+ \newline
+ ["Executes Naga on a program."
+ ""
+ "Usage: naga [filename]"
+ ""
+ summary
+ (str "Store types: " (vec stores))
+ ""]))
 
 (defn run-all
  "Runs a program, and returns the data processed, the results, and the stats.
@@ -74,7 +75,6 @@
  :output (remove (set axioms) data)
  :stats stats}))
 
-
 (defn- nm
  "Returns a string version of a keyword. These are not being represented
  as Clojure keywords, so namespaces (when they exist) are separated by
@@ -84,7 +84,6 @@
  (str n ":" (name k))
  (name k)))
 
-
 (defn- predicate-string
  "Convert a predicate triplet into a string."
  [[e p v]]
@@ -95,7 +94,7 @@
 (defn logic-program
  [in-stream]
  (let [{:keys [input output stats]} (run-all in-stream)]
- (println "INPUT DATA") 
+ (println "INPUT DATA")
  (doseq [a input] (println (predicate-string a)))
  (println "\nNEW DATA")
  (doseq [a output] (println (predicate-string a)))))

src/naga/cli.clj

@@ -22,7 +22,7 @@
  [k (into {} (map #(apply vector (rest %)) vs))]))
  (into {}))
  node-list (loop [nl [] n node]
- (if (= :naga/nil n)
+ (if-not n
  nl
  (let [{f :naga/first r :naga/rest} (listmap n)]
  (recur (conj nl f) r))))]
@@ -44,11 +44,10 @@
  (let [id (store/new-node *current-storage*)
  [value-id triples] (value-triples v)
  [next-id next-triples] (list-triples vs)]
- [id (concat [[id (store/data-property *current-storage* value-id) value-id]
-  [id :naga/rest next-id]]
+ [id (concat [[id (store/data-property *current-storage* value-id) value-id]]
+ (when next-id [[id :naga/rest next-id]])
  triples
- next-triples)])
- [:naga/nil nil]))
+ next-triples)])))
 
 (defmethod value-triples List
  [vlist]
@@ -59,7 +58,7 @@
 
 (defmethod value-triples Map [v] (map->triples v))
 
-(defmethod value-triples nil [v] [:naga/nil nil])
+(defmethod value-triples nil [v] nil)
 
 (defmethod value-triples :default [v] [v nil])
 
@@ -69,7 +68,7 @@
  and builds triples around it"
  [entity-id :- s/Any
  [property value] :- [s/Keyword s/Any]]
- (let [[value-id value-data] (value-triples value)]
+ (if-let [[value-id value-data] (value-triples value)]
  (cons [entity-id property value-id] value-data)))
 
 
@@ -103,8 +102,7 @@
  "Converts parsed JSON into a sequence of triples for a provided storage."
  [storage j]
  (binding [*current-storage* storage]
- (doall (apply concat
- (map ident-map->triples j)))))
+ (doall (mapcat ident-map->triples j))))
 
 
 (s/defn stream->triples :- [Triple]
@@ -129,8 +127,7 @@
  "Return all the property/value pairs for a given entity in the store."
  [store :- Storage
  entity :- s/Any]
- (if-not (= entity :naga/nil)
- (store/resolve-pattern store [entity '?p '?o])))
+ (store/resolve-pattern store [entity '?p '?o]))
 
 
 (s/defn check-structure :- (s/maybe [[s/Keyword s/Any]])
@@ -162,8 +159,9 @@
  ;; convert the data to a map
  (let [st (into {} pairs)]
  ;; if the properties indicate a list, then process it
- (if-let [remaining (:naga/rest st)]
- (let [first-prop-elt (get-data st)
+ (when (:naga/first st)
+ (let [remaining (:naga/rest st)
+ first-prop-elt (get-data st)
  [_ first-elt] (recurse-node store first-prop-elt)]
  (assert first-elt)
  ;; recursively build the list
@@ -184,11 +182,12 @@
  "Uses a set of property-value pairs to load up a nested data structure from the graph"
  [store :- Storage
  prop-vals :- [[s/Keyword s/Any]]]
- (->
+ (dissoc
  (->> prop-vals
  (map (partial recurse-node store))
  (into {}))
- (dissoc :db/id :db/ident)))
+ :db/id
+ :db/ident))
 
 
 (s/defn id->json :- {s/Keyword s/Any}

src/naga/data.clj

@@ -93,16 +93,16 @@
  ;; the rule was run
  [storage
  (u/mapmap :name (comp deref :execution-count) (vals rules))]
- 
+
 
  ;; find if any patterns have updated
  (if-let [dirty-patterns (seq (keep extract-dirty-pattern
  status))]
  ;; rule needs to be run
  (let [counted-patterns (keep (partial resolve-count storage status)
-  dirty-patterns)
+ dirty-patterns)
 
- counted-set (into #{} counted-patterns)
+ counted-set (set counted-patterns)
 
  hinted-patterns (map #(get counted-set % %) body)]
 
@@ -142,7 +142,6 @@
  {:keys [rules axioms]} :- Program]
  (let [storage (store/get-storage-handle config)
  storage' (store/start-tx storage)
- [output-storage stats] (->> (store/assert-data storage' axioms)
- (execute rules))
+ [output-storage stats] (execute rules (store/assert-data storage' axioms))
  result-storage (store/commit-tx output-storage)]
  [result-storage stats]))

src/naga/engine.clj

@@ -6,7 +6,7 @@
  [the.parsatron :refer :all]
  [naga.schema.structs :as st]))
 
-(defn choice* 
+(defn choice*
  "choice with backtracking."
  [& args]
  (apply choice (map attempt args)))
@@ -60,7 +60,7 @@
 
 ;; This does not include all legal characters.
 ;; Consider some others in future, especially >
-(def ns-word (many1 (choice (letter) (char \_) (char \-) (char \:))))
+(def ns-word (many1 (choice (letter) (digit) (char \_) (char \-) (char \:))))
 
 (def word (many1 (letter)))
 
@@ -73,48 +73,49 @@
 
 (defparser integer []
  (let->> [i (either digits (signed-digits))]
- (always (Long/parseLong (apply str i)))))
+ (always (Long/parseLong (str/join i)))))
 
 (defparser floating-point []
  (let->> [i (either digits (signed-digits))
  f (>> (char \.) (many1 (digit)))]
- (always (Double/parseDouble (apply str (apply str i) \. f)))))
+ (always (Double/parseDouble (apply str (str/join i) \. f)))))
 
 (def number (either* (floating-point) (integer)))
 
 ;; parses strings of the form: 'it''s a string!'
 (defparser pstring1 []
- (let->> [s (many1 (between (char \') (char \') (many non-squote))) ]
- (always (apply str (flatten (interpose \' s))))))
+ (let->> [s (many1 (between (char \') (char \') (many non-squote)))]
+ (always (str/join (flatten (interpose \' s))))))
 
 ;; parses strings of the form: "She said, ""Hello,"" to me."
 (defparser pstring2 []
  (let->> [s (many1 (between (char \") (char \") (many non-dquote)))]
- (always (apply str (flatten (interpose \" s))))))
+ (always (str/join (flatten (interpose \" s))))))
 
 (def pstring (either (pstring1) (pstring2)))
 
 ;; variables start with a capital. Internally they start with ?
 (defparser variable []
  (let->> [f (upper-case-letter)
- r (many (letter))]
- (always (symbol (apply str "?" (Character/toLowerCase f) r) ))))
+ r (many (choice (letter) (digit) (char \_) (char \-)))]
+ (always (symbol (apply str "?" (Character/toLowerCase f) r)))))
 
 (defn build-keyword
  "Creates a keyword from a parsed word token"
  [wrd]
  (let [[kns kname :as w] (str/split wrd #":")
  parts (count w)]
  ;; use cond without a default to return nil
- (cond (= 2 parts) (cond (empty? kns) (keyword kname)
+ (cond (Character/isDigit (first wrd)) nil
+ (= 2 parts) (cond (empty? kns) (keyword kname)
  (seq kname) (keyword kns kname))
  (= 1 parts) (if-not (str/ends-with? wrd ":")
  (keyword kns)))))
 
 ;; atomic values, like a predicate, are represented as a keyword
 (defparser kw []
  (let->> [r ns-word]
- (let [wrd (apply str r)]
+ (let [wrd (str/join r)]
  (if-let [k (build-keyword wrd)]
  (always k)
  (throw (fail (str "Invalid identifier: " wrd)))))))

src/naga/lang/basic.clj

@@ -67,16 +67,16 @@ Parses code and returns Naga rules."
 
 (def RuleAST
  {:type (s/eq :rule)
- :head [(s/one VK "property")
- (s/one Args "arguments")]
+ :head [[(s/one VK "property")
+  (s/one Args "arguments")]]
  :body [Predicate]})
 
 (s/defn ast->rule :- Rule
  "Converts the rule structure returned from the parser"
  [{:keys [head body] :as rule-ast} :- RuleAST]
- (r/rule (triplet head)
+ (r/rule (map triplet head)
  (mapcat structure body)
- (-> head first name gensym name)))
+ (-> head ffirst name gensym name)))
 
 (s/defn read-str :- {:rules [Rule]
  :axioms [Axiom]}

src/naga/lang/pabu.clj

@@ -47,7 +47,7 @@
 
 ;; a clause with a rule
 (defparser nonbase-clause []
- (let->> [head (>> opt-whitespace (structure))
+ (let->> [head (>> opt-whitespace (structures))
  _ (>> opt-whitespace (string ":-") opt-whitespace)
  body (structures)
  _ (>> opt-whitespace (char \.) opt-whitespace)]