commit 4231f15c03b4ce372b6761ccda82dd1aef568de4
parent 52cd7f3aa53af3ad737c791bf785986f5d3b30ff
Author: James Eversole <james@eversole.co>
Date: Wed, 6 May 2026 19:23:30 -0500
Tree-native binary processing
Diffstat:
2 files changed, 82 insertions(+), 0 deletions(-)
diff --git a/lib/binary.tri b/lib/binary.tri
@@ -0,0 +1,23 @@
+!import "base.tri" !Local
+!import "list.tri" !Local
+!import "bytes.tri" !Local
+
+errUnexpectedEof = 1
+
+ok = value rest : pair true (pair value rest)
+err = code rest : pair false (pair code rest)
+
+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))
diff --git a/test/Spec.hs b/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,60 @@ 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
+
+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])
+ ]