Refactor travis testing

haxelib.json

@@ -0,0 +1,15 @@
+{
+    "name": "nat-archive-tool",
+    "url": "https://github.com/hissvn/kisslang",
+    "license": "LGPL",
+    "tags": ["cross"],
+    "description": "",
+    "version": "0.0.0",
+    "releasenote": "It isn't safe to use this library yet.",
+    "contributors": ["NQNStudios"],
+    "classPath": "src/",
+    "dependencies": {
+        "kiss": "",
+        "tink_json": ""
+    }
+}

ideas.txt

@@ -0,0 +1,2 @@
+program that helps you cobble together journal entries retroactively using your texts and message history from that day. and calendar etc
+music player that youtubeDLs the songs you like, and will play songs by artists you like

src/nat/Archive.hx

@@ -0,0 +1,12 @@
+package nat;
+
+import sys.FileSystem;
+import kiss.Prelude;
+import sys.io.File;
+import tink.Json;
+import uuid.Uuid;
+
+using haxe.io.Path;
+
+@:build(kiss.Kiss.build())
+class Archive {}

src/nat/Archive.kiss

@@ -0,0 +1,42 @@
+(defnew [&prop :String archiveDir]
+
+    [:Array<System> systems
+            []
+        :Map<String,Template> templates
+            (new Map)
+        :Map<String,Entry> entries
+            (let [entryFiles (FileSystem.readDirectory (Path.join [archiveDir "entries"]))]
+                (for file entryFiles =>(file.withoutExtension) ~(the Entry (Json.parse (File.getContent (Path.join [archiveDir "entries" file]))))))])
+
+(defmethod addSystem [:System system]
+    // Assign entries to the Systems that care about them
+    (doFor =>id entry entries
+        (system.checkEntryInOrOut this entry))
+    (systems.push system))
+
+(defmethod addTemplate [name template]
+    (dictSet templates name template))
+
+(defmethod :Entry createEntry [template]
+    (let [e (_newEntry)]
+        (.prepareEntry (dictGet templates template) e)
+        (doFor system systems
+            (system.checkEntryInOrOut this e))
+        e))
+
+(defmethod saveEntry [:Entry e]
+    (File.saveContent
+        (Path.join [archiveDir "entries" (e.id.withExtension "json")])
+        (Json.stringify e))
+        
+    // TODO save its components? but it's not obvious how, because it only knows the string keys of them.
+    // Better yet, retrieving components with mutable access should be done through a
+    // (withComponent...) macro that serializes the component after the block is done.
+    // 
+    )
+
+(defun :Entry _newEntry []
+    (object
+        id (Uuid.v4)
+        components (new Map)
+        files []))

src/nat/BoolExpInterp.hx

@@ -0,0 +1,20 @@
+package nat;
+
+import kiss.KissInterp;
+import hscript.Parser;
+import kiss.Prelude;
+
+@:build(kiss.Kiss.build())
+class BoolExpInterp extends KissInterp {
+    public function new() {
+        super();
+    }
+
+    override function resolve(id:String):Dynamic {
+        return try {
+            super.resolve(id);
+        } catch (e:Dynamic) {
+            false;
+        }
+    }
+}

src/nat/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)))

src/nat/Entry.hx

@@ -0,0 +1,7 @@
+package nat;
+
+typedef Entry = {
+    id:String,
+    components:Map<String, String>,
+    files:Array<String>
+};

src/nat/Lib.hx

@@ -0,0 +1,11 @@
+package nat;
+
+import kiss.Prelude;
+import sys.io.File;
+import tink.Json;
+import uuid.Uuid;
+
+using haxe.io.Path;
+
+@:build(kiss.Kiss.build())
+class Lib {}

src/nat/Lib.kiss

@@ -0,0 +1,20 @@
+// 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.
+
+(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 nat.components ,componentType 
+        (tink.Json.parse
+            (sys.io.File.getContent
+                (haxe.io.Path.join [.archiveDir (the nat.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)))

src/nat/System.hx

@@ -0,0 +1,9 @@
+package nat;
+
+import kiss.Prelude;
+
+typedef EntryChecker = (Archive, Entry) -> Bool;
+typedef EntryProcessor = (Archive, Entry) -> Void;
+
+@:build(kiss.Kiss.build())
+class System {}

src/nat/System.kiss

@@ -0,0 +1,13 @@
+(defprop :Map<String,Entry> entries (new Map))
+
+(defmethod :Void process [:Archive archive]
+    (doFor e (entries.iterator) (processEntry archive e)))
+
+(defnew [&prop :EntryChecker canProcessEntry
+            &prop :EntryProcessor processEntry]
+    [])
+
+(defmethod :Void checkEntryInOrOut [:Archive archive :Entry e]
+    (if (canProcessEntry archive e)
+            (dictSet entries e.id e)
+        (entries.remove e.id)))

src/nat/Template.hx

@@ -0,0 +1,5 @@
+package nat;
+
+interface Template {
+    function prepareEntry(e:Entry):Void;
+}

src/nat/components/Dates.hx

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

src/nat/components/StringComponents.hx

@@ -0,0 +1,4 @@
+package nat.components;
+
+typedef Name = String;
+typedef Author = String;

src/nat/components/Tags.hx

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

src/nat/systems/TagSystem.hx

@@ -0,0 +1,6 @@
+package nat.systems;
+
+import kiss.Prelude;
+
+@:build(kiss.Kiss.build())
+class TagSystem extends System {}

src/nat/systems/TagSystem.kiss

@@ -0,0 +1,9 @@
+(load "../Lib.kiss")
+
+// TODO make a &super annotation that passes an argument to the super constructor
+(defnew [&prop :String tagFilterString
+            &prop :EntryProcessor processor] 
+    []
+    (super
+        (lambda [:Archive archive :Entry e] (tagsMatch archive e tagFilterString))
+        processor))

src/test/TestMain.hx

@@ -0,0 +1,11 @@
+package test;
+
+import kiss.Kiss;
+import kiss.Prelude;
+import nat.BoolExpInterp;
+import nat.Archive;
+import nat.Lib;
+import nat.components.*;
+
+@:build(kiss.Kiss.build())
+class TestMain {}

src/test/TestMain.kiss

@@ -0,0 +1,28 @@
+// TODO external programs need to be able to find and (load) this path to get the macros:
+// ^ That should be solved by allowing an optional first argument to load that is a symbol
+// of a library name that can be used to resolve the source dir in the user's Haxelib maybe?
+(load "../nat/Lib.kiss")
+
+
+(defun :Void main []
+    (assert (BoolExpInterp.eval "true" []))
+    (assert !(BoolExpInterp.eval "false" []))
+    (assert !(BoolExpInterp.eval "flag" []))
+    (assert (BoolExpInterp.eval "flag" ["flag"]))
+    (assert !(BoolExpInterp.eval "(and flag false)" ["flag"]))
+    (assert (BoolExpInterp.eval "(or flag otherFlag)" ["otherFlag"]))
+    //trace(error);
+    (let [archive
+                (new Archive "src/test/example-archive")
+            song1
+                (dictGet archive.entries "song1")
+            song2
+                (dictGet archive.entries "song2")]
+
+        (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)"))
+        ))

src/test/example-archive/components/author1.json

@@ -0,0 +1 @@
+"Rafael Krux"

src/test/example-archive/components/author2.json

@@ -0,0 +1 @@
+"Kevin MacLeod"

src/test/example-archive/components/name1.json

@@ -0,0 +1 @@
+"Adventure"

src/test/example-archive/components/name2.json

@@ -0,0 +1 @@
+"Ancient Rite"

src/test/example-archive/components/tags1.json

@@ -0,0 +1,4 @@
+[
+    ["song", 1],
+    ["western", 1]
+]

src/test/example-archive/components/tags2.json

@@ -0,0 +1,4 @@
+[
+    ["song", 1],
+    ["religious", 1]
+]

src/test/example-archive/entries/song1.json

@@ -0,0 +1,11 @@
+{
+    "id": "song1",
+    "components": [
+        ["Name", "name1"],
+        ["Author", "author1"],
+        ["Tags", "tags1"]
+    ],
+    "files": [
+        "Adventure.mp3"
+    ]
+}

src/test/example-archive/entries/song2.json

@@ -0,0 +1,11 @@
+{
+    "id": "song2",
+    "components": [
+        ["Name", "name2"],
+        ["Author", "author2"],
+        ["Tags", "tags2"]
+    ],
+    "files": [
+        "Ancient Rite.mp3"
+    ]
+}

test.hxml

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

test.sh

@@ -0,0 +1,4 @@
+#! /bin/bash
+
+haxelib dev nat-archive-tool .
+haxe test.hxml

tools/nap-music/build.hxml

@@ -0,0 +1,5 @@
+-lib kiss
+-lib nat-archive-tool
+-cp src
+--main Main
+--interp

tools/nap-music/src/Main.hx

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

tools/nap-music/src/Main.kiss

@@ -0,0 +1,2 @@
+(defun :Void main []
+    (print "Hello world!"))