Beginning Arborix work in tricu

lib/arborix.tri

@@ -0,0 +1,19 @@
+!import "base.tri" !Local
+!import "list.tri" !Local
+!import "bytes.tri" !Local
+!import "binary.tri" !Local
+
+arborixMagic = [(65) (82) (66) (79) (82) (73) (88) (0)]
+
+readArborixMagic = (bs : expectBytes arborixMagic bs)
+
+readArborixHeader = (bs :
+  bindResult (readArborixMagic bs)
+    (_ r0 :
+      bindResult (readU16BEBytes r0)
+        (major r1 :
+          bindResult (readU16BEBytes r1)
+            (minor r2 :
+              bindResult (readU32BEBytes r2)
+                (sections r3 :
+                  ok (pair major (pair minor sections)) r3)))))

lib/binary.tri

@@ -3,10 +3,24 @@
 !import "bytes.tri" !Local
 
 errUnexpectedEof = 1
+errUnexpectedBytes = 2
+errUnexpectedByte = 3
 
 ok = value rest : pair true (pair value rest)
 err = code rest : pair false (pair code rest)
 
+matchResult = (errCase okCase result :
+  matchPair
+    (tag payload :
+      matchPair
+        (value rest :
+          matchBool
+            (okCase value rest)
+            (errCase value rest)
+            tag)
+        payload)
+    result)
+
 readU8 = (bytes : matchList
   (err errUnexpectedEof t)
   (h r : ok h r)
@@ -16,8 +30,47 @@ readBytesTaken = n bytes : bytesTake n bytes
 readBytesRest = n bytes : bytesDrop n bytes
 readBytesEnough? = n bytes : equal? (bytesLength (readBytesTaken n bytes)) n
 
-readBytes = (n bytes :
+readBytes = (n bytes : matchBool
-  matchBool
     (ok (readBytesTaken n bytes) (readBytesRest n bytes))
     (err errUnexpectedEof bytes)
     (readBytesEnough? n bytes))
+
+unit = t
+
+expectBytes = (expected bs :
+  matchResult
+    (code rest : err code bs)
+    (taken rest :
+      matchBool
+        (ok unit rest)
+        (err errUnexpectedBytes bs)
+        (bytesEq taken expected))
+    (readBytes (bytesLength expected) bs))
+
+expectU8 = (expected bs :
+  matchResult
+    (code rest : err code bs)
+    (actual rest :
+      matchBool
+        (ok unit rest)
+        (err errUnexpectedByte bs)
+        (byteEq actual expected))
+    (readU8 bs))
+
+read2 = (bs : readBytes 2 bs)
+read4 = (bs : readBytes 4 bs)
+
+mapResult = (f result :
+  matchResult
+    (code rest : err code rest)
+    (value rest : ok (f value) rest)
+    result)
+
+bindResult = (result f :
+  matchResult
+    (code rest : err code rest)
+    (value rest : f value rest)
+    result)
+
+readU16BEBytes = (bs : read2 bs)
+readU32BEBytes = (bs : read4 bs)

src/Wire.hs

@@ -521,8 +521,6 @@ decodeNodeEntries count bs = go count bs Map.empty
                 Left $ "duplicate node entry: " ++ unpack h
               go (n - 1) after (Map.insert h payload acc)
 
-
-
 -- ---------------------------------------------------------------------------
 -- Bundle verification
 -- ---------------------------------------------------------------------------

test/Spec.hs

@@ -1240,6 +1240,15 @@ errT code rest = pairT falseT (pairT code rest)
 eofT :: T
 eofT = byteT 1
 
+unitT :: T
+unitT = Leaf
+
+unexpectedBytesT :: T
+unexpectedBytesT = byteT 2
+
+unexpectedByteT :: T
+unexpectedByteT = byteT 3
+
 binaryReaderTests :: TestTree
 binaryReaderTests = testGroup "Binary Reader Tests"
   [ testCase "readU8: empty input returns err" $ do
@@ -1283,4 +1292,266 @@ binaryReaderTests = testGroup "Binary Reader Tests"
       library <- evaluateFile "./lib/binary.tri"
       let env = evalTricu library (parseTricu input)
       result env @?= errT eofT (bytesT [1,2])
+
+  -- ------------------------------------------------------------------------
+  -- Binary Result Matcher Tests
+  -- ------------------------------------------------------------------------
+
+  , testCase "matchResult: ok branch returns value" $ do
+      let input = "matchResult (code rest : 0) (value rest : value) (ok 7 [])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= byteT 7
+
+  , testCase "matchResult: err branch returns code" $ do
+      let input = "matchResult (code rest : code) (value rest : 0) (err 1 [])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= byteT 1
+
+  , testCase "matchResult: ok branch receives rest" $ do
+      let input = "matchResult (code rest : []) (value rest : rest) (ok 7 [(8)])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [8]
+
+  , testCase "matchResult: err branch receives rest" $ do
+      let input = "matchResult (code rest : rest) (value rest : []) (err 1 [(7) (8)])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [7,8]
+
+  , testCase "matchResult: transforms readU8 ok result" $ do
+      let input = "matchResult (code rest : code) (value rest : value) (readU8 [(7) (8)])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= byteT 7
+
+  , testCase "matchResult: transforms readU8 err result" $ do
+      let input = "matchResult (code rest : code) (value rest : value) (readU8 [])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= byteT 1
+
+  -- ------------------------------------------------------------------------
+  -- Binary expectBytes Tests
+  -- ------------------------------------------------------------------------
+
+  , testCase "expectBytes: empty expected matches and preserves input" $ do
+      let input = "expectBytes [] [(1) (2)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT unitT (bytesT [1,2])
+
+  , testCase "expectBytes: single byte consumed, rest preserved" $ do
+      let input = "expectBytes [(1)] [(1) (2)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT unitT (bytesT [2])
+
+  , testCase "expectBytes: exact match with trailing data" $ do
+      let input = "expectBytes [(1) (2)] [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT unitT (bytesT [3])
+
+  , testCase "expectBytes: mismatch returns err with original input" $ do
+      let input = "expectBytes [(1) (2)] [(1) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT unexpectedBytesT (bytesT [1,3])
+
+  , testCase "expectBytes: overlong expected returns errEof with original input" $ do
+      let input = "expectBytes [(1) (2) (3)] [(1) (2)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [1,2])
+
+  -- ------------------------------------------------------------------------
+  -- Binary expectU8 Tests
+  -- ------------------------------------------------------------------------
+
+  , testCase "expectU8: matches and preserves rest" $ do
+      let input = "expectU8 7 [(7) (8)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT unitT (bytesT [8])
+
+  , testCase "expectU8: mismatch returns err with original input" $ do
+      let input = "expectU8 7 [(8)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT unexpectedByteT (bytesT [8])
+
+  , testCase "expectU8: empty input returns errEof with original input" $ do
+      let input = "expectU8 7 []"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [])
+
+  -- ------------------------------------------------------------------------
+  -- Binary fixed-size readers (read2 / read4)
+  -- ------------------------------------------------------------------------
+
+  , testCase "read2: reads two bytes and preserves rest" $ do
+      let input = "read2 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2]) (bytesT [3])
+
+  , testCase "read2: exact two-byte read" $ do
+      let input = "read2 [(1) (2)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2]) (bytesT [])
+
+  , testCase "read2: one byte returns EOF preserving input" $ do
+      let input = "read2 [(1)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [1])
+
+  , testCase "read2: empty input returns EOF" $ do
+      let input = "read2 []"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [])
+
+  , testCase "read4: reads four bytes and preserves rest" $ do
+      let input = "read4 [(1) (2) (3) (4) (5)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2,3,4]) (bytesT [5])
+
+  , testCase "read4: exact four-byte read" $ do
+      let input = "read4 [(1) (2) (3) (4)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2,3,4]) (bytesT [])
+
+  , testCase "read4: short input returns EOF preserving input" $ do
+      let input = "read4 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [1,2,3])
+
+  , testCase "read4: empty input returns EOF" $ do
+      let input = "read4 []"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [])
+
+  -- ------------------------------------------------------------------------
+  -- Binary Result sequencing combinators (mapResult / bindResult)
+  -- ------------------------------------------------------------------------
+
+  , testCase "mapResult: maps ok value and preserves rest" $ do
+      let input = "mapResult (x : bytesLength x) (ok [(1) (2)] [(3)])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (ofNumber 2) (bytesT [3])
+
+  , testCase "mapResult: preserves err unchanged" $ do
+      let input = "mapResult (x : bytesLength x) (err 1 [(7)])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [7])
+
+  , testCase "bindResult: ok invokes continuation" $ do
+      let input = "bindResult (ok 7 [(8)]) (value rest : ok rest [])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [8]) (bytesT [])
+
+  , testCase "bindResult: err skips continuation" $ do
+      let input = "bindResult (err 1 [(8)]) (value rest : ok value [])"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [8])
+
+  -- ------------------------------------------------------------------------
+  -- Binary fixed-size byte readers with BE byte-swap naming
+  -- ------------------------------------------------------------------------
+
+  , testCase "readU16BEBytes: reads two raw bytes" $ do
+      let input = "readU16BEBytes [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2]) (bytesT [3])
+
+  , testCase "readU16BEBytes: short input EOF" $ do
+      let input = "readU16BEBytes [(1)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [1])
+
+  , testCase "readU32BEBytes: reads four raw bytes" $ do
+      let input = "readU32BEBytes [(1) (2) (3) (4) (5)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2,3,4]) (bytesT [5])
+
+  , testCase "readU32BEBytes: short input EOF" $ do
+      let input = "readU32BEBytes [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [1,2,3])
+
+  -- ------------------------------------------------------------------------
+  -- Arborix magic recognition
+  -- ------------------------------------------------------------------------
+
+  , testCase "readArborixMagic: accepts magic and preserves rest" $ do
+      let input = "readArborixMagic [(65) (82) (66) (79) (82) (73) (88) (0) (1) (2)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT unitT (bytesT [1,2])
+
+  , testCase "readArborixMagic: rejects wrong magic preserving input" $ do
+      let input = "readArborixMagic [(65) (82) (66) (79) (82) (73) (88) (1) (9)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT unexpectedBytesT (bytesT [65,82,66,79,82,73,88,1,9])
+
+  , testCase "readArborixMagic: short input returns EOF preserving input" $ do
+      let input = "readArborixMagic [(65) (82) (66) (79)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [65,82,66,79])
+
+  -- ------------------------------------------------------------------------
+  -- Arborix header parsing
+  -- ------------------------------------------------------------------------
+
+  , testCase "readArborixHeader: parses version and section count" $ do
+      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT
+        (pairT (bytesT [0,1])
+          (pairT (bytesT [0,0])
+            (bytesT [0,0,0,0])))
+        (bytesT [])
+
+  , testCase "readArborixHeader: preserves trailing bytes" $ do
+      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0) (9) (8)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT
+        (pairT (bytesT [0,1])
+          (pairT (bytesT [0,0])
+            (bytesT [0,0,0,0])))
+        (bytesT [9,8])
+
+  , testCase "readArborixHeader: rejects wrong magic preserving input" $ do
+      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (1) (0) (1)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT unexpectedBytesT (bytesT [65,82,66,79,82,73,88,1,0,1])
+
+  , testCase "readArborixHeader: short input returns EOF preserving input" $ do
+      let input = "readArborixHeader [(65) (82)]"
+      library <- evaluateFile "./lib/arborix.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [65,82])
   ]