James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Beginning Arborix work in tricu

Browse Source
This commit is contained in:
James Eversole
2026-05-06 20:10:33 -05:00
parent dee85efabf
commit 44ab13c889
4 changed files with 345 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
lib/arborix.tri Normal file
View File

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

57
lib/binary.tri
View File

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

2
src/Wire.hs
View File

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

271
test/Spec.hs
View File

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