Tree-native binary processing

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))

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])
+  ]