commit ce072b6e07d4eeca858182adc994b9a8d6e2480f
parent 4231f15c03b4ce372b6761ccda82dd1aef568de4
Author: James Eversole <james@eversole.co>
Date: Wed, 6 May 2026 20:10:33 -0500
Beginning Arborix work in tricu
Diffstat:
4 files changed, 345 insertions(+), 4 deletions(-)
diff --git a/lib/arborix.tri b/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)))))
diff --git a/lib/binary.tri b/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 :
- matchBool
+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)
diff --git a/src/Wire.hs b/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
-- ---------------------------------------------------------------------------
diff --git a/test/Spec.hs b/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])
]
