[nap] tags example

kiss/src/kiss/Macros.hx

@@ -553,6 +553,7 @@ class Macros {
                         argList.push(propExp);
                         propertyDefs.push(
                             b.call(b.symbol("defprop"), [propExp]));
+                        // TODO allow &prop &mut or &mut &prop
                         switch (propExp.def) {
                             case TypedExp(_, {pos: _, def: Symbol(name)}):
                                 propertySetExps.push(

projects/nap/build.hxml

@@ -1,7 +0,0 @@
--lib uuid
--lib kiss
--lib hscript
--lib tink_json
--cp src
---main nap.Main
---interp

projects/nap/example-archive/song1.json

@@ -1 +0,0 @@
-{"name":"Villain Alcohol","id":"song1","components":[["Tag", ["song"]]]}

projects/nap/haxelib.json

@@ -8,7 +8,6 @@
     "releasenote": "It isn't safe to use this library yet.",
     "contributors": ["NQNStudios"],
     "classPath": "src/",
-    "main": "nap.Main",
     "dependencies": {
         "kiss": "",
         "tink_json": ""

projects/nap/src/nap/Archive.hx

@@ -1,10 +1,10 @@
 package nap;
 
-import kiss.Prelude;
 import sys.FileSystem;
+import kiss.Prelude;
 import sys.io.File;
 import tink.Json;
-import nap.systems.TagSystem;
+import uuid.Uuid;
 
 using haxe.io.Path;
 

projects/nap/src/nap/Archive.kiss

@@ -1,16 +1,18 @@
-(defnew [archiveDir]
+(defnew [&prop :String archiveDir
+            &prop :Array<System> systems]
+
     [:Map<String,Entry> entries
-            (let [entryFiles (FileSystem.readDirectory archiveDir)]
-                (for file entryFiles =>(file.withoutExtension) ~(the Entry (Json.parse (File.getContent (Path.join [archiveDir file]))))))
-        :Array<System> systems [
-            (the System (new TagSystem "song"))]]
+            (let [entryFiles (FileSystem.readDirectory (Path.join [archiveDir "entries"]))]
+                (for file entryFiles =>(file.withoutExtension) ~(the Entry (Json.parse (File.getContent (Path.join [archiveDir "entries" file]))))))]
+
+    // Assign entries to the Systems that care about them
     (doFor system systems
         (doFor =>id entry entries
             (when (system.canProcessEntry entry)
                 (system.entries.push entry)))))
 
-(defmethod :Void handleEvent [:Event e]
-    (throw "can't handle $e"))
-
-(defmethod :Void process []
-    (doFor system systems (system.process)))
+(defun :Entry _newEntry []
+    (object
+        id (Uuid.v4)
+        components (new Map)
+        files []))

projects/nap/src/nap/BoolExpInterp.hx

@@ -1,7 +1,10 @@
 package nap;
 
 import kiss.KissInterp;
+import hscript.Parser;
+import kiss.Prelude;
 
+@:build(kiss.Kiss.build())
 class BoolExpInterp extends KissInterp {
     public function new() {
         super();

projects/nap/src/nap/BoolExpInterp.kiss

@@ -0,0 +1,9 @@
+(defun eval [:String expStr :Array<String> activeConditions]
+    (let [hscriptExp
+                (.parseString (new Parser)
+                    (Prelude.convertToHScript expStr))
+            interp
+                (new BoolExpInterp)]
+        (doFor condition activeConditions
+            (interp.variables.set condition true))
+        ?(interp.execute hscriptExp)))

projects/nap/src/nap/Entry.hx

@@ -2,6 +2,6 @@ package nap;
 
 typedef Entry = {
     id:String,
-    name:String,
-    components:Map<String, Array<Dynamic>>
+    components:Map<String, String>,
+    files:Array<String>
 };

projects/nap/src/nap/Event.hx

@@ -1,7 +0,0 @@
-package nap;
-
-/**
- * All types of user input events to the NAP system. Archive handles these, acting as a backend
- * for whichever front-end generates the Events.
- */
-enum Event {}

projects/nap/src/nap/Lib.hx

@@ -1,10 +1,11 @@
 package nap;
 
-import uuid.Uuid;
 import kiss.Prelude;
-import kiss.Stream;
-import hscript.Parser;
-import hscript.Interp;
+import sys.io.File;
+import tink.Json;
+import uuid.Uuid;
+
+using haxe.io.Path;
 
 @:build(kiss.Kiss.build())
 class Lib {}

projects/nap/src/nap/Lib.kiss

@@ -1,15 +1,20 @@
-(defun evalBoolExp [:String expStr :Array<String> activeConditions]
-    (let [hscriptExp
-                (.parseString (new Parser)
-                    (Prelude.convertToHScript expStr))
-            interp
-                (new BoolExpInterp)]
-        (doFor condition activeConditions
-            (interp.variables.set condition true))
-        ?(interp.execute hscriptExp)))
+// Lib is its own class because, while it would make sense to group its functions and macros in Archive.kiss,
+// other files would not be able to (load "Archive.kiss") for the macro definitions without taking on Archive's constructor.
 
-(defun :Entry newEntry [:String name]
-    (object
-        id (Uuid.v4)
-        name name
-        components (new Map)))
+(defmacro hasComponent [e componentType]
+    `(.exists .components ,e ,(symbolName componentType)))
+
+// TODO add to the documentation a hint that macros should use fully qualified paths so macro caller classes don't need to import everything
+(defmacro getComponent [archive e componentType]
+    `(the nap.components ,componentType 
+        (tink.Json.parse
+            (sys.io.File.getContent
+                (haxe.io.Path.join [.archiveDir (the nap.Archive ,archive) "components" (+ (dictGet (the Map<String,String> .components ,e) ,(symbolName componentType)) ".json")])))))
+
+(defun tagList [archive e]
+    (let [t
+                (getComponent archive e Tags)]
+        (collect (t.keys))))
+
+(defun tagsMatch [archive e tagsBoolExp]
+    (BoolExpInterp.eval tagsBoolExp (tagList archive e)))

projects/nap/src/nap/Main.hx

@@ -1,7 +0,0 @@
-package nap;
-
-import kiss.Kiss;
-import kiss.Prelude;
-
-@:build(kiss.Kiss.build())
-class Main {}

projects/nap/src/nap/Main.kiss

@@ -1,27 +0,0 @@
-(defun :Void main []
-    ~(Lib.evalBoolExp "true" [])
-    ~(Lib.evalBoolExp "false" [])
-    ~(Lib.evalBoolExp "flag" [])
-    ~(Lib.evalBoolExp "flag" ["flag"])
-    ~(Lib.evalBoolExp "(and flag false)" ["flag"])
-    ~(Lib.evalBoolExp "(or flag otherFlag)" ["otherFlag"])
-    //trace(error);
-    (let [archiveDir
-                // TODO optional flags like --cache will complicate this way of handling args
-                (.shift (Sys.args))
-            archive
-                (new Archive archiveDir)]
-        // TODO run a front-end -- could be a test frontend that sends predetermined list of events
-        (archive.process)))
-    
-    
-    
-    /*
-    (let [e (new Entry "name")]
-        (dictSet e.components "f" [5])
-        (dictSet e.components "b" [(object c "d")])
-        (let [s (haxe.Json.stringify e)
-                :Entry e2 (haxe.Json.parse s)]
-            // can't call Entry methods on e2
-            (print s))))
-            */

projects/nap/src/nap/components/Tag.hx

@@ -1,3 +0,0 @@
-package nap.components;
-
-typedef Tag = String;

projects/nap/src/nap/components/Tag.kiss

@@ -1,2 +0,0 @@
-(defun :Array<String> getTags [:Entry e]
-    (or (dictGet e.components "Tag") []))

projects/nap/src/nap/components/Tags.hx

@@ -0,0 +1,3 @@
+package nap.components;
+
+typedef Tags = Map<String, Int>;

projects/nap/src/nap/systems/TagSystem.kiss

@@ -1,6 +1,4 @@
-(load "../components/Tag.kiss")
-
 (defnew [&prop :String tagFilterString] [])
 
-(defmethod &override :Bool canProcessEntry [:Entry e]
-    (Lib.evalBoolExp tagFilterString (getTags e)))
+(defmethod &override :Bool canProcessEntry [:Entry e] (print false))
+    // (Lib.evalBoolExp tagFilterString (getTags e)))

projects/nap/src/test/TestMain.hx

@@ -4,6 +4,8 @@ import kiss.Kiss;
 import kiss.Prelude;
 import nap.BoolExpInterp;
 import nap.Archive;
+import nap.Lib;
+import nap.components.*;
 
 @:build(kiss.Kiss.build())
 class TestMain {}

projects/nap/src/test/TestMain.kiss

@@ -1,3 +1,7 @@
+// TODO external programs need to be able to find and (load) this path to get the macros:
+(load "../nap/Lib.kiss")
+
+
 (defun :Void main []
     (assert (BoolExpInterp.eval "true" []))
     (assert !(BoolExpInterp.eval "false" []))
@@ -9,17 +13,16 @@
     (let [systems
                 []
             archive
-                (new Archive "src/test/example-archive" systems)]
-        (print "TODO")))
+                (new Archive "src/test/example-archive" systems)
+            song1
+                (dictGet archive.entries "song1")
+            song2
+                (dictGet archive.entries "song2")]
 
-    
-    
-    /*
-    (let [e (new Entry "name")]
-        (dictSet e.components "f" [5])
-        (dictSet e.components "b" [(object c "d")])
-        (let [s (haxe.Json.stringify e)
-                :Entry e2 (haxe.Json.parse s)]
-            // can't call Entry methods on e2
-            (print s))))
-            */
+        (assert (hasComponent song1 Tags))
+        (assert (hasComponent song2 Tags))
+        (assert (tagsMatch archive song1 "(and song western)"))
+        (assert !(tagsMatch archive song1 "(and song religious)"))
+        (assert (tagsMatch archive song2 "(and song religious)"))
+        (assert !(tagsMatch archive song2 "(and song western)"))
+        ))

projects/nap/test.hxml

@@ -0,0 +1,6 @@
+-D test
+-lib kiss
+-lib nap
+-cp test
+--main test.TestMain
+--interp

projects/nap/test.sh

@@ -1,4 +1,4 @@
 #! /bin/bash
 
 haxelib dev nap .
-haxelib run nap example-archive
+haxe test.hxml