tricu

Spec.hs (162216B)

---

 module Main where
 
 import Eval
 import FileEval
 import Lexer
 import Parser
 import REPL
 import Research
 import Wire
 import ContentStore
 import ContentStore.Bundle
 import Module.Manifest
 import Module.Resolver
 import IODriver (IOPermissions(..), checkIOSentinel, runIO, runIOWithEnv, runIOWith, unsafePerms, defaultPerms)
 
 import Control.Exception      (bracket, evaluate, try, SomeException)
 import System.IO.Unsafe       (unsafePerformIO)
 import qualified Network.Socket as NS
 import Control.Monad         (forM, forM_)
 import Control.Monad.IO.Class (liftIO)
 import System.IO.Temp         (withSystemTempDirectory)
 import System.Directory      (createDirectory, doesFileExist, doesDirectoryExist, listDirectory, getCurrentDirectory)
 import System.FilePath       ((</>))
 import Data.Bits              (xor)
 import Data.Char              (digitToInt)
 import Data.List              (find, isInfixOf)
 import Data.Text              (Text, unpack, pack)
 import Data.Word              (Word8)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Text.Megaparsec        (runParser)
 
 import Data.ByteString (ByteString)
 import qualified Data.Foldable as Foldable
 import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import qualified Data.Vector as V
 
 main :: IO ()
 main = defaultMain tests
 
 tricuTestString :: String -> String
 tricuTestString s = show $ result (evalTricu Map.empty $ parseTricu s)
 
 testStore :: StorePath
 testStore = StorePath "/tmp/tricu-test-store"
 {-# NOINLINE testStore #-}
 
 allTestLibsEnv :: Env
 allTestLibsEnv = unsafePerformIO $ do
   base    <- evaluateFile "./lib/base.tri"
   bytes   <- evaluateFile "./lib/bytes.tri"
   bin     <- evaluateFile "./lib/binary.tri"
   http    <- evaluateFile "./lib/http.tri"
   arbor   <- evaluateFile "./lib/arboricx/arboricx.tri"
   io      <- evaluateFile "./lib/io.tri"
   sock    <- evaluateFile "./lib/socket.tri"
   intensional   <- evaluateFile "./lib/intensionalContracts.tri"
   pure (injectKernel (Map.unions [base, bytes, bin, http, arbor, io, sock, intensional]))
 {-# NOINLINE allTestLibsEnv #-}
 
 tests :: TestTree
 tests = testGroup "Tricu Tests"
   [ lexer
   , parser
   , simpleEvaluation
   , lambdas
   , arithmetic
   , providedLibraries
   , contractsTests
   , maybeTests
   , fileEval
   , demos
   , decoding
   , elimLambdaSingle
   , stressElimLambda
   , byteMarshallingTests
   , wireTests
   , tricuReaderTests
   , byteListUtilities
   , binaryParserTests
   , httpParsingTests
   , contentStoreTests
   , ioDriverTests
   ]
 
 lexer :: TestTree
 lexer = testGroup "Lexer Tests"
   [ testCase "Lex simple identifiers" $ do
       let input = "x a b = a"
           expect = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex Tree Calculus terms" $ do
       let input = "t t t"
           expect = Right [LKeywordT, LKeywordT, LKeywordT]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex escaped characters in strings" $ do
       let input = "\"hello\\nworld\""
           expect = Right [LStringLiteral "hello\nworld"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex multiple escaped characters in strings" $ do
       let input = "\"tab:\\t newline:\\n quote:\\\" backslash:\\\\\""
           expect = Right [LStringLiteral "tab:\t newline:\n quote:\" backslash:\\"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex escaped characters in string literals" $ do
       let input = "x = \"line1\\nline2\\tindented\""
           expect = Right [LIdentifier "x", LAssign, LStringLiteral "line1\nline2\tindented"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex empty string with escape sequence" $ do
       let input = "\"\\\"\""
           expect = Right [LStringLiteral "\""]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex mixed literals" $ do
       let input = "t \"string\" 42"
           expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex invalid token" $ do
       let input = "&invalid"
       case runParser tricuLexer "" input of
         Left _ -> return ()
         Right _ -> assertFailure "Expected lexer to fail on invalid token"
 
   , testCase "Drop trailing whitespace in definitions" $ do
       let input = "x = 5 "
           expect = [LIdentifier "x",LAssign,LIntegerLiteral 5]
       case (runParser tricuLexer "" input) of
         Left _ -> assertFailure "Failed to lex input"
         Right i -> i @?= expect
 
   , testCase "Error when using invalid characters in identifiers" $ do
         case (runParser tricuLexer "" "!result = 5") of
           Left _ -> return ()
           Right _ -> assertFailure "Expected failure when trying to assign the value of !result"
 
   , testCase "Lex <| as arrow-left token" $ do
       let input = "f <| g"
           expect = Right [LIdentifier "f", LArrowLeft, LIdentifier "g"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex <| without surrounding spaces" $ do
       let input = "a<|b"
           expect = Right [LIdentifier "a", LArrowLeft, LIdentifier "b"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex |> as arrow-right token" $ do
       let input = "f |> g"
           expect = Right [LIdentifier "f", LArrowRight, LIdentifier "g"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex |> without surrounding spaces" $ do
       let input = "a|>b"
           expect = Right [LIdentifier "a", LArrowRight, LIdentifier "b"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex <- as bind arrow token" $ do
       let input = "x <- action"
           expect = Right [LIdentifier "x", LBindArrow, LIdentifier "action"]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex $ remains legal identifier char" $ do
       let input = "foo$bar = 1"
           expect = Right [LIdentifier "foo$bar", LAssign, LIntegerLiteral 1]
       runParser tricuLexer "" input @?= expect
 
   , testCase "Lex @ and =@ as annotation tokens" $ do
       let input = "f x@Bool =@String x"
           expect = Right
             [ LIdentifier "f"
             , LIdentifier "x"
             , LAt
             , LIdentifier "Bool"
             , LAssignAt
             , LIdentifier "String"
             , LIdentifier "x"
             ]
       runParser tricuLexer "" input @?= expect
   ]
 
 parser :: TestTree
 parser = testGroup "Parser Tests"
   [ testCase "Error when assigning a value to T" $ do
       let tokens = lexTricu "t = x" 
       case parseSingleExpr tokens of
         Left  _ -> return ()
         Right _ -> assertFailure "Expected failure when trying to assign the value of T"
 
   , testCase "Parse function definitions" $ do
       let input = "x = (a b c : a)"
           expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a" Nothing))))
       parseSingle input @?= expect
 
   , testCase "Parse nested Tree Calculus terms" $ do
       let input = "t (t t) t"
           expect = SApp (SApp TLeaf (SApp TLeaf TLeaf)) TLeaf
       parseSingle input @?= expect
 
   , testCase "Parse sequential Tree Calculus terms" $ do
       let input = "t t t"
           expect = SApp (SApp TLeaf TLeaf) TLeaf
       parseSingle input @?= expect
 
   , testCase "Parse mixed list literals" $ do
       let input = "[t (\"hello\") t]"
           expect = SList [TLeaf, SStr "hello", TLeaf]
       parseSingle input @?= expect
 
   , testCase "Parse function with applications" $ do
       let input  = "f = (x : t x)"
           expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Parse nested lists" $ do
       let input  = "[t [(t t)]]"
           expect = SList [TLeaf,SList [SApp TLeaf TLeaf]]
       parseSingle input @?= expect
 
   , testCase "Parse complex parentheses" $ do
       let input  = "t (t t (t t))"
           expect = SApp TLeaf (SApp (SApp TLeaf TLeaf) (SApp TLeaf TLeaf))
       parseSingle input @?= expect
 
   , testCase "Parse empty list" $ do
       let input  = "[]"
           expect = SList []
       parseSingle input @?= expect
 
   , testCase "Parse multiple nested lists" $ do
       let input  = "[[t t] [t (t t)]]"
           expect = SList [SList [TLeaf,TLeaf],SList [TLeaf,SApp TLeaf TLeaf]]
       parseSingle input @?= expect
 
   , testCase "Parse whitespace variance" $ do
       let input1 = "[t t]"
       let input2 = "[ t t ]"
           expect = SList [TLeaf, TLeaf]
       parseSingle input1 @?= expect
       parseSingle input2 @?= expect
 
   , testCase "Parse string in list" $ do
       let input  = "[(\"hello\")]"
           expect = SList [SStr "hello"]
       parseSingle input @?= expect
 
   , testCase "Parse parentheses inside list" $ do
       let input  = "[t (t t)]"
           expect = SList [TLeaf,SApp TLeaf TLeaf]
       parseSingle input @?= expect
 
   , testCase "Parse nested parentheses in function body" $ do
       let input  = "f = (x : t (t (t t)))"
           expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
       parseSingle input @?= expect
 
   , testCase "Parse lambda abstractions" $ do
       let input  = "(a : a)"
           expect = (SLambda ["a"] (SVar "a" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse multiple arguments to lambda abstractions" $ do
       let input  = "x = (a b : a)"
           expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Parse top-level definition arguments" $ do
       let input  = "const a b = a"
           expect = SDef "const" ["a", "b"] (SVar "a" Nothing)
       parseSingle input @?= expect
 
   , testCase "Evaluate top-level definition arguments" $ do
       tricuTestString "const a b = a\nconst 1 2" @?= "Fork (Stem Leaf) Leaf"
 
   , testCase "Parse annotated definition binders" $ do
       let input = "foo x@Bool xs@(List Bool) =@String x"
           expect = SDefAnn
             "foo"
             [DefBinder "x" (Just (VEName "Bool")), DefBinder "xs" (Just (VEApp (VEName "List") (VEName "Bool")))]
             (Just (VEName "String"))
             (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse phantom tail annotations" $ do
       let input = "foo x@Bool @(List Bool) =@String x"
           expect = SDefAnn
             "foo"
             [DefBinder "x" (Just (VEName "Bool")), DefPhantom (VEApp (VEName "List") (VEName "Bool"))]
             (Just (VEName "String"))
             (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse pure phantom function annotation" $ do
       let input = "foo @Bool @(Fn [Bool] String) =@Unit (x : x)"
           expect = SDefAnn
             "foo"
             [DefPhantom (VEName "Bool"), DefPhantom (VEApp (VEApp (VEName "Fn") (VEList [VEName "Bool"])) (VEName "String"))]
             (Just (VEName "Unit"))
             (SLambda ["x"] (SVar "x" Nothing))
       parseSingle input @?= expect
 
   , testCase "Evaluate annotated definition applies runtime contract boundary" $ do
       let input = unlines
             [ "bool? = guardC \"not a boolean\" (b : or? (equal? b true) (equal? b false))"
             , "id x@bool? =@bool? x"
             , "main = id true"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "Reject named binders after phantom annotations" $ do
       let tokens = lexTricu "foo @Bool x@Bool =@Bool x"
       case parseSingleExpr tokens of
         Left _ -> return ()
         Right ast -> assertFailure $ "Expected parse failure, got " ++ show ast
 
   , testCase "Unparenthesized annotation names remain ordinary aliases" $ do
       let input = "foo x@List Bool =@Bool x"
           expect = SDefAnn "foo"
             [DefBinder "x" (Just (VEName "List")), DefBinder "Bool" Nothing]
             (Just (VEName "Bool"))
             (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse let expression" $ do
       let input  = "let x = t t in x"
           expect = SLet "x" (SApp TLeaf TLeaf) (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Evaluate let expression" $ do
       tricuTestString "let x = 1 in x" @?= "Fork (Stem Leaf) Leaf"
 
   , testCase "Parse let function binding" $ do
       let input  = "let f x = x in f t"
           expect = SLet "f" (SLambda ["x"] (SVar "x" Nothing))
                         (SApp (SVar "f" Nothing) TLeaf)
       parseSingle input @?= expect
 
   , testCase "Parse where expression" $ do
       let input  = "x where x = t t"
           expect = SLet "x" (SApp TLeaf TLeaf) (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Evaluate where expression" $ do
       tricuTestString "x where x = 1" @?= "Fork (Stem Leaf) Leaf"
 
   , testCase "Parse where binding with arguments (SLet)" $ do
       let input  = "f 3 where f x = x"
           expect = SLet "f" (SLambda ["x"] (SVar "x" Nothing))
                         (SApp (SVar "f" Nothing) (SInt 3))
       parseSingle input @?= expect
 
   , testCase "Evaluate where binding with arguments matches applied lambda" $ do
       tricuTestString "f (t t) where f x = t x x"
         @?= tricuTestString "(f : f (t t)) (x : t x x)"
 
   , testCase "Evaluate nested let bindings" $ do
       tricuTestString "let a = t t in let b = t in t a b"
         @?= tricuTestString "t (t t) t"
 
   , testCase "Inner let binding shadows outer binding" $ do
       tricuTestString "let x = t in let x = t t in x"
         @?= tricuTestString "t t"
 
   , testCase "Parse indented multiline definition body" $ do
       let input  = "x =\n  t\n    t"
           expect = SDef "x" [] (SApp TLeaf TLeaf)
       parseSingle input @?= expect
 
   , testCase "Evaluate indented multiline let" $ do
       tricuTestString "let\n  x =\n    1\nin\n  x" @?= "Fork (Stem Leaf) Leaf"
 
   , testCase "Evaluate indented multiline where" $ do
       tricuTestString "x\n  where x =\n    1" @?= "Fork (Stem Leaf) Leaf"
 
   , testCase "Parse explicit custom-bind do" $ do
       let input = "do bind\n  x <- pure t\n  pure x"
           expect = SApp
             (SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
             (SLambda ["x"] (SApp (SVar "pure" Nothing) (SVar "x" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Parse do statement without binder" $ do
       let input = "do bind\n  pure t\n  pure t"
           expect = SApp
             (SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
             (SLambda ["_"] (SApp (SVar "pure" Nothing) TLeaf))
       parseSingle input @?= expect
 
   , testCase "Reject bare do without explicit bind operator" $ do
       parsed <- try (evaluate (parseSingle "do\n  x <- pure t\n  pure x")) :: IO (Either SomeException TricuAST)
       case parsed of
         Left _  -> pure ()
         Right _ -> assertFailure "Expected bare do to fail"
 
   , testCase "Grouping T terms with parentheses in function application" $ do
       let input  = "x = (a : a)\nx (t)"
           expect = [SDef "x" [] (SLambda ["a"] (SVar "a" Nothing)),SApp (SVar "x" Nothing) TLeaf]
       parseTricu input @?= expect
 
   , testCase "Comments 1" $ do
       let input = "(t) (t) -- (t)"
           expect = [SApp TLeaf TLeaf]
       parseTricu input @?= expect
 
   , testCase "Comments 2" $ do
       let input = "(t) -- (t) -- (t)"
           expect = [TLeaf]
       parseTricu input @?= expect
 
   , testCase "Parse <| as low-precedence application" $ do
       let input = "f x <| g y"
           expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
                         (SApp (SVar "g" Nothing) (SVar "y" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse chained <| as left-associative" $ do
       let input = "f <| g <| h"
           expect = SApp (SApp (SVar "f" Nothing) (SVar "g" Nothing))
                         (SVar "h" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse <| after newline inside parens" $ do
       let input = "(f x <|\n  g y)"
           expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
                         (SApp (SVar "g" Nothing) (SVar "y" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse <| in lambda body" $ do
       let input = "(x : f x <| g)"
           expect = SLambda ["x"] (SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
                                       (SVar "g" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse |> as low-precedence application" $ do
       let input = "f x |> g y"
           expect = SApp (SApp (SVar "g" Nothing) (SVar "y" Nothing))
                         (SApp (SVar "f" Nothing) (SVar "x" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse chained |> as left-associative" $ do
       let input = "f |> g |> h"
           expect = SApp (SVar "h" Nothing)
                         (SApp (SVar "g" Nothing) (SVar "f" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse |> after newline inside parens" $ do
       let input = "(f x |>\n  g y)"
           expect = SApp (SApp (SVar "g" Nothing) (SVar "y" Nothing))
                         (SApp (SVar "f" Nothing) (SVar "x" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse |> in lambda body" $ do
       let input = "(x : f x |> g)"
           expect = SLambda ["x"] (SApp (SVar "g" Nothing)
                                       (SApp (SVar "f" Nothing) (SVar "x" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Parse mixed <| and |>" $ do
       let input = "f |> g <| h"
           expect = SApp (SApp (SVar "g" Nothing) (SVar "f" Nothing))
                         (SVar "h" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse forward pipe chain" $ do
       let input = "x |> f |> g"
           expect = SApp (SVar "g" Nothing)
                     (SApp (SVar "f" Nothing) (SVar "x" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse backward pipe" $ do
       let input = "f <| x"
           expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse backward pipe chain left associative" $ do
       let input = "f <| x <| y"
           expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
                     (SVar "y" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse newline after forward pipe" $ do
       let input = "x |>\nf"
           expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
       parseSingle input @?= expect
 
   , testCase "Parse newline after backward pipe" $ do
       let input = "f <|\nx"
           expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
       parseSingle input @?= expect
   ]
 
 simpleEvaluation :: TestTree
 simpleEvaluation = testGroup "Evaluation Tests"
   [ testCase "Evaluate single Leaf" $ do
       let input = "t"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= Leaf
 
   , testCase "Evaluate single Stem" $ do
       let input = "t t"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= Stem Leaf
 
   , testCase "Evaluate single Fork" $ do
       let input = "t t t"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= Fork Leaf Leaf
 
   , testCase "Evaluate nested Fork and Stem" $ do
       let input = "t (t t) t"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= Fork (Stem Leaf) Leaf
 
   , testCase "Evaluate `not` function" $ do
       let input = "t (t (t t) (t t t)) t"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?=
         Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
 
   , testCase "Environment updates with definitions" $ do
       let input = "x = t\ny = x"
           env = evalTricu Map.empty (parseTricu input)
       Map.lookup "x" env @?= Just Leaf
       Map.lookup "y" env @?= Just Leaf
 
   , testCase "Variable substitution" $ do
       let input = "x = t t\ny = t x\ny"
           env = evalTricu Map.empty (parseTricu input)
       (result env) @?= Stem (Stem Leaf)
 
   , testCase "Multiline input evaluation" $ do
       let input = "x = t\ny = t t\nx"
           env = evalTricu Map.empty (parseTricu input)
       (result env) @?= Leaf
 
   , testCase "Evaluate string literal" $ do
       let input = "\"hello\""
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= ofString "hello"
 
   , testCase "Evaluate list literal" $ do
       let input = "[t (t t)]"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= ofList [Leaf, Stem Leaf]
 
   , testCase "Evaluate empty list" $ do
       let input = "[]"
       let ast = parseSingle input
       (result $ evalSingle Map.empty ast) @?= ofList []
 
   , testCase "Evaluate variable dependency chain" $ do
       let input = "x = t (t t)\n \
                   \ y = x\n \
                   \ z = y\n \
                   \ variablewithamuchlongername = z\n \
                   \ variablewithamuchlongername"
           env = evalTricu Map.empty (parseTricu input)
       (result env) @?= (Stem (Stem Leaf))
 
 
   , testCase "Immutable definitions" $ do
       let input = "x = t t\nx = t\nx"
           env = evalTricu Map.empty (parseTricu input)
       result <- try (evaluate (tricuTestString input)) :: IO (Either SomeException String)
       case result of
         Left  _ -> return ()
         Right _ -> assertFailure "Expected evaluation error"
 
 
   , testCase "Apply identity to Boolean Not" $ do
       let not = "(t (t (t t) (t t t)) t)"
       let input = "x = (a : a)\nx " ++ not
           env = evalTricu Map.empty (parseTricu input)
       result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
   ]
 
 lambdas :: TestTree
 lambdas = testGroup "Lambda Evaluation Tests"
   [ testCase "Lambda Identity Function" $ do
       let input = "id = (x : x)\nid t"
       tricuTestString input @?= "Leaf"
 
   , testCase "Lambda Constant Function (K combinator)" $ do
       let input = "k = (x y : x)\nk t (t t)"
       tricuTestString input @?= "Leaf"
 
   , testCase "Lambda Application with Variable" $ do
       let input = "id = (x : x)\nval = t t\nid val"
       tricuTestString input @?= "Stem Leaf"
 
   , testCase "Lambda Application with Multiple Arguments" $ do
       let input = "apply = (f x y : f x y)\nk = (a b : a)\napply k t (t t)"
       tricuTestString input @?= "Leaf"
 
    , testCase "Nested Lambda Application" $ do
       let input = "apply = (f x y : f x y)\nid = (x : x)\napply (f x : f x) id t"
       tricuTestString input @?= "Leaf"
 
   , testCase "Lambda with a complex body" $ do
       let input = "f = (x : t (t x))\nf t"
       tricuTestString input @?= "Stem (Stem Leaf)"
 
   , testCase "Lambda returning a function" $ do
       let input = "f = (x : (y : x))\ng = f t\ng (t t)"
       tricuTestString input @?= "Leaf"
 
   , testCase "Lambda with Shadowing" $ do
       let input = "f = (x : (x : x))\nf t (t t)"
       tricuTestString input @?= "Stem Leaf"
 
    , testCase "Lambda returning another lambda" $ do
       let input = "k = (x : (y : x))\nk_app = k t\nk_app (t t)"
       tricuTestString input @?= "Leaf"
 
    , testCase "Lambda with free variables" $ do
       let input = "y = t t\nf = (x : y)\nf t"
       tricuTestString input @?= "Stem Leaf"
 
    , testCase "SKI Composition" $ do
       let input = "s = (x y z : x z (y z))\nk = (x y : x)\ni = (x : x)\ncomp = s k i\ncomp t (t t)"
       tricuTestString input @?= "Stem (Stem Leaf)"
 
    , testCase "Lambda with multiple parameters and application" $ do
       let input = "f = (a b c : t a b c)\nf t (t t) (t t t)"
       tricuTestString input @?= "Stem Leaf"
 
    , testCase "Lambda with nested application in the body" $ do
       let input = "f = (x : t (t (t x)))\nf t"
       tricuTestString input @?= "Stem (Stem (Stem Leaf))"
 
     , testCase "Lambda returning a function and applying it" $ do
         let input = "f = (x : (y : t x y))\ng = f t\ng (t t)"
         tricuTestString input @?= "Fork Leaf (Stem Leaf)"
 
     , testCase "Lambda applying a variable" $ do
         let input = "id = (x : x)\na = t t\nid a"
         tricuTestString input @?= "Stem Leaf"
 
     , testCase "Nested lambda abstractions in the same expression" $ do
         let input = "f = (x : (y : x y))\ng = (z : z)\nf g t"
         tricuTestString input @?= "Leaf"
 
   , testCase "Lambda applied to string literal" $ do
         let input = "f = (x : x)\nf \"hello\""
         tricuTestString input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) Leaf))))"
 
 
    , testCase "Lambda applied to integer literal" $ do
         let input = "f = (x : x)\nf 42"
         tricuTestString input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
 
    , testCase "Lambda applied to list literal" $ do
         let input = "f = (x : x)\nf [t (t t)]"
         tricuTestString input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
 
   , testCase "Lambda containing list literal" $ do
       let input = "(a : [(a)]) 1"
       tricuTestString input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
   ]
 
 maybeTests :: TestTree
 maybeTests = testGroup "Maybe Tests"
   [ testCase "nothing is Leaf" $ do
       let input = "nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "just wraps value in Stem" $ do
       let input = "just (t t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem (Stem Leaf)
 
   , testCase "matchMaybe on nothing returns default" $ do
       let input = "matchMaybe \"empty\" (x : x) nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "empty"
 
   , testCase "matchMaybe on just extracts value" $ do
       let input = "matchMaybe \"empty\" (x : x) (just (t t))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem Leaf
 
   , testCase "maybe applies f inside just" $ do
       let input = "maybe 0 (x : succ x) (just 5)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 6
 
   , testCase "maybe returns default on nothing" $ do
       let input = "maybe 0 (x : succ x) nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "maybeMap transforms just value" $ do
       let input = "maybeMap (x : succ x) (just 3)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (ofNumber 4)
 
   , testCase "maybeMap returns nothing on nothing" $ do
       let input = "maybeMap (x : succ x) nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "maybeBind flattens just" $ do
       let input = "maybeBind (just 3) (x : just (succ x))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (ofNumber 4)
 
   , testCase "maybeBind returns nothing on nothing" $ do
       let input = "maybeBind nothing (x : just (succ x))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "maybeOr returns just value" $ do
       let input = "maybeOr 99 (just 5)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "maybeOr returns default on nothing" $ do
       let input = "maybeOr 99 nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 99
 
   , testCase "maybe? on just is true" $ do
       let input = "maybe? (just t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "maybe? on nothing is false" $ do
       let input = "maybe? nothing"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
   ]
 
 providedLibraries :: TestTree
 providedLibraries = testGroup "Library Tests"
   [ testCase "Triage test Leaf" $ do
       let input = "test t"
           env = decodeResult $ result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= "\"Leaf\""
 
   , testCase "Triage test (Stem Leaf)" $ do
       let input = "test (t t)"
           env = decodeResult $ result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= "\"Stem\""
 
   , testCase "Triage test (Fork Leaf Leaf)" $ do
       let input = "test (t t t)"
           env = decodeResult $ result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= "\"Fork\""
 
   , testCase "Boolean NOT: true" $ do
       let input = "not? true"
           env = result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= Leaf
 
   , testCase "Boolean NOT: false" $ do
       let input = "not? false"
           env = result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= Stem Leaf
 
 
   , testCase "Boolean AND TF" $ do
       let input = "and? (t t) (t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "Boolean AND FT" $ do
       let input = "and? (t) (t t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "Boolean AND FF" $ do
       let input = "and? (t) (t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "Boolean AND TT" $ do
       let input = "and? (t t) (t t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem Leaf
 
   , testCase "List head" $ do
       let input = "head [(t) (t t) (t t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Leaf
 
   , testCase "List tail" $ do
       let input = "head (tail (tail [(t) (t t) (t t t)]))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Fork Leaf Leaf
 
   , testCase "List map" $ do
       let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Fork Leaf Leaf
 
   , testCase "Empty list check" $ do
       let input = "emptyList? []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem Leaf
 
   , testCase "Non-empty list check" $ do
       let input = "not? (emptyList? [(1) (2) (3)])"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem Leaf
 
   , testCase "Concatenate strings" $ do
       let input = "append \"Hello, \" \"world!\""
           env = decodeResult $ result $ evalTricu allTestLibsEnv (parseTricu input)
       env @?= "\"Hello, world!\""
 
   , testCase "Verifying Equality" $ do
       let input = "equal? (t t t) (t t t)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= Stem Leaf
 
   , testCase "headMaybe on empty list" $ do
       let input = "headMaybe []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "headMaybe on non-empty list" $ do
       let input = "headMaybe [(t) (t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT Leaf
 
   , testCase "lastMaybe on empty list" $ do
       let input = "lastMaybe []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "lastMaybe on single element" $ do
       let input = "lastMaybe [(t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (Stem Leaf)
 
   , testCase "lastMaybe on multi-element list" $ do
       let input = "lastMaybe [(t) (t t) (t t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (Fork Leaf Leaf)
 
   , testCase "nthMaybe first element" $ do
       let input = "nthMaybe 0 [(t) (t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT Leaf
 
   , testCase "nthMaybe middle element" $ do
       let input = "nthMaybe 1 [(t) (t t) (t t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (Stem Leaf)
 
   , testCase "nthMaybe out of bounds" $ do
       let input = "nthMaybe 5 [(t) (t t)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "reverse empty list" $ do
       let input = "reverse []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "reverse non-empty list" $ do
       let input = "reverse [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 3, ofNumber 2, ofNumber 1]
 
   , testCase "take 0 any list = empty" $ do
       let input = "take 0 [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "take 2 [1,2,3] = [1,2]" $ do
       let input = "take 2 [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 1, ofNumber 2]
 
   , testCase "take overlong returns whole list" $ do
       let input = "take 5 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 1, ofNumber 2]
 
   , testCase "drop 0 any list = list" $ do
       let input = "drop 0 [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 1, ofNumber 2, ofNumber 3]
 
   , testCase "drop 2 [1,2,3] = [3]" $ do
       let input = "drop 2 [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 3]
 
   , testCase "drop overlong returns empty" $ do
       let input = "drop 5 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "splitAt 0 [1,2] = pair [] [1,2]" $ do
       let input = "splitAt 0 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (ofList []) (ofList [ofNumber 1, ofNumber 2])
 
   , testCase "splitAt 2 [1,2,3] = pair [1,2] [3]" $ do
       let input = "splitAt 2 [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList [ofNumber 3])
 
   , testCase "splitAt overlong = pair [1,2] []" $ do
       let input = "splitAt 5 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList [])
 
   , testCase "concatMap on empty list" $ do
       let input = "concatMap (x : [(x) (x)]) []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "concatMap doubles elements" $ do
       let input = "concatMap (x : [(x) (x)]) [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 1, ofNumber 1, ofNumber 2, ofNumber 2]
 
   , testCase "find on empty list" $ do
       let input = "find (x : equal? x 2) []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "find finds element" $ do
       let input = "find (x : equal? x 2) [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (ofNumber 2)
 
   , testCase "find missing element" $ do
       let input = "find (x : equal? x 9) [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "partition empty list" $ do
       let input = "partition (x : equal? x 2) []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (ofList []) (ofList [])
 
   , testCase "partition splits list" $ do
       let input = "partition (x : lt? 2 x) [(1) (2) (3) (4)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (ofList [ofNumber 3, ofNumber 4]) (ofList [ofNumber 1, ofNumber 2])
 
   , testCase "zipWith on empty lists" $ do
       let input = "zipWith add [] []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "zipWith adds pairwise" $ do
       let input = "zipWith add [(1) (2)] [(10) (20)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 11, ofNumber 22]
 
   , testCase "zipWith truncates to shorter list" $ do
       let input = "zipWith add [(1) (2)] [(10)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 11]
 
   , testCase "strLength" $ do
       let input = "strLength \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "strAppend" $ do
       let input = "strAppend \"hello\" \" world\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "hello world"
 
   , testCase "equal? equal strings" $ do
       let input = "equal? \"abc\" \"abc\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "equal? different strings" $ do
       let input = "equal? \"abc\" \"def\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "strEmpty? on empty" $ do
       let input = "strEmpty? \"\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "strEmpty? on non-empty" $ do
       let input = "strEmpty? \"a\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "startsWith? prefix matches" $ do
       let input = "startsWith? \"he\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "startsWith? prefix too long" $ do
       let input = "startsWith? \"hello\" \"he\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "startsWith? empty prefix" $ do
       let input = "startsWith? \"\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "endsWith? suffix matches" $ do
       let input = "endsWith? \"lo\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "endsWith? suffix too long" $ do
       let input = "endsWith? \"hello\" \"lo\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "endsWith? empty suffix" $ do
       let input = "endsWith? \"\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "contains? substring found" $ do
       let input = "contains? \"ell\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "contains? substring missing" $ do
       let input = "contains? \"xyz\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "contains? empty needle" $ do
       let input = "contains? \"\" \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "lines splits on newline" $ do
       let input = "lines \"a\\nb\\nc\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "a", ofString "b", ofString "c"]
 
   , testCase "lines single line" $ do
       let input = "lines \"hello\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "hello"]
 
   , testCase "lines empty string" $ do
       let input = "lines \"\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString ""]
 
   , testCase "lines trailing newline" $ do
       let input = "lines \"a\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "a", ofString ""]
 
   , testCase "unlines joins with newline" $ do
       let input = "unlines [(\"a\") (\"b\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "a\nb\n"
 
   , testCase "unlines empty list" $ do
       let input = "unlines []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString ""
 
   , testCase "words splits on space" $ do
       let input = "words \"hello world\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "hello", ofString "world"]
 
   , testCase "words empty string" $ do
       let input = "words \"\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "words multiple spaces" $ do
       let input = "words \"  hello  world  \""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "hello", ofString "world"]
 
   , testCase "unwords joins with space" $ do
       let input = "unwords [(\"hello\") (\"world\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "hello world"
 
   , testCase "unwords single word" $ do
       let input = "unwords [(\"hello\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "hello"
 
   , testCase "unwords empty list" $ do
       let input = "unwords []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString ""
 
   , testCase "intercalate joins fields" $ do
       let input = "intercalate \", \" [(\"a\") (\"b\") (\"c\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "a, b, c"
 
   , testCase "intercalate leaves a lone field alone" $ do
       let input = "intercalate \", \" [(\"a\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "a"
 
   , testCase "intercalate empty list" $ do
       let input = "intercalate \", \" []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString ""
 
   , testCase "joinSuffix terminates every field" $ do
       let input = "joinSuffix \"-\" [(\"a\") (\"b\")]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "a-b-"
 
   , testCase "splitOnByte splits on a byte" $ do
       let input = "splitOnByte 58 \"a:b:c\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "a", ofString "b", ofString "c"]
 
   , testCase "splitOnByte keeps empty fields" $ do
       let input = "splitOnByte 58 \"a::b\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "a", ofString "", ofString "b"]
 
   , testCase "splitOnByte trailing separator leaves an empty field" $ do
       let input = "splitOnByte 58 \"a:\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "a", ofString ""]
 
   , testCase "splitOnByte without a match" $ do
       let input = "splitOnByte 58 \"abc\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString "abc"]
 
   , testCase "splitOnByte empty input" $ do
       let input = "splitOnByte 58 \"\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofString ""]
 
   , testCase "intercalate round trips splitOnByte" $ do
       let input = "equal? (intercalate \":\" (splitOnByte 58 \"a:b:c\")) \"a:b:c\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "takeWhile keeps the matching prefix" $ do
       let input = "takeWhile (n : lt? n 3) [(1) (2) (3) (1)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 1, ofNumber 2]
 
   , testCase "takeWhile stops at the first mismatch" $ do
       let input = "takeWhile (n : lt? n 3) [(3) (1)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "dropWhile drops the matching prefix" $ do
       let input = "dropWhile (n : lt? n 3) [(1) (2) (3) (1)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList [ofNumber 3, ofNumber 1]
 
   , testCase "dropWhile on an all matching list" $ do
       let input = "dropWhile (n : lt? n 3) [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofList []
 
   , testCase "trim strips surrounding spaces and tabs" $ do
       let input = "trim \"  \\ttrimmed  \\t\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "trimmed"
 
   , testCase "trim leaves interior bytes alone" $ do
       let input = "trim \" a b \""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "a b"
 
   , testCase "trim all whitespace is empty" $ do
       let input = "trim \" \\t \""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString ""
   ]
 
 contractsTests :: TestTree
 contractsTests = testGroup "Contracts library tests"
   [ testCase "anyC passes any value" $ do
       let input = "main = resultIsOk (checkContract anyC 7)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "guardC rejects failures" $ do
       let input = "main = resultIsErr (checkContract (guardC \"odd\" even?) 5)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "andC combines contracts" $ do
       let input = "main = resultIsOk (checkContract (andC (guardC \"odd\" odd?) (guardC \"gt0\" (n : gt? n 0))) 5)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "listOf checks every element" $ do
       let input = "main = resultIsOk (checkContract (listOf (guardC \"odd\" odd?)) [1 3 5])"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "fnContract wraps a function" $ do
       let input = "main = resultIsOk (checkContract (fnContract (guardC \"odd\" odd?) anyC) (x : x))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "runM reduces pureM" $ do
       let input = "main = resultIsOk (runM (pureM 42))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "do notation chains checkM and pureM" $ do
       let input = unlines
             [ "program = (xs :"
             , "  do bindM"
             , "    n <- pureM (length xs)"
             , "    _ <- checkM (guardC \"positive\" (n : gte? n 1)) n"
             , "    pureM n)"
             , "main = runM (program [1 2 3 4])"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       decodeResult (result env) @?= "[t t, 4]"
 
   , testCase "handleM replaces exception with a new action" $ do
       let input = unlines
             [ "lookupConfig = (key defaultValue :"
             , "  exceptE \"missing\" key (resume : pureM defaultValue))"
             , "pipeline = (xs :"
             , "  do bindM"
             , "    divisor <- lookupConfig \"divisor\" 1"
             , "    total <- pureM (sum xs)"
             , "    scaled <- liftM (x : div x divisor) total"
             , "    pureM scaled)"
             , "handled = handleM \"missing\" (key k : pureM 2) (pipeline [10 20 30])"
             , "main = runM handled"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       decodeResult (result env) @?= "[t t, 30]"
 
   , testCase "=@ return annotation passes" $ do
       let input = unlines
             [ "five =@anyC 5"
             , "main = five"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "=@ return annotation fails" $ do
       let input = unlines
             [ "boom =@(neverC \"boom\") 5"
             , "main = boom"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       decodeResult (result env) @?= "[t, \"boom\"]"
 
   , testCase "@ argument annotation passes" $ do
       let input = unlines
             [ "idNat x@anyC =@anyC x"
             , "main = idNat 5"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "@ argument annotation fails" $ do
       let input = unlines
             [ "idNat x@(neverC \"bad\") =@anyC x"
             , "main = idNat 5"
             ]
           env = evalTricu allTestLibsEnv (parseTricu input)
       decodeResult (result env) @?= "[t, \"bad\"]"
   ]
 
 arithmetic :: TestTree
 arithmetic = testGroup "Arithmetic Tests"
   [ testCase "isZero? on 0" $ do
       let input = "isZero? 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "isZero? on 5" $ do
       let input = "isZero? 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "add 0 3 = 3" $ do
       let input = "add 0 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "add 3 0 = 3" $ do
       let input = "add 3 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "add 2 3 = 5" $ do
       let input = "add 2 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "sub 5 2 = 3" $ do
       let input = "sub 5 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "sub 2 5 = 0 (saturated)" $ do
       let input = "sub 2 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "sub 5 5 = 0" $ do
       let input = "sub 5 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "lt? 2 3 = true" $ do
       let input = "lt? 2 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "lt? 3 2 = false" $ do
       let input = "lt? 3 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "lt? 2 2 = false" $ do
       let input = "lt? 2 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "lte? 2 3 = true" $ do
       let input = "lte? 2 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "lte? 3 2 = false" $ do
       let input = "lte? 3 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "lte? 2 2 = true" $ do
       let input = "lte? 2 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "mul 0 5 = 0" $ do
       let input = "mul 0 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "mul 5 0 = 0" $ do
       let input = "mul 5 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "mul 2 3 = 6" $ do
       let input = "mul 2 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 6
 
   , testCase "mul 3 3 = 9" $ do
       let input = "mul 3 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 9
 
   , testCase "pred 0 = 0" $ do
       let input = "pred 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "pred 1 = 0" $ do
       let input = "pred 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "pred 5 = 4" $ do
       let input = "pred 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 4
 
   , testCase "add is commutative" $ do
       let input = "equal? (add 4 7) (add 7 4)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "add is associative" $ do
       let input = "equal? (add (add 2 3) 4) (add 2 (add 3 4))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "sub x 0 = x" $ do
       let input = "sub 7 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 7
 
   , testCase "sub chained" $ do
       let input = "sub (sub 10 3) 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "mul identity 1" $ do
       let input = "mul 1 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "mul identity 2" $ do
       let input = "mul 5 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "mul is commutative" $ do
       let input = "equal? (mul 3 4) (mul 4 3)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "mul is associative" $ do
       let input = "equal? (mul (mul 2 3) 4) (mul 2 (mul 3 4))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "mul distributes over add" $ do
       let input = "equal? (mul 2 (add 3 4)) (add (mul 2 3) (mul 2 4))"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "lt? reflexive is false" $ do
       let input = "lt? 5 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "lte? reflexive is true" $ do
       let input = "lte? 5 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "lt? transitivity" $ do
       let input = "and? (lt? 2 5) (lt? 5 7)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "add larger numbers" $ do
       let input = "add 12 15"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 27
 
   , testCase "mul larger numbers" $ do
       let input = "mul 5 6"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 30
 
   , testCase "isZero? on add 0 0" $ do
       let input = "isZero? (add 0 0)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "div 10 3 = 3" $ do
       let input = "div 10 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "div 12 4 = 3 (exact)" $ do
       let input = "div 12 4"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "div 3 5 = 0 (divisor larger)" $ do
       let input = "div 3 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "div 7 1 = 7 (identity)" $ do
       let input = "div 7 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 7
 
   , testCase "div 0 5 = 0" $ do
       let input = "div 0 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "div 5 0 = 0 (div by zero)" $ do
       let input = "div 5 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "mod 10 3 = 1" $ do
       let input = "mod 10 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 1
 
   , testCase "mod 12 4 = 0 (exact)" $ do
       let input = "mod 12 4"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "mod 3 5 = 3 (divisor larger)" $ do
       let input = "mod 3 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "mod 7 1 = 0" $ do
       let input = "mod 7 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "mod 5 0 = 0 (mod by zero)" $ do
       let input = "mod 5 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "div mod consistency" $ do
       let input = "equal? (add (mul 3 7) 4) 25"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "pow 2 0 = 1" $ do
       let input = "pow 2 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 1
 
   , testCase "pow 2 3 = 8" $ do
       let input = "pow 2 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 8
 
   , testCase "pow 3 2 = 9" $ do
       let input = "pow 3 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 9
 
   , testCase "pow 0 0 = 1" $ do
       let input = "pow 0 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 1
 
   , testCase "pow 0 5 = 0" $ do
       let input = "pow 0 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "pow 1 10 = 1" $ do
       let input = "pow 1 10"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 1
 
   , testCase "pow 5 1 = 5" $ do
       let input = "pow 5 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "min 3 7 = 3" $ do
       let input = "min 3 7"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "min 7 3 = 3" $ do
       let input = "min 7 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "min 5 5 = 5" $ do
       let input = "min 5 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "min 0 5 = 0" $ do
       let input = "min 0 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "max 3 7 = 7" $ do
       let input = "max 3 7"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 7
 
   , testCase "max 7 3 = 7" $ do
       let input = "max 7 3"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 7
 
   , testCase "max 5 5 = 5" $ do
       let input = "max 5 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "max 0 5 = 5" $ do
       let input = "max 0 5"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 5
 
   , testCase "even? 0 = true" $ do
       let input = "even? 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "even? 1 = false" $ do
       let input = "even? 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "even? 2 = true" $ do
       let input = "even? 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "even? 7 = false" $ do
       let input = "even? 7"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "odd? 0 = false" $ do
       let input = "odd? 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "odd? 1 = true" $ do
       let input = "odd? 1"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "odd? 2 = false" $ do
       let input = "odd? 2"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "odd? 7 = true" $ do
       let input = "odd? 7"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
   ]
 
 fileEval :: TestTree
 fileEval = testGroup "File evaluation tests"
   [ testCase "Forks" $ do
       res <- liftIO $ evaluateFileResult "./test/fork.tri"
       res @?= Fork Leaf Leaf
 
   , testCase "File ends with comment" $ do
       res <- liftIO $ evaluateFileResult "./test/comments-1.tri"
       res @?= Fork (Stem Leaf) Leaf
 
   , testCase "Mapping and Equality" $ do
       fEnv    <- liftIO $ evaluateFileWithContext allTestLibsEnv "./test/map.tri"
       (mainResult fEnv) @?= Stem Leaf
 
   , testCase "Eval and decoding string" $ do
       res <- liftIO $ evaluateFileWithContext allTestLibsEnv "./test/string.tri"
       decodeResult (result res) @?= "\"String test!\""
   ]
 
 -- All of our demo tests are also module tests
 demos :: TestTree
 demos = testGroup "Test provided demo functionality"
   [ testCase "Structural equality demo" $ do
       res     <- liftIO $ evaluateFileResult "./demos/equality.tri"
       decodeResult res @?= "t t"
   , testCase "Convert values back to source code demo" $ do
       res     <- liftIO $ evaluateFileResult "./demos/toSource.tri"
       decodeResult res @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\""
   , testCase "Determining the size of functions" $ do
       res     <- liftIO $ evaluateFileResult "./demos/size.tri"
       decodeResult res @?= "321"
   , testCase "Level Order Traversal demo" $ do
       res     <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri"
       decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \""
   , testCase "Contract effect demo with do notation" $ do
       res     <- liftIO $ evaluateFileResult "./demos/contractEffects.tri"
       decodeResult res @?= "[t t, 10]"
   , testCase "Safe base wrappers demo" $ do
       res     <- liftIO $ evaluateFileResult "./demos/contractBasics.tri"
       decodeResult res @?= "[3, t t, t, t t]"
   ]
 
 decoding :: TestTree
 decoding = testGroup "Decoding Tests"
   [ testCase "Decode Leaf" $ do
       decodeResult Leaf @?= "t"
 
   , testCase "Decode list of non-ASCII numbers" $ do
       let input = ofList [ofNumber 1, ofNumber 14, ofNumber 6]
       decodeResult input @?= "[1, 14, 6]"
 
   , testCase "Decode list of ASCII numbers as a string" $ do
       let input = ofList [ofNumber 97, ofNumber 98, ofNumber 99]
       decodeResult input @?= "\"abc\""
 
   , testCase "Decode small number" $ do
       decodeResult (ofNumber 42) @?= "42"
 
   , testCase "Decode large number" $ do
       decodeResult (ofNumber 9999) @?= "9999"
 
   , testCase "Decode string in list" $ do
       let input = ofList [ofString "hello", ofString "world"]
       decodeResult input @?= "[\"hello\", \"world\"]"
 
   , testCase "Decode mixed list with strings" $ do
       let input = ofList [ofString "hello", ofNumber 42, ofString "world"]
       decodeResult input @?= "[\"hello\", 42, \"world\"]"
 
   , testCase "Decode nested lists with strings" $ do
       let input = ofList [ofList [ofString "nested"], ofString "string"]
       decodeResult input @?= "[[\"nested\"], \"string\"]"
   ]
 
 elimLambdaSingle :: TestTree
 elimLambdaSingle = testCase "elimLambda preserves eval, fires eta, and SDef binds" $ do
   -- 1) eta reduction, purely structural and parsed from source
   let [etaIn] = parseTricu "x : f x"
       [fRef ] = parseTricu "f"
   elimLambda etaIn @?= fRef
 
   -- 2) SDef binds its own name and parameters
   let [defFXY] = parseTricu "f x y : f x"
       fv       = freeVars defFXY
   assertBool "f should be bound in SDef" ("f" `Set.notMember` fv)
   assertBool "x should be bound in SDef" ("x" `Set.notMember` fv)
   assertBool "y should be bound in SDef" ("y" `Set.notMember` fv)
 
   -- 3) semantics preserved on a small program that exercises compose and triage
   let src =
         unlines
           [ "false = t"
           , "_     = t"
           , "true  = t t"
           , "id    = a : a"
           , "const = a b : a"
           , "compose = f g x : f (g x)"
           , "triage = leaf stem fork : t (t leaf stem) fork"
           , "test   = triage \"Leaf\" (_ : \"Stem\") (_ _ : \"Fork\")"
           , "main   = compose id id test"
           ]
       prog        = parseTricu src
       progElim    = map elimLambda prog
       evalBefore  = result (evalTricu Map.empty prog)
       evalAfter   = result (evalTricu Map.empty progElim)
   evalAfter @?= evalBefore
 
 stressElimLambda :: TestTree
 stressElimLambda = testCase "stress elimLambda on wide list under deep curried lambda" $ do
   let numVars = 200
       numBody = 800
       vars    = [ "x" ++ show i | i <- [1..numVars] ]
       body    = "(" ++ unwords (replicate numBody "t") ++ ")"
       etaOne  = "h : f h"
       etaTwo  = "k : id k"
       defId   = "id = a : a"
       lambda  = unwords vars ++ " : " ++ body
       src     = unlines
                   [ defId
                   , etaOne
                   , "compose = f g x : f (g x)"
                   , "f = t t"
                   , etaTwo
                   , lambda
                   , "main = compose id id (" ++ head vars ++ " : f " ++ head vars ++ ")"
                   ]
       prog    = parseTricu src
 
   let out = map elimLambda prog
   let noLambda term = case term of
         SLambda _ _ -> False
         SApp f g    -> noLambda f && noLambda g
         SList xs    -> all noLambda xs
         TFork l r   -> noLambda l && noLambda r
         TStem u     -> noLambda u
         _           -> True
 
   assertBool "all lambdas eliminated" (all noLambda out)
 
   let before = result (evalTricu Map.empty prog)
       after  = result (evalTricu Map.empty out)
   after @?= before
 
 -- --------------------------------------------------------------------------
 -- Byte marshalling tests
 -- --------------------------------------------------------------------------
 
 byteMarshallingTests :: TestTree
 byteMarshallingTests = testGroup "Byte Marshalling Tests"
   [ testCase "ofByte / toByte round-trip: 0" $ do
       let w8 = (0 :: Word8)
       toByte (ofByte w8) @?= Right w8
 
   , testCase "ofByte / toByte round-trip: 1" $ do
       let w8 = (1 :: Word8)
       toByte (ofByte w8) @?= Right w8
 
   , testCase "ofByte / toByte round-trip: 127" $ do
       let w8 = (127 :: Word8)
       toByte (ofByte w8) @?= Right w8
 
   , testCase "ofByte / toByte round-trip: 128" $ do
       let w8 = (128 :: Word8)
       toByte (ofByte w8) @?= Right w8
 
   , testCase "ofByte / toByte round-trip: 255" $ do
       let w8 = (255 :: Word8)
       toByte (ofByte w8) @?= Right w8
 
   , testCase "toByte rejects value > 255" $ do
       -- ofNumber 256 = Fork Leaf (Fork Leaf Leaf) — value 256
       toByte (ofNumber 256) @?= Left "Byte value out of range: 256"
 
   , testCase "toByte accepts Leaf" $ do
       toByte (Leaf) @?= Right 0
 
   , testCase "toByte rejects non-number tree" $ do
       toByte (Stem Leaf) @?= Left "Invalid Tree Calculus number"
       toByte (Stem (Stem Leaf)) @?= Left "Invalid Tree Calculus number"
 
   , testCase "ofBytes / toBytes round-trip: empty ByteString" $ do
       toBytes (ofBytes BS.empty) @?= Right BS.empty
 
   , testCase "ofBytes / toBytes round-trip: [0x00]" $ do
       toBytes (ofBytes (BS.pack [0x00])) @?= Right (BS.pack [0x00])
 
   , testCase "ofBytes / toBytes round-trip: [0xff]" $ do
       toBytes (ofBytes (BS.pack [0xff])) @?= Right (BS.pack [0xff])
 
   , testCase "ofBytes / toBytes round-trip: mixed bytes" $ do
       let bytes = BS.pack [0x00, 0x01, 0x7f, 0x80, 0xff, 0x41, 0x42, 0x43]
       toBytes (ofBytes bytes) @?= Right bytes
 
   , testCase "toBytes rejects non-list tree" $ do
       -- Leaf is a valid list (empty), so this won't work.
       -- Stem Leaf is not a list.
       toBytes (Stem Leaf) @?= Left "Invalid Tree Calculus list"
 
   , testCase "toBytes rejects list containing invalid byte (>255)" $ do
       -- [ofNumber 256, ofNumber 1] — first element is > 255
       let badList = ofList [ofNumber 256, ofNumber 1]
       toBytes badList @?= Left "Byte value out of range: 256"
 
   , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Leaf payload" $ do
       -- Leaf payload is 0x00 (1 byte)
       let payload = BS.pack [0x00]
       treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
 
   , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Stem payload" $ do
       -- Stem payload: 0x01 || 32-byte hash = 33 bytes
       let payload = BS.pack (0x01 : replicate 32 0x42)
       treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
 
   , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Fork payload" $ do
       -- Fork payload: 0x02 || 32-byte hash || 32-byte hash = 65 bytes
       let payload = BS.pack (0x02 : replicate 64 0x42)
       treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
 
   , testCase "hashToTreeBytes / treeBytesToHash round-trip" $ do
       -- Use a known 32-byte hash (SHA256 of "")
       let hashStr :: MerkleHash
           hashStr = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
       case hashToTreeBytes hashStr of
         Left err -> assertFailure $ "hashToTreeBytes failed: " ++ err
         Right tree -> treeBytesToHash tree @?= Right hashStr
 
   , testCase "hashToTreeBytes rejects invalid hex hash" $ do
       hashToTreeBytes "not-a-hash" @?= Left "Invalid hex MerkleHash"
 
   , testCase "hashToTreeBytes rejects non-32-byte hash" $ do
       -- "00" decodes to 1 byte, not 32
       hashToTreeBytes "00" @?= Left "Hash raw bytes must be 32 bytes"
 
   , testCase "treeBytesToHash rejects wrong byte count" $ do
       -- Only 16 bytes, not 32
       let t16 = ofBytes (BS.pack [0x41 | _ <- [1..16]])
       treeBytesToHash t16 @?= Left "Expected exactly 32 byte elements for hash"
   ]
 
 -- --------------------------------------------------------------------------
 -- Content store tests
 -- --------------------------------------------------------------------------
 
 contentStoreTests :: TestTree
 contentStoreTests = testGroup "Content Store Tests"
   [ testCase "Filesystem CAS: put/get object and sharded path" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             domain = Domain "test.object.v1"
             payload = BS.pack [1, 2, 3, 4]
         h <- putObject store domain payload
         shardForHash h @?= take 3 (unpack h)
         objectPath store h @?= dir </> "objects" </> take 3 (unpack h) </> unpack h
         doesFileExist (objectPath store h) >>= (@?= True)
         getObject store h >>= (@?= Just payload)
 
   , testCase "Filesystem CAS: idempotent object writes" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             domain = Domain "test.object.v1"
             payload = BS.pack [9, 8, 7]
         h1 <- putObject store domain payload
         h2 <- putObject store domain payload
         h1 @?= h2
         countStoredObjects store >>= (@?= 1)
 
   , testCase "Filesystem CAS: putTree/getTree round trip" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             term = Fork (Stem Leaf) (Fork Leaf (Stem Leaf))
             leafHash = nodeHash NLeaf
             stemHash = nodeHash (NStem leafHash)
             rightHash = nodeHash (NFork leafHash stemHash)
             expectedRoot = nodeHash (NFork stemHash rightHash)
         root <- putTree store term
         root @?= expectedRoot
         getTree store root >>= (@?= Just term)
 
   , testCase "Filesystem CAS: shared subtrees are deduplicated" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             shared = Stem Leaf
             term = Fork shared shared
         _ <- putTree store term
         countStoredObjects store >>= (@?= 3)
 
   , testCase "Workspace aliases: write/read/list object refs" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             ref = ObjectRef "arboricx.tree-root.v1" "abc123"
         writeAlias store NameAlias "main" ref
         readAlias store NameAlias "main" >>= (@?= Just ref)
         listAliases store NameAlias >>= (@?= [("main", ref)])
 
   , testCase "Module manifests: put/get round trip through CAS" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             term = Fork Leaf (Stem Leaf)
             manifestFor root = ModuleManifest []
               [ ModuleExport
                   "main"
                   (ObjectRef (unDomain treeTermDomain) root)
                   "arboricx.abi.tree.v1"
               ]
         root <- putTreeTerm store term
         h <- putManifest store (manifestFor root)
         getManifest store h >>= (@?= Just (manifestFor root))
 
   , testCase "ObjectResolver: resolves manifests and trees without filesystem coupling" $ do
       let term = Fork Leaf (Stem Leaf)
           leafH = nodeHash NLeaf
           stemH = nodeHash (NStem leafH)
           rootH = nodeHash (NFork leafH stemH)
           termH = hashObject treeTermDomain (encodeTreeTerm term)
           manifest = ModuleManifest []
             [ ModuleExport
                 "value"
                 (ObjectRef (unDomain treeTermDomain) termH)
                 "arboricx.abi.tree.v1"
               ]
           manifestBytes = encodeManifest manifest
           manifestH = hashObject manifestDomain manifestBytes
           objects = Map.fromList
             [ (("arboricx.merkle.node.v1", leafH), serializeNode NLeaf)
             , (("arboricx.merkle.node.v1", stemH), serializeNode (NStem leafH))
             , (("arboricx.merkle.node.v1", rootH), serializeNode (NFork leafH stemH))
             , ((unDomain treeTermDomain, termH), encodeTreeTerm term)
             , ((unDomain manifestDomain, manifestH), manifestBytes)
             ]
           hydrate objs h = case deserializeNode <$> Map.lookup ("arboricx.merkle.node.v1", h) objs of
             Nothing -> return Nothing
             Just NLeaf -> return (Just Leaf)
             Just (NStem child) -> fmap Stem <$> hydrate objs child
             Just (NFork left right) -> do
               l <- hydrate objs left
               r <- hydrate objs right
               return $ Fork <$> l <*> r
           resolver = ObjectResolver
             { resolverAlias = \kind name -> return $ if kind == ModuleAlias && name == "demo"
                 then Just (ObjectRef (unDomain manifestDomain) manifestH)
                 else Nothing
             , resolverObject = \ref -> return $ Map.lookup (objectRefKind ref, objectRefHash ref) objects
             , resolverManifest = \h -> return $ do
                 bytes <- Map.lookup (unDomain manifestDomain, h) objects
                 either (const Nothing) Just (decodeManifest bytes)
             , resolverTree = hydrate objects
             }
       resolverAlias resolver ModuleAlias "demo" >>= (@?= Just (ObjectRef (unDomain manifestDomain) manifestH))
       resolveManifest resolver manifestH >>= (@?= Just manifest)
       resolveTree resolver rootH >>= (@?= Just term)
 
   , testCase "Workspace modules: exported names are local top-level definitions only" $
       withSystemTempDirectory "tricu-workspace-local-exports" $ \dir -> do
         let store = StorePath (dir </> "store")
             depPath = dir </> "dep.tri"
             libPath = dir </> "util.tri"
             mainPath = dir </> "main.tri"
         writeFile (dir </> "tricu.workspace") "module dep = dep.tri\nmodule util = util.tri\n"
         writeFile depPath "helper = t t\n"
         writeFile libPath "!import \"dep\" !Local\n\nvalue = helper\n"
         writeFile mainPath "!import \"util\" Util\n\nmain = Util.value\n"
         env <- evaluateFileWithStore (Just store) mainPath
         result env @?= Stem Leaf
         mAlias <- readAlias store ModuleAlias "util"
         case mAlias of
           Nothing -> assertFailure "expected workspace build to write util module alias"
           Just ref -> do
             mManifest <- getManifest store (objectRefHash ref)
             case mManifest of
               Nothing -> assertFailure "expected workspace module manifest"
               Just manifest -> map moduleExportName (moduleManifestExports manifest) @?= ["value"]
 
   , testCase "Workspace modules: contract annotations travel with exported definitions" $
       withSystemTempDirectory "tricu-workspace-contract-export" $ \dir -> do
         let store = StorePath (dir </> "store")
             libPath = dir </> "util.tri"
             mainPath = dir </> "main.tri"
         cwd <- getCurrentDirectory
         writeFile (dir </> "tricu.workspace") ("module base = \"" ++ cwd </> "lib/base.tri\"\nmodule util = \"" ++ dir </> "util.tri\"\n")
         writeFile libPath "!import \"base\" !Local\n\nalwaysOk = (value rest : ok value rest)\n\nneverOk = (value rest : err \"nope\" rest)\n\nsafeId n@alwaysOk =@alwaysOk n\n\nbadId n@neverOk =@neverOk n\n"
         writeFile mainPath "!import \"util\" Util\n\nmain = Util.safeId 5\n"
         env <- evaluateFileWithStore (Just store) mainPath
         result env @?= ofNumber 5
         writeFile mainPath "!import \"util\" Util\n\nmain = Util.badId 5\n"
         envFail <- evaluateFileWithStore (Just store) mainPath
         decodeResult (result envFail) @?= "[t, \"nope\"]"
 
   , testCase "Module imports: resolve manifest exports from store" $
       withSystemTempDirectory "tricu-module-import" $ \dir -> do
         let store = StorePath (dir </> "store")
             sourcePath = dir </> "consumer.tri"
             term = Fork Leaf (Stem Leaf)
             manifestFor root = ModuleManifest []
               [ ModuleExport
                   "value"
                   (ObjectRef (unDomain treeTermDomain) root)
                   "arboricx.abi.tree.v1"
               ]
         root <- putTreeTerm store term
         manifestHash <- putManifest store (manifestFor root)
         writeAlias store ModuleAlias "demo" (ObjectRef (unDomain manifestDomain) manifestHash)
         writeFile sourcePath "!import \"demo\" Demo\n\nmain = Demo.value\n"
         env <- evaluateFileWithStore (Just store) sourcePath
         result env @?= term
 
   , testCase "Module resolver diagnostics: missing alias names workspace/module guidance" $ do
       let resolver = filesystemResolver (StorePath "/tmp/tricu-test-missing-module-store")
       outcome <- try (resolveModuleImport resolver "definitely-not-a-module" "Demo") :: IO (Either SomeException ResolvedModule)
       case outcome of
         Right _ -> assertFailure "expected missing module alias failure"
         Left err -> show err `containsAll` ["Module alias not found", "definitely-not-a-module", "tricu.workspace", "ModuleAlias"]
 
   , testCase "Module resolver diagnostics: alias kind mismatch names expected kind" $ do
       let resolver = ObjectResolver
             { resolverAlias = \kind name -> return $ if kind == ModuleAlias && name == "demo"
                 then Just (ObjectRef "arboricx.tree-root.v1" "abc123")
                 else Nothing
             , resolverObject = \_ -> return Nothing
             , resolverManifest = \_ -> return Nothing
             , resolverTree = \_ -> return Nothing
             }
       outcome <- try (resolveModuleImport resolver "demo" "Demo") :: IO (Either SomeException ResolvedModule)
       case outcome of
         Right _ -> assertFailure "expected alias kind mismatch failure"
         Left err -> show err `containsAll` ["Module alias", "demo", "unsupported object kind", "arboricx.tree-root.v1", "arboricx.module-manifest.v1"]
 
   , testCase "Module resolver diagnostics: missing tree term names export and hash" $ do
       let root = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
           manifest = ModuleManifest []
             [ ModuleExport "value" (ObjectRef (unDomain treeTermDomain) root) "arboricx.abi.tree.v1" ]
           resolver = ObjectResolver
             { resolverAlias = \kind name -> return $ if kind == ModuleAlias && name == "demo"
                 then Just (ObjectRef (unDomain manifestDomain) "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb")
                 else Nothing
             , resolverObject = \_ -> return Nothing
             , resolverManifest = \_ -> return (Just manifest)
             , resolverTree = \_ -> return Nothing
             }
       outcome <- try (resolveModuleImport resolver "demo" "Demo") :: IO (Either SomeException ResolvedModule)
       case outcome of
         Right _ -> assertFailure "expected missing tree term failure"
         Left err -> show err `containsAll` ["Module export", "value", "missing tree term", unpack root]
 
   , testCase "Arboricx bundle: unpack transport bundle into CAS tree terms" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             term = Fork (Stem Leaf) Leaf
             bundle = buildBundle [("main", term)]
         exports <- unpackBundleToStore store (encodeBundle bundle)
         case exports of
           [("main", root)] -> getTreeTerm store root >>= (@?= Just term)
           other -> assertFailure $ "unexpected exports: " ++ show other
 
   , testCase "Arboricx bundle: pack CAS tree terms into transport bundle" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let store = StorePath dir
             term = Fork Leaf (Stem Leaf)
         root <- putTreeTerm store term
         bundle <- packBundleFromStore store [("main", root)]
         bundleRoots bundle @?= [2]
         let terms = reconstructBundleTermsForTest (bundleNodes bundle)
         case manifestExports (bundleManifest bundle) of
           [exported] -> do
             exportName exported @?= "main"
             terms V.! fromIntegral (exportRoot exported) @?= term
           other -> assertFailure $ "unexpected exports: " ++ show other
   ]
 
 reconstructBundleTermsForTest :: Seq.Seq BundleNode -> V.Vector T
 reconstructBundleTermsForTest nodes = V.fromList (go <$> Foldable.toList nodes)
   where
     built = V.fromList (go <$> Foldable.toList nodes)
     go BNLeaf = Leaf
     go (BNStem child) = Stem (built V.! fromIntegral child)
     go (BNFork left right) = Fork (built V.! fromIntegral left) (built V.! fromIntegral right)
 
 countStoredObjects :: StorePath -> IO Int
 countStoredObjects store@(StorePath root) = do
   ensureStore store
   shards <- listDirectory (root </> "objects")
   fmap sum $ forM shards $ \shard -> do
     files <- listDirectory (root </> "objects" </> shard)
     return (length files)
 
 -- --------------------------------------------------------------------------
 -- Wire module tests
 -- --------------------------------------------------------------------------
 
 -- | Helper: create a temporary file-backed DB, store a term, return the
 
 wireTests :: TestTree
 wireTests = testGroup "Wire Tests"
   [ testCase "Indexed bundle: header and manifest declare indexed format" $ do
       let term = result $ evalTricu Map.empty $ parseTricu "id = a : a\nmain = id t"
           bundle = buildBundle [("main", term)]
           wireData = encodeBundle bundle
       BS.take 8 wireData @?= BS.pack [0x41, 0x52, 0x42, 0x4f, 0x52, 0x49, 0x43, 0x58]
       case decodeBundle wireData of
         Left err -> assertFailure $ "decodeBundle failed: " ++ err
         Right decoded -> do
           let manifest = bundleManifest decoded
               tree = manifestTree manifest
               hashSpec = treeNodeHash tree
           manifestSchema manifest @?= "arboricx.bundle.manifest.v1"
           manifestBundleType manifest @?= "tree-calculus-executable-object"
           manifestClosure manifest @?= ClosureComplete
           treeCalculus tree @?= "tree-calculus.v1"
           treeNodePayload tree @?= "arboricx.indexed.payload.v1"
           nodeHashAlgorithm hashSpec @?= "indexed"
           nodeHashDomain hashSpec @?= "arboricx.indexed.node.v1"
           bundleRoots decoded @?= bundleRoots bundle
           case manifestExports manifest of
             [exported] -> do
               exportName exported @?= "main"
               exportRoot exported @?= head (bundleRoots bundle)
               exportKind exported @?= "term"
               exportAbi exported @?= "arboricx.abi.tree.v1"
             exports -> assertFailure $ "Expected one export, got: " ++ show exports
 
   , testCase "Indexed bundle: deterministic encoding" $ do
       let term = result $ evalTricu Map.empty $ parseTricu "x = t t\nmain = t x"
           bundle1 = buildBundle [("main", term)]
           bundle2 = buildBundle [("main", term)]
       encodeBundle bundle1 @?= encodeBundle bundle2
 
   , testCase "Indexed bundle: renaming export changes bytes" $ do
       let term = result $ evalTricu Map.empty $ parseTricu "f = a : a\nmain = f t"
           mainBundle = buildBundle [("main", term)]
           renamedBundle = buildBundle [("validate", term)]
       encodeBundle mainBundle /= encodeBundle renamedBundle @? "different export names should produce different bytes"
       -- But nodes are identical
       bundleNodes mainBundle @?= bundleNodes renamedBundle
 
   , testCase "Indexed bundle: verify rejects out-of-bounds root" $ do
       let term = Leaf
           bundle = buildBundle [("main", term)]
           badBundle = bundle { bundleRoots = [99] }
       case verifyBundle badBundle of
         Left err -> assertBool ("Expected bounds error, got: " ++ err) ("out of bounds" `isInfixOf` err)
         Right () -> assertFailure "Expected out-of-bounds root to be rejected"
 
   , testCase "Indexed bundle: verify rejects out-of-bounds child index" $ do
       let bundle = Bundle
             { bundleVersion = 1000
             , bundleRoots = [1]
             , bundleNodes = Seq.fromList [BNLeaf, BNStem 99]
             , bundleManifest = (bundleManifest $ buildBundle [("main", Leaf)])
                 { manifestRoots = [BundleRoot 1 "default"]
                 , manifestExports = [BundleExport "main" 1 "term" "arboricx.abi.tree.v1"]
                 }
             , bundleManifestBytes = BS.empty
             }
       case verifyBundle bundle of
         Left err -> assertBool ("Expected bounds error, got: " ++ err) ("references child 99" `isInfixOf` err)
         Right () -> assertFailure "Expected out-of-bounds child to be rejected"
 
   , testCase "Indexed bundle: verify rejects acyclic (forward reference)" $ do
       let bundle = Bundle
             { bundleVersion = 1000
             , bundleRoots = [1]
             , bundleNodes = Seq.fromList [BNStem 1, BNLeaf]  -- index 0 refers to 1 (forward)
             , bundleManifest = (bundleManifest $ buildBundle [("main", Leaf)])
                 { manifestRoots = [BundleRoot 1 "default"]
                 , manifestExports = [BundleExport "main" 1 "term" "arboricx.abi.tree.v1"]
                 }
             , bundleManifestBytes = BS.empty
             }
       case verifyBundle bundle of
         Left err -> assertBool ("Expected acyclicity error, got: " ++ err) ("references child 1" `isInfixOf` err)
         Right () -> assertFailure "Expected forward reference to be rejected"
 
   , testCase "Indexed bundle: verify rejects duplicate nodes" $ do
       let bundle = Bundle
             { bundleVersion = 1000
             , bundleRoots = [0]
             , bundleNodes = Seq.fromList [BNLeaf, BNLeaf]
             , bundleManifest = (bundleManifest $ buildBundle [("main", Leaf)])
                 { manifestRoots = [BundleRoot 0 "default"]
                 , manifestExports = [BundleExport "main" 0 "term" "arboricx.abi.tree.v1"]
                 }
             , bundleManifestBytes = BS.empty
             }
       case verifyBundle bundle of
         Left err -> assertBool ("Expected duplicate error, got: " ++ err) ("duplicate" `isInfixOf` err)
         Right () -> assertFailure "Expected duplicate nodes to be rejected"
 
   , testCase "Indexed bundle: unpack into filesystem CAS" $
       withSystemTempDirectory "tricu-store" $ \dir -> do
         let term = result $ evalTricu Map.empty $ parseTricu "validateEmail = a : a\nmain = validateEmail t"
             bundle = buildBundle [("validateEmail", term)]
             wireData = encodeBundle bundle
             store = StorePath dir
         roots <- unpackBundleToStore store wireData
         case roots of
           [("validateEmail", root)] -> getTree store root >>= (@?= Just term)
           other -> assertFailure $ "unexpected roots: " ++ show other
 
   , testCase "Indexed bundle: round-trip decode and verify" $ do
       let term = result $ evalTricu Map.empty $ parseTricu "x = t\ny = t x\nz = t y\nmain = z"
           bundle = buildBundle [("main", term)]
           wireData = encodeBundle bundle
       case decodeBundle wireData of
         Left err -> assertFailure $ "decodeBundle failed: " ++ err
         Right decoded -> case verifyBundle decoded of
           Left err -> assertFailure $ "verifyBundle failed: " ++ err
           Right () -> do
             bundleRoots decoded @?= bundleRoots bundle
             Seq.length (bundleNodes decoded) @?= Seq.length (bundleNodes bundle)
 
   , testCase "Indexed bundle: unsupported manifest semantics rejected" $ do
       let term = Leaf
           bundle = buildBundle [("main", term)]
           manifest = bundleManifest bundle
           partialBundle = bundle
             { bundleManifest = manifest { manifestClosure = ClosurePartial }
             , bundleManifestBytes = BS.empty
             }
           capabilityBundle = bundle
             { bundleManifest = manifest
                 { manifestRuntime = (manifestRuntime manifest)
                     { runtimeCapabilities = ["host.io"] }
                 }
             , bundleManifestBytes = BS.empty
             }
           wrongHashBundle = bundle
             { bundleManifest = manifest
                 { manifestTree = (manifestTree manifest)
                     { treeNodeHash = (treeNodeHash $ manifestTree manifest)
                         { nodeHashAlgorithm = "blake3" }
                     }
                 }
             , bundleManifestBytes = BS.empty
             }
       case verifyBundle partialBundle of
         Left err -> assertBool ("Expected closure error, got: " ++ err) ("closure = complete" `isInfixOf` err)
         Right () -> assertFailure "Expected partial closure to be rejected"
       case verifyBundle capabilityBundle of
         Left err -> assertBool ("Expected capability error, got: " ++ err) ("capabilities" `isInfixOf` err)
         Right () -> assertFailure "Expected runtime capabilities to be rejected"
       case verifyBundle wrongHashBundle of
         Left err -> assertBool ("Expected hash algorithm error, got: " ++ err) ("node hash algorithm" `isInfixOf` err)
         Right () -> assertFailure "Expected unsupported node hash algorithm to be rejected"
     ]
 
 -- --------------------------------------------------------------------------
 -- Tricu reader tests
 -- Smoke-test the tricu-native Arboricx reader against indexed bundles.
 -- --------------------------------------------------------------------------
 
 tricuReaderTests :: TestTree
 tricuReaderTests = testGroup "Tricu Reader Tests"
   [ testCase "Tricu reader parses indexed bundle (id fixture)" $ do
       bundleBytes <- BS.readFile "./test/fixtures/id.arboricx"
       let bundleT = ofBytes bundleBytes
       let env = Map.insert "testBundle" bundleT allTestLibsEnv
           tagExpr = parseTricu "pairFirst (runArboricx testBundle t)"
           tag = result (evalTricu env tagExpr)
           codeExpr = parseTricu "pairFirst (pairSecond (runArboricx testBundle t))"
           code = result (evalTricu env codeExpr)
       tag @?= trueT
 
   , testCase "Tricu reader parses indexed bundle (append fixture)" $ do
       bundleBytes <- BS.readFile "./test/fixtures/append.arboricx"
       let bundleT = ofBytes bundleBytes
       let env = Map.insert "testBundle" bundleT allTestLibsEnv
           tagExpr = parseTricu "pairFirst (runArboricx testBundle t)"
           tag = result (evalTricu env tagExpr)
       tag @?= trueT
 
   , testCase "Tricu reader parses indexed bundle (bool fixtures)" $ do
       forM_ ["true", "false"] $ \name -> do
         bundleBytes <- BS.readFile ("./test/fixtures/" ++ name ++ ".arboricx")
         let bundleT = ofBytes bundleBytes
         let env = Map.insert "testBundle" bundleT allTestLibsEnv
             tagExpr = parseTricu "pairFirst (runArboricx testBundle t)"
             tag = result (evalTricu env tagExpr)
         tag @?= trueT
   ]
 
 -- --------------------------------------------------------------------------
 -- Byte-list utility tests
 -- Expected values built with canonical Haskell-side T constructors.
 -- --------------------------------------------------------------------------
 
 -- | Helpers for byte-list test expectations.
 
 trueT  :: T
 trueT  = Stem Leaf
 
 falseT :: T
 falseT = Leaf
 
 nothingT :: T
 nothingT = Leaf
 
 justT :: T -> T
 justT = Stem
 
 pairT :: T -> T -> T
 pairT = Fork
 
 byteT :: Integer -> T
 byteT = ofNumber
 
 bytesT :: [Integer] -> T
 bytesT = ofList . fmap byteT
 
 bytesExpr :: [Integer] -> String
 bytesExpr xs = "[" ++ unwords (map (\n -> "(" ++ show n ++ ")") xs) ++ "]"
 
 u16 :: Integer -> [Integer]
 u16 n = [0,n]
 
 u32 :: Integer -> [Integer]
 u32 n = [0,0,0,n]
 
 u64 :: Integer -> [Integer]
 u64 n = [0,0,0,0,0,0,0,n]
 
 arboricxHeaderBytes :: Integer -> [Integer]
 arboricxHeaderBytes sectionCount =
   [65,82,66,79,82,73,67,88]
   ++ u16 1
   ++ u16 0
   ++ u32 sectionCount
   ++ u64 0
   ++ u64 32
 
 sectionEntryBytes :: [Integer] -> Integer -> Integer -> [Integer]
 sectionEntryBytes sectionType offset lengthBytes =
   sectionType
   ++ u16 1
   ++ u16 1
   ++ u16 0
   ++ u16 1
   ++ u64 offset
   ++ u64 lengthBytes
   ++ replicate 32 0
 
 manifestSectionIdBytes :: [Integer]
 manifestSectionIdBytes = [0,0,0,1]
 
 nodesSectionIdBytes :: [Integer]
 nodesSectionIdBytes = [0,0,0,2]
 
 hexTextBytes :: Text -> [Integer]
 hexTextBytes h = go (unpack h)
   where
     go [] = []
     go (a:b:rest) = toInteger (digitToInt a * 16 + digitToInt b) : go rest
     go _ = error "odd-length hex text"
 
 manifestEntryBytes :: Integer -> Integer -> [Integer]
 manifestEntryBytes = sectionEntryBytes manifestSectionIdBytes
 
 nodesEntryBytes :: Integer -> Integer -> [Integer]
 nodesEntryBytes = sectionEntryBytes nodesSectionIdBytes
 
 simpleContainerBytes :: [Integer] -> [Integer] -> [Integer]
 simpleContainerBytes manifestBytes nodesBytes =
   let manifestOffset = 152
       nodesOffset = manifestOffset + fromIntegral (length manifestBytes)
   in arboricxHeaderBytes 2
      ++ manifestEntryBytes manifestOffset (fromIntegral $ length manifestBytes)
      ++ nodesEntryBytes nodesOffset (fromIntegral $ length nodesBytes)
      ++ manifestBytes
      ++ nodesBytes
 
 singleSectionContainerBytes :: [Integer] -> [Integer] -> [Integer]
 singleSectionContainerBytes sectionType sectionBytes =
   arboricxHeaderBytes 1
   ++ sectionEntryBytes sectionType 92 (fromIntegral $ length sectionBytes)
   ++ sectionBytes
 
 arboricxHeaderT :: Integer -> T
 arboricxHeaderT sectionCount =
   pairT (bytesT [0,1])
     (pairT (bytesT [0,0])
       (pairT (bytesT $ u32 sectionCount)
         (pairT (bytesT $ u64 0)
           (bytesT $ u64 32))))
 
 sectionRecordT :: [Integer] -> Integer -> Integer -> T
 sectionRecordT sectionType offset lengthBytes =
   pairT (bytesT sectionType)
     (pairT (bytesT [0,1])
       (pairT (bytesT [0,1])
         (pairT (bytesT [0,0])
           (pairT (bytesT [0,1])
             (pairT (bytesT $ u64 offset)
               (pairT (bytesT $ u64 lengthBytes)
                 (bytesT $ replicate 32 0)))))))
 
 sectionRecordExpr :: [Integer] -> Integer -> Integer -> String
 sectionRecordExpr sectionType offset lengthBytes =
   "(pair " ++ bytesExpr sectionType
   ++ " (pair " ++ bytesExpr [0,1]
   ++ " (pair " ++ bytesExpr [0,1]
   ++ " (pair " ++ bytesExpr [0,0]
   ++ " (pair " ++ bytesExpr [0,1]
   ++ " (pair " ++ bytesExpr (u64 offset)
   ++ " (pair " ++ bytesExpr (u64 lengthBytes)
   ++ " " ++ bytesExpr (replicate 32 0)
   ++ ")))))))"
 
 byteListUtilities :: TestTree
 byteListUtilities = testGroup "Byte List Utility Tests"
   [ testCase "isNil: empty list is nil" $ do
       let input = "bytesNil? []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "isNil: non-empty list is not nil" $ do
       let input = "bytesNil? [(1)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "head: empty list is nothing" $ do
       let input = "bytesHead []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "head: non-empty list returns first element" $ do
       let input = "bytesHead [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (byteT 1)
 
   , testCase "tail: empty list is nothing" $ do
       let input = "bytesTail []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= nothingT
 
   , testCase "tail: non-empty list returns rest" $ do
       let input = "bytesTail [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= justT (bytesT [2])
 
   , testCase "length: empty list is zero" $ do
       let input = "bytesLength []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 0
 
   , testCase "length: single element list is one" $ do
       let input = "bytesLength [(1)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 1
 
   , testCase "length: three element list is three" $ do
       let input = "bytesLength [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofNumber 3
 
   , testCase "append: empty ++ [1,2] = [1,2]" $ do
       let input = "bytesAppend [] [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2]
 
   , testCase "append: [1,2] ++ [3] = [1,2,3]" $ do
       let input = "bytesAppend [(1) (2)] [(3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2,3]
 
   , testCase "append: [1,2] ++ empty = [1,2]" $ do
       let input = "bytesAppend [(1) (2)] []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2]
 
   , testCase "take: take 0 any list = empty" $ do
       let input = "bytesTake 0 [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT []
 
   , testCase "take: take 2 [1,2,3] = [1,2]" $ do
       let input = "bytesTake 2 [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2]
 
   , testCase "take: take 5 [1,2] = [1,2] (overlong)" $ do
       let input = "bytesTake 5 [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2]
 
   , testCase "drop: drop 0 any list = list" $ do
       let input = "bytesDrop 0 [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [1,2,3]
 
   , testCase "drop: drop 2 [1,2,3] = [3]" $ do
       let input = "bytesDrop 2 [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [3]
 
   , testCase "drop: drop 5 [1,2] = empty (overlong)" $ do
       let input = "bytesDrop 5 [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT []
 
   , testCase "splitAt: splitAt 0 [1,2] = pair [] [1,2]" $ do
       let input = "bytesSplitAt 0 [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT []) (bytesT [1,2])
 
   , testCase "splitAt: splitAt 2 [1,2,3] = pair [1,2] [3]" $ do
       let input = "bytesSplitAt 2 [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT [1,2]) (bytesT [3])
 
   , testCase "splitAt: splitAt 5 [1,2] = pair [1,2] []" $ do
       let input = "bytesSplitAt 5 [(1) (2)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT [1,2]) (bytesT [])
 
   , testCase "byteEq: equal bytes are equal" $ do
       let input = "equal? 1 1"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "byteEq: unequal bytes are not equal" $ do
       let input = "equal? 1 2"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "bytesEq: empty == empty" $ do
       let input = "bytesEq? [] []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "bytesEq: empty != [1]" $ do
       let input = "bytesEq? [] [(1)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "bytesEq: [1] != empty" $ do
       let input = "bytesEq? [(1)] []"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "bytesEq: equal lists are equal" $ do
       let input = "bytesEq? [(1) (2) (3)] [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
 
   , testCase "bytesEq: different last element" $ do
       let input = "bytesEq? [(1) (2) (3)] [(1) (2) (4)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
 
   , testCase "bytesEq: different lengths" $ do
       let input = "bytesEq? [(1) (2)] [(1) (2) (3)]"
       let env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= falseT
   ]
 
 -- --------------------------------------------------------------------------
 -- Binary parser combinator tests
 -- --------------------------------------------------------------------------
 
 parserOk :: T -> T -> T
 parserOk val rest = Fork trueT (Fork val rest)
 
 parserErr :: T -> T -> T
 parserErr code rest = Fork falseT (Fork code rest)
 
 binaryParserTests :: TestTree
 binaryParserTests = testGroup "Binary Parser Tests"
   [ testCase "pureParser succeeds" $ do
       let input = "pureParser 42 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 42) (bytesT [1, 2])
 
   , testCase "failParser fails" $ do
       let input = "failParser 99 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 99) (bytesT [1, 2])
 
   , testCase "mapParser transforms value" $ do
       let input = "mapParser succ readU8 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 2) (bytesT [2])
 
   , testCase "bindParser chains parsers" $ do
       let input = "bindParser readU8 (x : readU8) [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 2) (bytesT [])
 
   , testCase "thenParser discards first result" $ do
       let input = "thenParser readU8 readU8 [(1) (2)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 2) (bytesT [])
 
   , testCase "orParser tries second on first failure" $ do
       let input = "orParser (failParser 1) readU8 [(5)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 5) (bytesT [])
 
   , testCase "orParser returns first on success" $ do
       let input = "orParser readU8 (failParser 1) [(5)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 5) (bytesT [])
 
   , testCase "readWhile consumes matching bytes" $ do
       let input = "readWhile (x : lt? x 3) [(1) (2) (3) (4)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (bytesT [1, 2]) (bytesT [3, 4])
 
   , testCase "readWhile leaves non-matching byte" $ do
       let input = "bindParser (readWhile (x : lt? x 3)) (x : readU8) [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 3) (bytesT [])
 
   , testCase "readUntil stops at matching byte" $ do
       let input = "readUntil (x : equal? x 3) [(1) (2) (3) (4)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (bytesT [1, 2]) (bytesT [3, 4])
 
   , testCase "readRemaining returns all bytes" $ do
       let input = "readRemaining [(1) (2) (3)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (bytesT [1, 2, 3]) (bytesT [])
 
   , testCase "peekU8 does not consume" $ do
       let input = "bindParser peekU8 (x : readU8) [(7) (8)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofNumber 7) (bytesT [8])
 
   , testCase "peekU8 second read gets same byte" $ do
       let input = "bindParser peekU8 (x : bindParser peekU8 (y : pureParser (pair x y))) [(7)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (pairT (ofNumber 7) (ofNumber 7)) (bytesT [7])
 
   , testCase "eof? succeeds at empty input" $ do
       let input = "eof? []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk Leaf (bytesT [])
 
   , testCase "eof? fails on non-empty input" $ do
       let input = "eof? [(1)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 1) (bytesT [1])
 
   , testCase "expectAscii matches string" $ do
       let input = "expectAscii \"hi\" [(104) (105) (106)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk Leaf (bytesT [106])
 
   , testCase "expectAscii fails on mismatch" $ do
       let input = "expectAscii \"hi\" [(104) (99)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 2) (bytesT [104, 99])
   ]
 
 -- --------------------------------------------------------------------------
 -- IO driver tests
 -- --------------------------------------------------------------------------
 
 ioDriverTests :: TestTree
 ioDriverTests = testGroup "IO driver tests"
   [ -- Existing behaviour tests
     testCase "readFile through onReadFile returns file contents" $
       withSystemTempDirectory "tricu-io-read" $ \dir -> do
         let sourcePath = dir ++ "/input.txt"
         writeFile sourcePath "abc123"
         final <- runIOSource $
           unlines
             [ "main = io (onReadFile \"" ++ sourcePath ++ "\""
             , "  (err rest : pure \"read failed\")"
             , "  (contents rest : pure contents))"
             ]
         final @?= ofString "abc123"
 
   , testCase "readFile error path returns explicit error branch" $
       withSystemTempDirectory "tricu-io-read-missing" $ \dir -> do
         let sourcePath = dir ++ "/missing.txt"
         final <- runIOSource $
           unlines
             [ "main = io (onReadFile \"" ++ sourcePath ++ "\""
             , "  (err rest : pure \"read failed\")"
             , "  (contents rest : pure contents))"
             ]
         final @?= ofString "read failed"
 
   , testCase "chains multiple readFile actions through Result-aware helper" $
       withSystemTempDirectory "tricu-io-chain" $ \dir -> do
         let firstPath = dir ++ "/first.txt"
             secondPath = dir ++ "/second.txt"
         writeFile firstPath "abc"
         writeFile secondPath "def"
         final <- runIOSource $
           unlines
             [ "main = io (onReadFile \"" ++ firstPath ++ "\""
             , "  (err rest : pure \"first read failed\")"
             , "  (first rest : onReadFile \"" ++ secondPath ++ "\""
             , "    (err rest : pure \"second read failed\")"
             , "    (second rest : pure (append first second))))"
             ]
         final @?= ofString "abcdef"
 
     -- Monad law tests
   , testCase "left identity: bind (pure x) f == f x" $ do
       left <- runIOSource $
         unlines
           [ "f = x : pure (append x \"!\")"
           , "main = io (bind (pure \"abc\") f)"
           ]
       right <- runIOSource $
         unlines
           [ "f = x : pure (append x \"!\")"
           , "main = io (f \"abc\")"
           ]
       left @?= right
       left @?= ofString "abc!"
 
   , testCase "right identity: bind m pure == m" $
       withSystemTempDirectory "tricu-io-right-id" $ \dir -> do
         let path = dir ++ "/input.txt"
         writeFile path "abc"
         left <- runIOSource $
           unlines
             [ "main = io (bind (readFile \"" ++ path ++ "\")"
             , "  (result : pure result))"
             ]
         right <- runIOSource $
           unlines
             [ "main = io (readFile \"" ++ path ++ "\")"
             ]
         left @?= right
         left @?= ioOkResult (ofString "abc")
 
   , testCase "associativity: bind (bind m f) g == bind m (x : bind (f x) g)" $
       withSystemTempDirectory "tricu-io-assoc" $ \dir -> do
         let path = dir ++ "/input.txt"
         writeFile path "abc"
         left <- runIOSource $
           unlines
             [ "m = readFile \"" ++ path ++ "\""
             , "f = result : matchResult (err rest : pure \"read failed\") (contents rest : pure (append contents \"-f\")) result"
             , "g = value : pure (append value \"-g\")"
             , "main = io (bind (bind m f) g)"
             ]
         right <- runIOSource $
           unlines
             [ "m = readFile \"" ++ path ++ "\""
             , "f = result : matchResult (err rest : pure \"read failed\") (contents rest : pure (append contents \"-f\")) result"
             , "g = value : pure (append value \"-g\")"
             , "main = io (bind m (x : bind (f x) g))"
             ]
         left @?= right
         left @?= ofString "abc-f-g"
 
   , testCase "associativity preserves error flow" $
       withSystemTempDirectory "tricu-io-assoc-err" $ \dir -> do
         let missingPath = dir ++ "/missing.txt"
         left <- runIOSource $
           unlines
             [ "m = readFile \"" ++ missingPath ++ "\""
             , "f = result : matchResult (err rest : pure \"handled\") (contents rest : pure (append contents \"-ok\")) result"
             , "g = value : pure (append value \"-g\")"
             , "main = io (bind (bind m f) g)"
             ]
         right <- runIOSource $
           unlines
             [ "m = readFile \"" ++ missingPath ++ "\""
             , "f = result : matchResult (err rest : pure \"handled\") (contents rest : pure (append contents \"-ok\")) result"
             , "g = value : pure (append value \"-g\")"
             , "main = io (bind m (x : bind (f x) g))"
             ]
         left @?= right
         left @?= ofString "handled-g"
 
   , testCase "bind defers continuation until left action completes" $
       withSystemTempDirectory "tricu-io-lazy-k" $ \dir -> do
         let path = dir ++ "/created.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bind (writeFile \"" ++ path ++ "\" \"created\")"
             , "  (_ : readFile \"" ++ path ++ "\"))"
             ]
         final @?= ioOkResult (ofString "created")
 
     -- Primitive effect shape tests
   , testCase "readFile without continuation returns Result" $
       withSystemTempDirectory "tricu-io-raw-read" $ \dir -> do
         let path = dir ++ "/input.txt"
         writeFile path "abc"
         final <- runIOSource $
           unlines
             [ "main = io (readFile \"" ++ path ++ "\")"
             ]
         final @?= ioOkResult (ofString "abc")
 
   , testCase "writeFile then readFile executes exactly once" $
       withSystemTempDirectory "tricu-io-once" $ \dir -> do
         let path = dir ++ "/test.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bind (writeFile \"" ++ path ++ "\" \"abc\")"
             , "  (_ : readFile \"" ++ path ++ "\"))"
             ]
         final @?= ioOkResult (ofString "abc")
 
   , testCase "sequencing order is left-to-right" $
       withSystemTempDirectory "tricu-io-order" $ \dir -> do
         let path = dir ++ "/test.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bind (writeFile \"" ++ path ++ "\" \"a\")"
             , "  (_ : bind (writeFile \"" ++ path ++ "\" \"ab\")"
             , "    (_ : readFile \"" ++ path ++ "\")))"
             ]
         final @?= ioOkResult (ofString "ab")
 
   , testCase "thenIO sequences two actions and discards first result" $
       withSystemTempDirectory "tricu-io-then" $ \dir -> do
         let path = dir ++ "/test.txt"
         final <- runIOSource $
           unlines
             [ "main = io (thenIO (writeFile \"" ++ path ++ "\" \"x\")"
             , "  (readFile \"" ++ path ++ "\"))"
             ]
         final @?= ioOkResult (ofString "x")
 
   , testCase "bind does not short-circuit on readFile error" $
       withSystemTempDirectory "tricu-io-no-short" $ \dir -> do
         let path = dir ++ "/missing.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bind (readFile \"" ++ path ++ "\")"
             , "  (result : pure \"continued\"))"
             ]
         final @?= ofString "continued"
 
   , testCase "mapIO transforms pure value" $ do
       final <- runIOSource $
         unlines
           [ "main = io (mapIO (pure \"abc\") (x : append x \"!\"))"
           ]
       final @?= ofString "abc!"
 
     -- Malformed action tests
   , testCase "unknown IO action tag returns err result" $ do
       final <- runIOSource "main = io (pair 99 t)"
       final @?= ioErrResult "invalid action"
 
   , testCase "malformed Bind returns err result" $ do
       final <- runIOSource "main = io (pair 1 t)"
       final @?= ioErrResult "invalid action"
 
   , testCase "malformed ReadFile payload returns err result" $ do
       final <- runIOSource "main = io (readFile (t t))"
       final @?= ioErrResult "invalid string"
 
     -- Permission tests
   , testCase "allowed read path succeeds" $
       withSystemTempDirectory "tricu-io-allowed" $ \dir -> do
         let path = dir ++ "/allowed.txt"
         writeFile path "allowed"
         let perms = defaultPerms { allowRead = [path] }
         result <- runIOSourceWithPerms perms $
           unlines
             [ "main = io (readFile \"" ++ path ++ "\")"
             ]
         result @?= ioOkResult (ofString "allowed")
 
   , testCase "readFile denied path returns err result" $
       withSystemTempDirectory "tricu-io-read-denied" $ \dir -> do
         let allowedPath = dir ++ "/allowed.txt"
             deniedPath = dir ++ "/denied.txt"
         writeFile allowedPath "allowed"
         writeFile deniedPath "denied"
         let perms = defaultPerms { allowRead = [allowedPath] }
         result <- runIOSourceWithPerms perms $
           unlines
             [ "main = io (readFile \"" ++ deniedPath ++ "\")"
             ]
         result @?= ioErrResult "permission denied"
 
   , testCase "writeFile denied path returns err result" $
       withSystemTempDirectory "tricu-io-write-denied" $ \dir -> do
         let allowedPath = dir ++ "/allowed.txt"
             deniedPath = dir ++ "/denied.txt"
         let perms = defaultPerms { allowWrite = [allowedPath] }
         result <- runIOSourceWithPerms perms $
           unlines
             [ "main = io (writeFile \"" ++ deniedPath ++ "\" \"x\")"
             ]
         result @?= ioErrResult "permission denied"
 
   , testCase "path prefix does not allow prefix bypass" $
       withSystemTempDirectory "tricu-io-prefix" $ \dir -> do
         let allowedDir = dir ++ "/foo"
             bypassPath = dir ++ "/foobar/secret.txt"
         createDirectory allowedDir
         createDirectory (dir ++ "/foobar")
         writeFile bypassPath "secret"
         let perms = defaultPerms { allowRead = [allowedDir] }
         result <- runIOSourceWithPerms perms $
           unlines
             [ "main = io (readFile \"" ++ bypassPath ++ "\")"
             ]
         result @?= ioErrResult "permission denied"
 
     -- Pure test
   , testCase "pure performs no effects" $ do
       final <- runIOSource "main = io (pure \"abc\")"
       final @?= ofString "abc"
 
     -- Reader tests
   , testCase "ask returns initial environment" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "dev") $
         unlines
           [ "main = io (bind ask (env : pure env))"
           ]
       final @?= ofString "dev"
 
   , testCase "local transforms environment" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (local (env : append env \"-local\") (bind ask (env : pure env)))"
           ]
       final @?= ofString "root-local"
 
   , testCase "local restores environment afterward" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (bind ask (before :"
           , "  bind (local (env : append env \"-local\") (bind ask (env : pure env))) (inside :"
           , "  bind ask (after :"
           , "  pure (pair before (pair inside after))))))"
           ]
       final @?= Fork (ofString "root") (Fork (ofString "root-local") (ofString "root"))
 
   , testCase "nested local composes correctly" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "f = x : append x \"-f\""
           , "g = x : append x \"-g\""
           , "main = io (bind"
           , "  (local f (local g (bind ask (env : pure env))))"
           , "  (inner :"
           , "  bind ask (after :"
           , "  pure (pair inner after))))"
           ]
       final @?= Fork (ofString "root-f-g") (ofString "root")
 
   , testCase "local result passes through bind correctly" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (bind"
           , "  (local (env : append env \"-local\") (pure \"value\"))"
           , "  (x : pure x))"
           ]
       final @?= ofString "value"
 
   , testCase "IO inside local uses transformed environment and restores after" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (bind"
           , "  (local (env : append env \"-local\")"
           , "    (bind ask (env : pure env)))"
           , "  (result :"
           , "  bind ask (after :"
           , "  pure (pair result after))))"
           ]
       final @?= Fork (ofString "root-local") (ofString "root")
 
   , testCase "local does not affect outer bind continuation" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (bind"
           , "  (local (env : append env \"-local\") (pure \"x\"))"
           , "  (_ : bind ask (env : pure env)))"
           ]
       final @?= ofString "root"
 
   , testCase "local environment persists across inner binds" $ do
       final <- runIOSourceWithEnv unsafePerms (ofString "root") $
         unlines
           [ "main = io (local (env : append env \"-local\")"
           , "  (bind (pure t) (_ :"
           , "  bind ask (env : pure env))))"
           ]
       final @?= ofString "root-local"
 
   , testCase "local restores environment when scoped action returns error value" $ do
       final <- runIOSourceWithEnv defaultPerms (ofString "root") $
         unlines
           [ "main = io (bind"
           , "  (local (env : append env \"-local\") (readFile \"definitely-missing.txt\"))"
           , "  (_ : bind ask (env : pure env)))"
           ]
       final @?= ofString "root"
 
     -- State tests
   , testCase "get returns initial state" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf (ofNumber 42) $
         unlines
           [ "main = io (bind get (s : pure s))"
           ]
       final @?= ofNumber 42
       st @?= ofNumber 42
 
   , testCase "put updates state" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf (ofNumber 0) $
         unlines
           [ "main = io (bind (put 100) (_ : bind get (s : pure s)))"
           ]
       final @?= ofNumber 100
       st @?= ofNumber 100
 
   , testCase "state persists through bind" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf (ofNumber 5) $
         unlines
           [ "main = io (bind get (s1 :"
           , "  bind (put (succ s1)) (_ :"
           , "  bind get (s2 :"
           , "  pure (pair s1 s2)))))"
           ]
       final @?= Fork (ofNumber 5) (ofNumber 6)
       st @?= ofNumber 6
 
   , testCase "local does not restore state" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf (ofNumber 0) $
         unlines
           [ "main = io (bind (put 10) (_ :"
           , "  bind (local (env : env) (put 20)) (_ :"
           , "  bind get (s :"
           , "  pure s))))"
           ]
       final @?= ofNumber 20
       st @?= ofNumber 20
 
   , testCase "state and reader are independent" $ do
       (final, st) <- runIOSourceWith unsafePerms (ofString "hello") (ofNumber 42) $
         unlines
           [ "main = io (bind ask (env :"
           , "  bind get (s :"
           , "  pure (pair env s))))"
           ]
       final @?= Fork (ofString "hello") (ofNumber 42)
       st @?= ofNumber 42
 
     -- Async tests
   , testCase "fork returns handle and await returns child value" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (pure \"child\")) (h :"
           , "  await h))"
           ]
       final @?= ofString "child"
       st @?= Leaf
 
   , testCase "main completion abandons unawaited child" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (pure \"child\")) (_ :"
           , "  pure \"main\"))"
           ]
       final @?= ofString "main"
 
   , testCase "fork captures reader environment at fork point" $ do
       (final, _) <- runIOSourceWith unsafePerms (ofString "root") Leaf $
         unlines
           [ "main = io (local (env : append env \"-local\")"
           , "  (bind (fork (bind ask (env : pure env))) (h :"
           , "  await h)))"
           ]
       final @?= ofString "root-local"
 
   , testCase "fork inside local captures child env and parent restores env" $ do
       (final, _) <- runIOSourceWith unsafePerms (ofString "root") Leaf $
         unlines
           [ "main = io (bind"
           , "  (local (env : append env \"-local\")"
           , "    (fork (bind ask (env : pure env))))"
           , "  (h : bind ask (after :"
           , "  bind (await h) (child :"
           , "  pure (pair after child)))))"
           ]
       final @?= Fork (ofString "root") (ofString "root-local")
 
   , testCase "fork copies state and child state does not merge" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf (ofNumber 0) $
         unlines
           [ "main = io (bind (put 1) (_ :"
           , "  bind (fork (bind (put 99) (_ : bind get (s : pure s)))) (h :"
           , "  bind (put 2) (_ :"
           , "  bind (await h) (childState :"
           , "  bind get (parentState :"
           , "  pure (pair childState parentState)))))))"
           ]
       final @?= Fork (ofNumber 99) (ofNumber 2)
       st @?= ofNumber 2
 
   , testCase "multiple awaiters receive same completed value" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (pure \"done\")) (h :"
           , "  bind (await h) (a :"
           , "  bind (await h) (b :"
           , "  pure (pair a b)))))"
           ]
       final @?= Fork (ofString "done") (ofString "done")
 
   , testCase "self await returns async error" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (await (pair \"task\" 0))"
           ]
       final @?= ioErrResult "self await"
 
   , testCase "await invalid handle returns async error" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (await 123)"
           ]
       final @?= ioErrResult "invalid task handle"
 
   , testCase "yield returns unit and resumes continuation" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind yield (_ : pure \"after\"))"
           ]
       final @?= ofString "after"
 
   , testCase "sleep resumes continuation" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (sleep 1) (_ : pure \"awake\"))"
           ]
       final @?= ofString "awake"
 
   , testCase "await waits for sleeping child" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (bind (sleep 1) (_ : pure \"awake\"))) (h :"
           , "  await h))"
           ]
       final @?= ofString "awake"
 
   , testCase "await waits for sleeping child and returns child value" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (bind (sleep 1) (_ : pure \"child done\"))) (h :"
           , "  await h))"
           ]
       final @?= ofString "child done"
       st @?= Leaf
 
   , testCase "sleep inside bind resumes as unit" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (sleep 1) (_ : pure \"awake\"))"
           ]
       final @?= ofString "awake"
       st @?= Leaf
 
   , testCase "fork await returns child value" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (pure \"child done\")) (h :"
           , "  await h))"
           ]
       final @?= ofString "child done"
       st @?= Leaf
 
   -- Scheduler hardening tests
   , testCase "runIO rejects non-IO tree with sentinel error" $ do
       result <- runIO unsafePerms (ofString "not an io program")
       case result of
         Left _  -> return ()
         Right _ -> assertFailure "Expected Left for invalid sentinel"
 
   , testCase "cyclic await returns error instead of hanging" $ do
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "main = io (bind (fork (await (pair \"task\" 0))) (h :"
           , "  await h))"
           ]
       final @?= ioErrResult "cyclic await"
 
   , testCase "writeBytes and readFile roundtrip binary data" $
       withSystemTempDirectory "tricu-io-bytes" $ \dir -> do
         let path = dir ++ "/binary.bin"
         final <- runIOSource $
           unlines
             [ "main = io (bind (writeBytes \"" ++ path ++ "\" [(0) (255) (128) (1)])"
             , "  (_ : readFile \"" ++ path ++ "\"))"
             ]
         final @?= ioOkResult (ofBytes (BS.pack [0, 255, 128, 1]))
 
   , testCase "stress test: many concurrent sleepers complete promptly" $ do
       let n = 5000
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
         unlines
           [ "spawner = y (self n acc : if (equal? n 0) (pure acc) (bind (fork (sleep 1)) (h : self (pred n) (pair h acc))))"
           , "awaitAll = y (self hs : matchList (pure \"done\") (h r : bind (await h) (_ : self r)) hs)"
           , "main = io (bind (spawner " ++ show n ++ " t) (hs : awaitAll hs))"
           ]
       final @?= ofString "done"
 
   , testCase "long fork await loop does not leak" $ do
       let n = 200
           build 0 = "pure \"done\""
           build k = "bind (fork (pure \"x\")) (h : bind (await h) (_ : " ++ build (k - 1) ++ "))"
       (final, _) <- runIOSourceWith unsafePerms Leaf Leaf ("main = io (" ++ build n ++ ")")
       final @?= ofString "done"
 
   , testGroup "Socket primitives"
     [ testCase "socket returns ok result with valid handle" $ do
         final <- runIOSource "main = io socket"
         final @?= ioOkResult (Fork (ofString "sock") (ofNumber 0))
 
     , testCase "closeSocket on invalid handle returns error" $ do
         final <- runIOSource "main = io (closeSocket (pair \"sock\" 99999))"
         final @?= ioErrResult "invalid socket handle"
 
     , testCase "bindSocket and listen succeed on loopback port 0" $ do
         final <- runIOSource $
           unlines
             [ "main = io ("
             , "  onOk socket (server rest :"
             , "    onOk (bindSocket server \"127.0.0.1\" 0) (_ rest :"
             , "      bind (listen server 1) (listenResult :"
             , "        pure listenResult))))"
             ]
         final @?= ioOkResult Leaf
 
     , testCase "connect to non-listening port returns error" $ do
         final <- runIOSource "main = io (onOk socket (sock rest : connect sock \"127.0.0.1\" 1))"
         case final of
           Fork Leaf (Fork _ Leaf) -> return ()
           other -> assertFailure $ "Expected error result, got: " ++ show other
 
     , testCase "accept and recv receive bytes from forked client" $
         withFreePort $ \port -> do
           final <- runIOSource $
             unlines
               [ "client = port :"
               , "  onOk socket (sock rest :"
               , "    onOk (connect sock \"127.0.0.1\" port) (_ rest :"
               , "      send sock [104 105]))"
               , ""
               , "main = io ("
               , "  onOk socket (server rest :"
               , "    onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
               , "      onOk (listen server 1) (_ rest :"
               , "        bind (fork (client " ++ show port ++ ")) (_ :"
               , "          onOk (accept server) (accepted rest :"
               , "            recv (fst accepted) 2))))))"
               ]
           final @?= ioOkResult (ofBytes (BS.pack [104, 105]))
 
     , testCase "client recv receives server response via accepted socket" $
         withFreePort $ \port -> do
           final <- runIOSource $
             unlines
               [ "serverTask = (server :"
               , "  onOk (accept server) (accepted rest :"
               , "    onOk (recv (fst accepted) 4) (msg rest :"
               , "      send (fst accepted) [112 111 110 103])))"
               , ""
               , "clientTask = (port :"
               , "  onOk socket (sock rest :"
               , "    onOk (connect sock \"127.0.0.1\" port) (_ rest :"
               , "      bind (send sock [112 105 110 103]) (_ :"
               , "        recv sock 4))))"
               , ""
               , "main = io ("
               , "  onOk socket (server rest :"
               , "    onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
               , "      onOk (listen server 1) (_ rest :"
               , "        bind (fork (serverTask server)) (_ :"
               , "          clientTask " ++ show port ++ ")))))"
               ]
           final @?= ioOkResult (ofBytes (BS.pack [112, 111, 110, 103]))
 
     , testCase "recv on closed peer returns connection closed" $
         withFreePort $ \port -> do
           final <- runIOSource $
             unlines
               [ "clientTask = port :"
               , "  onOk socket (sock rest :"
               , "    onOk (connect sock \"127.0.0.1\" port) (_ rest :"
               , "      closeSocket sock))"
               , ""
               , "main = io ("
               , "  onOk socket (server rest :"
               , "    onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
               , "      onOk (listen server 1) (_ rest :"
               , "        bind (fork (clientTask " ++ show port ++ ")) (_ :"
               , "          onOk (accept server) (accepted rest :"
               , "            bind (yield) (_ :"
               , "              recv (fst accepted) 1)))))))"
               ]
           final @?= ioErrResult "connection closed"
 
     , testCase "accept invalid socket handle returns error" $ do
         final <- runIOSource "main = io (accept (pair \"sock\" 99999))"
         final @?= ioErrResult "invalid socket handle"
 
     , testCase "recv invalid socket handle returns error" $ do
         final <- runIOSource "main = io (recv (pair \"sock\" 99999) 1)"
         final @?= ioErrResult "invalid socket handle"
 
     , testCase "send invalid socket handle returns error" $ do
         final <- runIOSource "main = io (send (pair \"sock\" 99999) [(1)])"
         final @?= ioErrResult "invalid socket handle"
 
     , testCase "getSocketName returns positive port after bind 0" $ do
         final <- runIOSource $
           unlines
             [ "main = io ("
             , "  onOk socket (server rest :"
             , "    onOk (bindSocket server \"127.0.0.1\" 0) (_ rest :"
             , "      bind (getSocketName server) (nameResult :"
             , "        pure nameResult))))"
             ]
         case final of
           Fork (Stem Leaf) (Fork val Leaf) ->
             case toNumber val of
               Right port | port > 0 -> return ()
               Right 0 -> assertFailure "Expected positive port, got 0"
               Left _  -> assertFailure $ "Expected numeric port, got: " ++ show val
           other -> assertFailure $ "Expected ok result, got: " ++ show other
 
     , testCase "connectTo creates connected socket" $
         withFreePort $ \port -> do
           final <- runIOSource $
             unlines
               [ "clientTask = port :"
               , "  onOk (connectTo \"127.0.0.1\" port) (client rest :"
               , "    onOk (send client [104 105]) (_ rest :"
               , "      pure t))"
               , ""
               , "main = io ("
               , "  onOk socket (server rest :"
               , "    onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
               , "      onOk (listen server 1) (_ rest :"
               , "        bind (fork (clientTask " ++ show port ++ ")) (_ :"
               , "          onOk (accept server) (accepted rest :"
               , "            onOk (recv (fst accepted) 2) (msg rest :"
               , "              pure msg)))))))"
               ]
           final @?= ofBytes (BS.pack [104, 105])
 
     , testCase "serveOnce handles a single client connection" $
         withFreePort $ \port -> do
           final <- runIOSource $
             unlines
               [ "echoHandler = (client peer :"
               , "  onOk (recv client 2) (msg rest :"
               , "    onOk (send client msg) (_ rest :"
               , "      pure t)))"
               , ""
               , "clientTask = (port :"
               , "  onOk socket (sock rest :"
               , "    onOk (connect sock \"127.0.0.1\" port) (_ rest :"
               , "      onOk (send sock [104 105]) (_ rest :"
               , "        onOk (recv sock 2) (msg rest :"
               , "          pure msg)))))"
               , ""
               , "main = io ("
               , "  onOk socket (server rest :"
               , "    onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
               , "      onOk (listen server 1) (_ rest :"
               , "        bind (fork (serveOnce server echoHandler)) (_ :"
               , "          clientTask " ++ show port ++ ")))))"
               ]
           final @?= ofBytes (BS.pack [104, 105])
 
   , testCase "finally preserves successful action result" $ do
       final <- runIOSource $
         unlines
           [ "main = io (finally (pure 42) (pure 99))"
           ]
       final @?= ofNumber 42
 
   , testCase "finally runs cleanup after successful action" $
       withSystemTempDirectory "tricu-finally" $ \dir -> do
         let cleanupPath = dir ++ "/cleanup.txt"
         final <- runIOSource $
           unlines
             [ "main = io (finally"
             , "  (pure 42)"
             , "  (writeFile \"" ++ cleanupPath ++ "\" \"cleaned\"))"
             ]
         final @?= ofNumber 42
         contents <- readFile cleanupPath
         contents @?= "cleaned"
 
   , testCase "bracket passes acquired resource to use" $ do
       final <- runIOSource $
         unlines
           [ "main = io (bracket (pure 41) (_ : pure t) (r : pure (succ r)))"
           ]
       final @?= ofNumber 42
 
   , testCase "bracket preserves successful use result over release result" $ do
       final <- runIOSource $
         unlines
           [ "main = io (bracket (pure \"res\") (_ : pure 123) (_ : pure 99))"
           ]
       final @?= ofNumber 99
 
   , testCase "bracket runs release on successful use" $
       withSystemTempDirectory "tricu-bracket" $ \dir -> do
         let releasePath = dir ++ "/release.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bracket"
             , "  (pure \"" ++ releasePath ++ "\")"
             , "  (path : writeFile path \"released\")"
             , "  (path : pure 99))"
             ]
         final @?= ofNumber 99
         contents <- readFile releasePath
         contents @?= "released"
 
   , testCase "bracket passes acquired resource to release" $
       withSystemTempDirectory "tricu-bracket-release-resource" $ \dir -> do
         let releasePath = dir ++ "/release.txt"
         final <- runIOSource $
           unlines
             [ "main = io (bracket"
             , "  (pure \"" ++ releasePath ++ "\")"
             , "  (path : writeFile path \"released\")"
             , "  (_ : pure 99))"
             ]
         final @?= ofNumber 99
         contents <- readFile releasePath
         contents @?= "released"
 
     -- Directory and file management primitives
   , testGroup "listDirectory"
     [ testCase "listDirectory returns entry names" $
         withSystemTempDirectory "tricu-listdir" $ \dir -> do
           writeFile (dir ++ "/a.txt") "a"
           writeFile (dir ++ "/b.txt") "b"
           final <- runIOSource $
             unlines
               [ "main = io (onListDirectory \"" ++ dir ++ "\""
               , "  (err rest : pure false)"
               , "  (entries rest :"
               , "    pure (pair (lExist? \"a.txt\" entries) (lExist? \"b.txt\" entries))))"
               ]
           final @?= Fork (Stem Leaf) (Stem Leaf)
 
     , testCase "listDirectory missing path returns does not exist" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onListDirectory \"/nonexistent/path/12345\""
             , "  (err rest : pure err)"
             , "  (_ rest : pure \"ok\"))"
             ]
         final @?= ofString "does not exist"
 
     , testCase "listDirectory on file returns not a directory" $
         withSystemTempDirectory "tricu-listdir-file" $ \dir -> do
           let path = dir ++ "/file.txt"
           writeFile path "x"
           final <- runIOSource $
             unlines
               [ "main = io (onListDirectory \"" ++ path ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "not a directory"
 
     , testCase "listDirectory denied path returns permission denied" $
         withSystemTempDirectory "tricu-listdir-denied" $ \dir -> do
           let allowedDir = dir ++ "/allowed"
               deniedDir = dir ++ "/denied"
           createDirectory allowedDir
           createDirectory deniedDir
           let perms = defaultPerms { allowRead = [allowedDir] }
           final <- runIOSourceWithPerms perms $
             unlines
               [ "main = io (listDirectory \"" ++ deniedDir ++ "\")"
               ]
           final @?= ioErrResult "permission denied"
     ]
 
     , testCase "listDirectory excludes dot entries" $
        withSystemTempDirectory "tricu-listdir-dot" $ \dir -> do
          final <- runIOSource $
            unlines
              [ "main = io (onListDirectory \"" ++ dir ++ "\""
              , "  (err rest : pure false)"
              , "  (entries rest :"
              , "    pure (pair (lExist? \".\" entries) (lExist? \"..\" entries))))"
              ]
          final @?= Fork Leaf Leaf
 
   , testGroup "renameFile"
     [ testCase "renameFile moves file atomically" $
         withSystemTempDirectory "tricu-rename" $ \dir -> do
           let oldPath = dir ++ "/old.txt"
               newPath = dir ++ "/new.txt"
           writeFile oldPath "contents"
           final <- runIOSource $
             unlines
               [ "main = io (onRenameFile \"" ++ oldPath ++ "\" \"" ++ newPath ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "ok"
           newExists <- doesFileExist newPath
           oldExists <- doesFileExist oldPath
           newExists @?= True
           oldExists @?= False
 
     , testCase "renameFile missing source returns does not exist" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onRenameFile \"/nonexistent/old.txt\" \"/nonexistent/new.txt\""
             , "  (err rest : pure err)"
             , "  (_ rest : pure \"ok\"))"
             ]
         final @?= ofString "does not exist"
 
     , testCase "renameFile denied destination returns permission denied" $
         withSystemTempDirectory "tricu-rename-denied" $ \dir -> do
           let allowedDir = dir ++ "/allowed"
               deniedDir = dir ++ "/denied"
           createDirectory allowedDir
           createDirectory deniedDir
           let oldPath = allowedDir ++ "/old.txt"
               newPath = deniedDir ++ "/new.txt"
           writeFile oldPath "contents"
           let perms = defaultPerms { allowWrite = [allowedDir] }
           final <- runIOSourceWithPerms perms $
             unlines
               [ "main = io (renameFile \"" ++ oldPath ++ "\" \"" ++ newPath ++ "\")"
               ]
           final @?= ioErrResult "permission denied"
 
     , testCase "renameFile replaces existing destination atomically" $
       withSystemTempDirectory "tricu-rename-replace" $ \dir -> do
         let oldPath = dir ++ "/old.txt"
             newPath = dir ++ "/new.txt"
         writeFile oldPath "new"
         writeFile newPath "old"
         final <- runIOSource $
           unlines
             [ "main = io (onRenameFile \"" ++ oldPath ++ "\" \"" ++ newPath ++ "\""
             , "  (err rest : pure err)"
             , "  (_ rest : pure \"ok\"))"
             ]
         final @?= ofString "ok"
         readFile newPath >>= (@?= "new")
         oldExists <- doesFileExist oldPath
         oldExists @?= False
     ]
 
   , testGroup "createDirectory"
     [ testCase "createDirectory creates new directory" $
         withSystemTempDirectory "tricu-mkdir" $ \dir -> do
           let newDir = dir ++ "/subdir"
           final <- runIOSource $
             unlines
               [ "main = io (onCreateDirectory \"" ++ newDir ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "ok"
           exists <- doesDirectoryExist newDir
           exists @?= True
 
     , testCase "createDirectory is idempotent for existing directory" $
         withSystemTempDirectory "tricu-mkdir-idempotent" $ \dir -> do
           let existingDir = dir ++ "/exists"
           createDirectory existingDir
           final <- runIOSource $
             unlines
               [ "main = io (onCreateDirectory \"" ++ existingDir ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "ok"
 
     , testCase "createDirectory on existing file returns already exists" $
         withSystemTempDirectory "tricu-mkdir-file" $ \dir -> do
           let path = dir ++ "/file.txt"
           writeFile path "x"
           final <- runIOSource $
             unlines
               [ "main = io (onCreateDirectory \"" ++ path ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "already exists"
 
     , testCase "createDirectory missing parent returns does not exist" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onCreateDirectory \"/nonexistent/path/12345/sub\""
             , "  (err rest : pure err)"
             , "  (_ rest : pure \"ok\"))"
             ]
         final @?= ofString "does not exist"
 
     , testCase "createDirectory denied path returns permission denied" $
         withSystemTempDirectory "tricu-mkdir-denied" $ \dir -> do
           let allowedDir = dir ++ "/allowed"
               deniedDir = dir ++ "/denied"
           createDirectory allowedDir
           createDirectory deniedDir
           let perms = defaultPerms { allowWrite = [allowedDir] }
           final <- runIOSourceWithPerms perms $
             unlines
               [ "main = io (createDirectory \"" ++ deniedDir ++ "/new\")"
               ]
           final @?= ioErrResult "permission denied"
     , testCase "createDirectory with file parent returns not a directory or does not exist" $
         withSystemTempDirectory "tricu-mkdir-file-parent" $ \dir -> do
           let parentFile = dir ++ "/file"
               child = parentFile ++ "/sub"
           writeFile parentFile "x"
           final <- runIOSource $
             unlines
               [ "main = io (onCreateDirectory \"" ++ child ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "not a directory"
     ]
 
   , testGroup "deleteFile"
     [ testCase "deleteFile removes file" $
         withSystemTempDirectory "tricu-delete" $ \dir -> do
           let path = dir ++ "/del.txt"
           writeFile path "x"
           final <- runIOSource $
             unlines
               [ "main = io (onDeleteFile \"" ++ path ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "ok"
           exists <- doesFileExist path
           exists @?= False
 
     , testCase "deleteFile is idempotent for missing file" $ do
         final <- runIOSource $
           unlines
               [ "main = io (onDeleteFile \"/nonexistent/path/12345.txt\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
         final @?= ofString "ok"
 
     , testCase "deleteFile on directory returns is a directory" $
         withSystemTempDirectory "tricu-delete-dir" $ \dir -> do
           let subDir = dir ++ "/subdir"
           createDirectory subDir
           final <- runIOSource $
             unlines
               [ "main = io (onDeleteFile \"" ++ subDir ++ "\""
               , "  (err rest : pure err)"
               , "  (_ rest : pure \"ok\"))"
               ]
           final @?= ofString "is a directory"
 
     , testCase "deleteFile denied path returns permission denied" $
         withSystemTempDirectory "tricu-delete-denied" $ \dir -> do
           let allowedDir = dir ++ "/allowed"
               deniedDir = dir ++ "/denied"
           createDirectory allowedDir
           createDirectory deniedDir
           let path = deniedDir ++ "/file.txt"
           writeFile path "x"
           let perms = defaultPerms { allowWrite = [allowedDir] }
           final <- runIOSourceWithPerms perms $
             unlines
               [ "main = io (deleteFile \"" ++ path ++ "\")"
               ]
           final @?= ioErrResult "permission denied"
     ]
 
   , testGroup "fileExists"
     [ testCase "fileExists true for existing file" $
         withSystemTempDirectory "tricu-exists" $ \dir -> do
           let path = dir ++ "/file.txt"
           writeFile path "x"
           final <- runIOSource $
             unlines
               [ "main = io (onFileExists \"" ++ path ++ "\""
               , "  (err rest : pure err)"
               , "  (exists rest : pure exists))"
               ]
           final @?= Stem Leaf
 
     , testCase "fileExists false for missing path" $ do
         final <- runIOSource $
           unlines
               [ "main = io (onFileExists \"/nonexistent/path/12345.txt\""
               , "  (err rest : pure err)"
               , "  (exists rest : pure exists))"
               ]
         final @?= Leaf
 
     , testCase "fileExists denied path returns permission denied" $
         withSystemTempDirectory "tricu-exists-denied" $ \dir -> do
           let allowedDir = dir ++ "/allowed"
               deniedDir = dir ++ "/denied"
           createDirectory allowedDir
           createDirectory deniedDir
           let path = deniedDir ++ "/file.txt"
           writeFile path "x"
           let perms = defaultPerms { allowRead = [allowedDir] }
           final <- runIOSourceWithPerms perms $
             unlines
               [ "main = io (fileExists \"" ++ path ++ "\")"
               ]
           final @?= ioErrResult "permission denied"
     ]
 
   , testGroup "sha256Hex"
     [ testCase "sha256Hex returns lowercase hex digest" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onSha256Hex [(104) (105)]"
             , "  (err rest : pure err)"
             , "  (hex rest : pure hex))"
             ]
         final @?= ofString "8f434346648f6b96df89dda901c5176b10a6d83961dd3c1ac88b59b2dc327aa4"
 
     , testCase "sha256Hex empty bytes returns empty digest" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onSha256Hex []"
             , "  (err rest : pure err)"
             , "  (hex rest : pure hex))"
             ]
         final @?= ofString "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
 
     , testCase "sha256Hex hashes raw bytes" $ do
       final <- runIOSource $
         unlines
           [ "main = io (onSha256Hex [(0) (255) (1)]"
           , "  (err rest : pure err)"
           , "  (hex rest : pure hex))"
           ]
       final @?= ofString "47ffa3ea45a70b8a41c2c0825df323c00a8b7a01c1ea06083cc41dddcc001123"
     ]
 
   , testGroup "currentTime"
     [ testCase "currentTime returns a positive integer" $ do
         final <- runIOSource $
           unlines
             [ "main = io (onCurrentTime"
             , "  (err rest : pure 0)"
             , "  (v rest : pure v))"
             ]
         case toNumber final of
           Right n | n > 1600000000 -> return ()  -- after ~Sep 2020
           Right n -> assertFailure $ "Expected recent timestamp, got: " ++ show n
           Left err -> assertFailure $ "Expected number, got error: " ++ err
     ]
     ]
   ]
 
 httpParsingTests :: TestTree
 httpParsingTests = testGroup "HTTP Parsing Tests"
   [
     -- chomp / request-line reader
     testCase "chomp strips trailing CR" $ do
       let input = "chomp [(104) (105) (13)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [104, 105]
 
   , testCase "chomp leaves line without CR" $ do
       let input = "chomp [(104) (105)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT [104, 105]
 
   , testCase "chomp empty list" $ do
       let input = "chomp []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= bytesT []
 
   , testCase "readLineBytes with CRLF" $ do
       let input = "readLineBytes [(104) (105) (13) (10) (120)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT [104, 105]) (bytesT [120])
 
   , testCase "readLineBytes with bare LF" $ do
       let input = "readLineBytes [(104) (105) (10) (120)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT [104, 105]) (bytesT [120])
 
   , testCase "readLineBytes empty line" $ do
       let input = "readLineBytes [(13) (10) (120)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT []) (bytesT [120])
 
   , testCase "readLineBytes EOF mid-line returns line" $ do
       let input = "readLineBytes [(104) (105)]"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= pairT (bytesT [104, 105]) (bytesT [])
 
     -- parseRequestLine
   , testCase "parseRequestLine GET slash" $ do
       let input = "parseRequestLine (append \"GET / HTTP/1.1\\r\\n\" \"x\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk
         (pairT (ofString "GET") (pairT (ofString "/") (ofString "HTTP/1.1")))
         (ofString "x")
 
   , testCase "parseRequestLine POST path" $ do
       let input = "parseRequestLine \"POST /foo/bar HTTP/1.1\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk
         (pairT (ofString "POST") (pairT (ofString "/foo/bar") (ofString "HTTP/1.1")))
         (ofString "")
 
   , testCase "parseRequestLine too short" $ do
       let input = "parseRequestLine \"GET\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
 
   , testCase "parseRequestLine no version" $ do
       let input = "parseRequestLine \"GET /foo\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
 
   , testCase "parseRequestLine empty line" $ do
       let input = "parseRequestLine \"\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
 
   , testCase "parseRequestLine rejects extra fields" $ do
       let input = "parseRequestLine \"GET / HTTP/1.1 wat\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
 
     -- parseHeaders
   , testCase "parseHeaders two headers lowercases names" $ do
       let input = "parseHeaders (append \"Host: localhost\\r\\nContent-Length: 42\\r\\n\\r\\n\" \"x\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk
         (ofList
           [ pairT (ofString "host") (ofString "localhost")
           , pairT (ofString "content-length") (ofString "42")
           ])
         (ofString "x")
 
   , testCase "parseHeaders preserves colon in value" $ do
       let input = "parseHeaders (append \"X-Custom: a: b\\r\\n\\r\\n\" \"x\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk
         (ofList [pairT (ofString "x-custom") (ofString "a: b")])
         (ofString "x")
 
   , testCase "parseHeaders accepts empty value" $ do
       let input = "parseHeaders (append \"X-Empty:\\r\\n\\r\\n\" \"x\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk
         (ofList [pairT (ofString "x-empty") (ofString "")])
         (ofString "x")
 
   , testCase "parseHeaders immediate blank" $ do
       let input = "parseHeaders \"\\r\\nx\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (ofList []) (ofString "x")
 
   , testCase "parseHeaders rejects missing colon" $ do
       let input = "parseHeaders \"Host\\r\\n\\r\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
 
   , testCase "parseContentLengthValue accepts max body bytes" $ do
       let input = "matchResult \"err\" (maybeLen rest : \"ok\") (parseContentLengthValue \"1048576\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "ok"
 
   , testCase "parseContentLengthValue accepts shorter decimal below max" $ do
       let input = "matchResult \"err\" (maybeLen rest : \"ok\") (parseContentLengthValue \"999999\")"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "ok"
 
   , testCase "parseContentLengthValue strips leading zeros before limit check" $ do
       let input = "parseContentLengthValue \"0000000000001\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserOk (justT (ofNumber 1)) Leaf
 
   , testCase "parseContentLengthValue rejects body above max" $ do
       let input = "parseContentLengthValue \"1048577\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 413) (ofString "Request body too large\n")
 
   , testCase "parseContentLengthValue rejects longer body above max" $ do
       let input = "parseContentLengthValue \"2000000\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= parserErr (ofNumber 413) (ofString "Request body too large\n")
 
     -- statusLine / headerLine
   , testCase "statusLine 200 OK" $ do
       let input = "statusLine 200 \"OK\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 200 OK\r\n"
 
   , testCase "headerLine Content-Length" $ do
       let input = "headerLine \"Content-Length\" \"42\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Content-Length: 42\r\n"
 
     -- statusPhrase
   , testCase "statusPhrase 200" $ do
       let input = "statusPhrase 200"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "OK"
 
   , testCase "statusPhrase 201" $ do
       let input = "statusPhrase 201"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Created"
 
   , testCase "statusPhrase 204" $ do
       let input = "statusPhrase 204"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "No Content"
 
   , testCase "statusPhrase 400" $ do
       let input = "statusPhrase 400"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Bad Request"
 
   , testCase "statusPhrase 404" $ do
       let input = "statusPhrase 404"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Not Found"
 
   , testCase "statusPhrase 405" $ do
       let input = "statusPhrase 405"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Method Not Allowed"
 
   , testCase "statusPhrase 431" $ do
       let input = "statusPhrase 431"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Request Header Fields Too Large"
 
   , testCase "statusPhrase 501" $ do
       let input = "statusPhrase 501"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Not Implemented"
 
   , testCase "statusPhrase 505" $ do
       let input = "statusPhrase 505"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP Version Not Supported"
 
   , testCase "statusPhrase 500" $ do
       let input = "statusPhrase 500"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Internal Server Error"
 
   , testCase "statusPhrase unknown" $ do
       let input = "statusPhrase 999"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "Internal Server Error"
 
     -- buildResponse
   , testCase "buildResponse 200 no headers" $ do
       let input = "buildResponse 200 [] \"hi\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 200 OK\r\n\r\nhi"
 
   , testCase "buildResponse 404 with header" $ do
       let input = "buildResponse 404 [(pair \"Content-Length\" \"9\")] \"Not found\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 404 Not Found\r\nContent-Length: 9\r\n\r\nNot found"
 
     -- convenience responses
   , testCase "okResponse" $ do
       let input = "okResponse \"hi\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 200 OK\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 2\r\nConnection: close\r\n\r\nhi"
 
   , testCase "notFoundResponse" $ do
       let input = "notFoundResponse"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 404 Not Found\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 10\r\nConnection: close\r\n\r\nNot found\n"
 
   , testCase "textResponse" $ do
       let input = "textResponse \"hi\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 200 OK\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 2\r\nConnection: close\r\n\r\nhi"
 
   , testCase "jsonResponse" $ do
       let input = "jsonResponse \"{}\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 200 OK\r\nContent-Type: application/json\r\nContent-Length: 2\r\nConnection: close\r\n\r\n{}"
 
   , testCase "createdResponse" $ do
       let input = "createdResponse \"created\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 201 Created\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 8\r\nConnection: close\r\n\r\ncreated\n"
 
   , testCase "emptyResponse 204" $ do
       let input = "emptyResponse 204"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 204 No Content\r\nContent-Length: 0\r\nConnection: close\r\n\r\n"
 
   , testCase "badRequestResponse" $ do
       let input = "badRequestResponse \"Bad Request\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 400 Bad Request\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 12\r\nConnection: close\r\n\r\nBad Request\n"
 
   , testCase "errorResponse 405" $ do
       let input = "errorResponse 405 \"Method Not Allowed\\n\""
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString "HTTP/1.1 405 Method Not Allowed\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 19\r\nConnection: close\r\n\r\nMethod Not Allowed\n"
   ]
 
 containsAll :: String -> [String] -> Assertion
 containsAll text needles =
   forM_ needles $ \needle ->
     assertBool ("expected " ++ show needle ++ " in: " ++ text) (needle `isInfixOf` text)
 
 withFreePort :: (Int -> IO a) -> IO a
 withFreePort action =
   bracket
     (NS.socket NS.AF_INET NS.Stream NS.defaultProtocol)
     NS.close
     (\s -> do
       NS.setSocketOption s NS.ReuseAddr 1
       NS.bind s (NS.SockAddrInet 0 (NS.tupleToHostAddress (127, 0, 0, 1)))
       port <- NS.socketPort s
       action (fromIntegral port))
 
 runIOSourceWith :: IOPermissions -> T -> T -> String -> IO (T, T)
 runIOSourceWith perms readerEnv initialState source = do
   let asts = parseTricu source
       evalEnv = evalTricu allTestLibsEnv asts
       fullTree = mainResult evalEnv
   result <- runIOWith perms readerEnv initialState fullTree
   case result of
     Left err   -> assertFailure ("IO runtime error: " ++ err)
     Right pair -> pure pair
 
 runIOSource :: String -> IO T
 runIOSource source = fmap fst $ runIOSourceWith unsafePerms Leaf Leaf source
 
 runIOSourceWithPerms :: IOPermissions -> String -> IO T
 runIOSourceWithPerms perms source = fmap fst $ runIOSourceWith perms Leaf Leaf source
 
 runIOSourceWithEnv :: IOPermissions -> T -> String -> IO T
 runIOSourceWithEnv perms readerEnv source = fmap fst $ runIOSourceWith perms readerEnv Leaf source
 
 ioOkResult :: T -> T
 ioOkResult val = Fork (Stem Leaf) (Fork val Leaf)
 
 ioErrResult :: String -> T
 ioErrResult msg = Fork Leaf (Fork (ofString msg) Leaf)