00f7bec64b84

--- a/bones-test.asd	Sun Apr 24 13:52:33 2016 +0000
+++ b/bones-test.asd	Sun Apr 24 13:55:28 2016 +0000
@@ -9,5 +9,6 @@
                (:module "test"
                 :serial t
                 :components ((:file "bones")
-                             (:file "paip")))))
+                             (:file "paip")
+                             (:file "wam")))))
 

--- a/package-test.lisp	Sun Apr 24 13:52:33 2016 +0000
+++ b/package-test.lisp	Sun Apr 24 13:55:28 2016 +0000
@@ -11,4 +11,19 @@
     #:bones.quickutils
     #:bones.paip)
   ; kill me
-  (:shadowing-import-from #:5am #:fail))
+  (:shadowing-import-from #:5am
+    #:fail))
+
+(defpackage #:bones-test.wam
+  (:use
+    #:cl
+    #:5am
+    #:bones.quickutils
+    #:bones.wam)
+  (:import-from #:bones.wam
+    #:with-database
+    #:make-database
+    #:rules
+    #:facts
+    #:return-one
+    #:return-all))

--- a/test/run.lisp	Sun Apr 24 13:52:33 2016 +0000
+++ b/test/run.lisp	Sun Apr 24 13:55:28 2016 +0000
@@ -12,5 +12,6 @@
 
 (test :bones)
 (test :bones.paip)
+(test :bones.wam)
 
 (sb-ext:exit :code (if *passed* 0 1))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/wam.lisp	Sun Apr 24 13:55:28 2016 +0000
@@ -0,0 +1,139 @@
+(in-package #:bones-test.wam)
+
+(def-suite :bones.wam)
+(in-suite :bones.wam)
+
+
+;;;; Setup
+(defun make-test-database ()
+  (let ((db (make-database)))
+    (with-database db
+
+      (facts (always))
+
+      (facts (drinks tom :anything)
+             (drinks kim water)
+             (drinks alice bourbon)
+             (drinks bob genny-cream)
+             (drinks candace birch-beer))
+
+      (facts (listens alice blues)
+             (listens alice jazz)
+             (listens bob blues)
+             (listens bob rock)
+             (listens candace blues))
+
+      (facts (fuzzy cats))
+
+      (facts (cute cats)
+             (cute snakes))
+
+      (rules ((pets alice :what)
+              (cute :what))
+
+             ((pets bob :what)
+              (cute :what)
+              (fuzzy :what))
+
+             ((pets candace :bird)
+              (flies :bird)))
+
+      (rules ((likes sally :who)
+              (likes :who cats)
+              (drinks :who beer))
+
+             ((likes tom cats))
+             ((likes alice cats))
+             ((likes kim cats))
+
+             ((likes kim :who)
+              (likes :who cats))
+
+             )
+
+      (rules ((narcissist :person)
+              (likes :person :person))))
+    db))
+
+(defparameter *test-database* (make-test-database))
+
+
+;;;; Utils
+(defun result= (x y)
+  (set-equal (plist-alist x)
+             (plist-alist y)
+             :test #'equal))
+
+(defun results= (r1 r2)
+  (set-equal r1 r2 :test #'result=))
+
+; (defmacro status (successp query)
+;   `(eql )
+;   )
+
+(defmacro q (&body query)
+  `(with-database *test-database*
+    (return-all ,@query)))
+
+(defmacro check (query)
+  `(with-database *test-database*
+    (nth-value 1 (return-one ,query))))
+
+
+;;;; Tests
+(test facts-literal
+  (is (results= '(nil) (q (always))))
+  (is (results= '(nil) (q (fuzzy cats))))
+  (is (results= nil (q (fuzzy snakes)))))
+
+(test facts-variables
+  (is (results= '((:what cats))
+                (q (fuzzy :what))))
+  (is (results= '((:what blues)
+                  (:what rock))
+                (q (listens bob :what))))
+  (is (results= '((:who alice)
+                  (:who bob)
+                  (:who candace))
+                (q (listens :who blues))))
+  (is (results= '()
+                (q (listens :who metal)))))
+
+(test facts-conjunctions
+  (is (results= '((:who alice))
+                (q (listens :who blues)
+                   (listens :who jazz))))
+  (is (results= '((:who alice))
+                (q (listens :who blues)
+                   (drinks :who bourbon))))
+  (is (results= '((:what bourbon :who alice)
+                  (:what genny-cream :who bob)
+                  (:what birch-beer :who candace))
+                (q (listens :who blues)
+                   (drinks :who :what)))))
+
+(test basic-rules
+  (is (results= '((:what snakes)
+                  (:what cats))
+                (q (pets alice :what))))
+
+  (is (results= '((:what cats))
+                (q (pets bob :what))))
+
+  (is (results= '()
+                (q (pets candace :what))))
+
+  (is (results= '((:who alice))
+                (q (pets :who snakes))))
+
+  (is (results= '((:who tom)
+                  (:who alice)
+                  (:who kim)
+                  (:who cats))
+                (q (likes kim :who))))
+
+  (is (results= '((:who tom))
+                (q (likes sally :who))))
+
+  (is (results= '((:person kim))
+                (q (narcissist :person)))))