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

@@ -0,0 +1,76 @@
+!import "base.tri" !Local
+!import "list.tri" !Local
+!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)
+  bytes)
+
+readBytesTaken = n bytes : bytesTake n bytes
+readBytesRest = n bytes : bytesDrop n bytes
+readBytesEnough? = n bytes : equal? (bytesLength (readBytesTaken n bytes)) n
+
+readBytes = (n bytes : 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

@@ -47,6 +47,7 @@ tests = testGroup "Tricu Tests"
   , byteMarshallingTests
   , wireTests
   , byteListUtilities
+  , binaryReaderTests
   ]
 
 lexer :: TestTree
@@ -1028,6 +1029,7 @@ wireTests = testGroup "Wire Tests"
 -- --------------------------------------------------------------------------
 
 -- | Helpers for byte-list test expectations.
+
 trueT  :: T
 trueT  = Stem Leaf
 
@@ -1225,3 +1227,331 @@ byteListUtilities = testGroup "Byte List Utility Tests"
       let env = evalTricu library (parseTricu input)
       result env @?= falseT
   ]
+
+-- --------------------------------------------------------------------------
+-- Binary reader tests (binary.tri)
+-- --------------------------------------------------------------------------
+okT :: T -> T -> T
+okT value rest = pairT trueT (pairT value rest)
+
+errT :: T -> T -> T
+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
+      let input = "readU8 []"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= errT eofT (bytesT [])
+
+  , testCase "readU8: single byte returns ok" $ do
+      let input = "readU8 [(7)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (byteT 7) (bytesT [])
+
+  , testCase "readU8: multi-byte returns first byte and rest" $ do
+      let input = "readU8 [(7) (8)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (byteT 7) (bytesT [8])
+
+  , testCase "readBytes 0: returns ok with empty bytes and original input" $ do
+      let input = "readBytes 0 [(1) (2)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT []) (bytesT [1,2])
+
+  , testCase "readBytes 2: exact read returns ok with taken and rest" $ do
+      let input = "readBytes 2 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2]) (bytesT [3])
+
+  , testCase "readBytes 3: exact read with no remainder" $ do
+      let input = "readBytes 3 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/binary.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= okT (bytesT [1,2,3]) (bytesT [])
+
+  , testCase "readBytes 5: overlong read returns err preserving input" $ do
+      let input = "readBytes 5 [(1) (2)]"
+      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])
+  ]