From 44ab13c889af6fd9bcdd11a5b502671d261bdce2 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Wed, 6 May 2026 20:10:33 -0500 Subject: [PATCH] Beginning Arborix work in tricu --- lib/arborix.tri | 19 ++++ lib/binary.tri | 57 +++++++++- src/Wire.hs | 2 - test/Spec.hs | 271 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 345 insertions(+), 4 deletions(-) create mode 100644 lib/arborix.tri diff --git a/lib/arborix.tri b/lib/arborix.tri new file mode 100644 index 0000000..cc9fbe0 --- /dev/null +++ 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 index 1dfd27f..a5eea6b 100644 --- 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 index e9bdfcc..82ba2bb 100644 --- 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 index 1db6c9a..861918e 100644 --- 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]) ]