module Main where

import Check
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)
import System.FilePath       ((</>))
import Data.Bits              (xor)
import Data.Char              (digitToInt)
import Data.List              (find, isInfixOf)
import Data.Text              (Text, unpack)
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 #-}

viewTestEnv :: Env
viewTestEnv = unsafePerformIO (evaluateFileWithStore (Just testStore) "./lib/view.tri")
{-# NOINLINE viewTestEnv #-}

viewCatalogTestEnv :: Env
viewCatalogTestEnv = unsafePerformIO $ do
  catalog <- evaluateFileWithStore (Just testStore) "./lib/views/catalog.tri"
  pure (Map.union viewTestEnv catalog)
{-# NOINLINE viewCatalogTestEnv #-}

allTestLibsEnv :: Env
allTestLibsEnv = unsafePerformIO $ do
  base    <- evaluateFile "./lib/base.tri"
  list    <- evaluateFile "./lib/list.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"
  view    <- evaluateFileWithStore (Just testStore) "./lib/view.tri"
  catalog <- evaluateFileWithStore (Just testStore) "./lib/views/catalog.tri"
  pure (Map.unions [base, list, bytes, bin, http, arbor, io, sock, view, catalog])
{-# NOINLINE allTestLibsEnv #-}

tests :: TestTree
tests = testGroup "Tricu Tests"
  [ lexer
  , parser
  , simpleEvaluation
  , lambdas
  , providedLibraries
  , maybeTests
  , fileEval
  , demos
  , decoding
  , elimLambdaSingle
  , stressElimLambda
  , byteMarshallingTests
  , wireTests
  , tricuReaderTests
  , byteListUtilities
  , binaryParserTests
  , httpParsingTests
  , contentStoreTests
  , viewContractTests
  , 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 as ordinary definition" $ do
      tricuTestString "id x@Bool =@Bool x\nid t" @?= "Leaf"

  , 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 = SApp (SLambda ["x"] (SVar "x" Nothing)) (SApp TLeaf TLeaf)
      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 = SApp (SLambda ["f"] (SApp (SVar "f" Nothing) TLeaf))
                        (SLambda ["x"] (SVar "x" Nothing))
      parseSingle input @?= expect

  , testCase "Parse where expression" $ do
      let input  = "x where x = t t"
          expect = SApp (SLambda ["x"] (SVar "x" Nothing)) (SApp TLeaf TLeaf)
      parseSingle input @?= expect

  , testCase "Evaluate where expression" $ do
      tricuTestString "x where x = 1" @?= "Fork (Stem Leaf) Leaf"

  , 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 ""
  ]

arithmeticTests :: TestTree
arithmeticTests = 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
  ]

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 \""
  ]

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: deterministic encoding and hash" $ do
      let manifest = ModuleManifest
            [ ModuleReference "base" (ObjectRef (unDomain manifestDomain) "111") ]
            [ ModuleExport
                "main"
                (ObjectRef (unDomain treeTermDomain) "222")
                "arboricx.abi.tree.v1"
                (Just (ObjectRef viewContractTypeKind "333"))
            ]
          encoded = encodeManifest manifest
      decodeManifest encoded @?= Right manifest
      hashObject manifestDomain encoded @?= "7c3cb85454744894a403d2d12c7ece6d391c0cfbeb4bf3adfc7e69ae70ec4f5c"

  , testCase "View Contract type artifacts: encode/decode round trip" $ do
      let view = VTFn [VTList (VTName "String"), VTPair (VTName "Byte") (VTMaybe (VTRef 7))]
                       (VTResult (VTName "Byte") (VTName "Bool"))
      decodeViewType (encodeViewType view) @?= Right view

  , testCase "View Contract type artifacts: encode/decode string refs" $ do
      let view = VTFn [VTRefText "Nat"] (VTPair (VTRefText "Box") (VTName "String"))
      decodeViewType (encodeViewType view) @?= Right view

  , testCase "View Contract type artifacts: encode/decode guarded views with opaque guard trees" $ do
      let guardTree = Fork (Stem Leaf) Leaf
          view = VTGuarded (VTRefText "UserId") guardTree
      decodeViewType (encodeViewType view) @?= Right view

  , testCase "View-tree artifacts: encode/decode and put/get through CAS" $
      withSystemTempDirectory "tricu-store" $ \dir -> do
        let store = StorePath dir
            viewTree = Fork (Stem Leaf) (Fork Leaf (Stem Leaf))
        decodeViewTree (encodeViewTree viewTree) @?= Right viewTree
        ref <- putViewTree store viewTree
        objectRefKind ref @?= viewTreeKind
        getViewTree store ref >>= (@?= Right viewTree)

  , testCase "View Contract type artifacts: put/get through CAS" $
      withSystemTempDirectory "tricu-store" $ \dir -> do
        let store = StorePath dir
            view = VTFn [VTName "Bool"] (VTName "String")
        ref <- putViewType store view
        objectRefKind ref @?= viewContractTypeKind
        getViewType store ref >>= (@?= Right view)

  , 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"
                  Nothing
              ]
        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"
                Nothing
              ]
          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: auto-build source module into manifest" $
      withSystemTempDirectory "tricu-workspace-module" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "value = t t\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
            objectRefKind ref @?= unDomain manifestDomain
            mManifest <- getManifest store (objectRefHash ref)
            case mManifest of
              Nothing -> assertFailure "expected workspace module manifest"
              Just manifest -> case moduleManifestExports manifest of
                [ex] -> do
                  objectRefKind (moduleExportObject ex) @?= viewTreeKind
                  loaded <- getViewTree store (moduleExportObject ex)
                  (loaded >>= viewTreeRootTerm) @?= Right (Stem Leaf)
                other -> assertFailure $ "unexpected exports: " ++ show other

  , testCase "Workspace modules: attach direct View Contract type artifacts to annotated exports" $
      withSystemTempDirectory "tricu-workspace-export-views" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "id x@Bool =@Bool x\nplain = t\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.id t\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        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 -> do
                let exports = moduleManifestExports manifest
                    viewFor name = moduleExportView =<< findExport name exports
                map moduleExportName exports @?= ["id", "plain"]
                map (objectRefKind . moduleExportObject) exports @?= [viewTreeKind, viewTreeKind]
                map moduleExportAbi exports @?= ["arboricx.abi.view-tree.v1", "arboricx.abi.view-tree.v1"]
                case viewFor "id" of
                  Nothing -> assertFailure "expected annotated export view ref"
                  Just viewRef -> do
                    objectRefKind viewRef @?= viewContractTypeKind
                    getViewType store viewRef >>= (@?= Right (VTFn [VTRef 0] (VTRef 0)))
                viewFor "plain" @?= Nothing

  , testCase "Workspace module checks: consumer imports use producer-checked view refs" $
      withSystemTempDirectory "tricu-workspace-consumer-check-ok" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "id x@Bool =@Bool x\n"
        writeFile mainPath "!import \"util\" Util\n\nfoo x@Bool =@Bool Util.id x\n"
        output <- checkFileWithStore store mainPath
        output @?= "ok"

  , testCase "Workspace module checks: consumer mismatches are judged from imported view refs" $
      withSystemTempDirectory "tricu-workspace-consumer-check-fail" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "toString x@Bool =@String \"ok\"\n"
        writeFile mainPath "!import \"util\" Util\n\nfoo x@Bool =@Bool Util.toString x\n"
        output <- checkFileWithStore store mainPath
        output @?= "symbol 3 (Util.toString application result) expected Bool but got String"

  , testCase "Workspace module checks: producer checks use imported view refs" $
      withSystemTempDirectory "tricu-workspace-producer-import-view-ok" $ \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 "id x@Bool =@Bool x\n"
        writeFile libPath "!import \"dep\" Dep\n\nuseId x@Bool =@Bool Dep.id x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.useId t\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        mAlias <- readAlias store ModuleAlias "util"
        case mAlias of
          Nothing -> assertFailure "expected producer-checked util module alias"
          Just ref -> do
            Just manifest <- getManifest store (objectRefHash ref)
            case moduleExportView =<< findExport "useId" (moduleManifestExports manifest) of
              Nothing -> assertFailure "expected imported-view-checked export view"
              Just viewRef -> getViewType store viewRef >>= (@?= Right (VTFn [VTRef 0] (VTRef 0)))

  , testCase "Workspace module checks: producer rejects mismatches against imported view refs" $
      withSystemTempDirectory "tricu-workspace-producer-import-view-fail" $ \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 "toString x@Bool =@String \"ok\"\n"
        writeFile libPath "!import \"dep\" Dep\n\nuseString x@Bool =@Bool Dep.toString x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.useString t\n"
        outcome <- try (evaluateFileWithStore (Just store) mainPath) :: IO (Either SomeException Env)
        case outcome of
          Right _ -> assertFailure "expected producer-side imported view mismatch"
          Left err -> show err `containsAll`
            [ "Workspace module"
            , "util"
            , "failed View Contract check"
            , "Dep.toString application result"
            , "expected Bool but got String"
            ]
        mDepAlias <- readAlias store ModuleAlias "dep"
        case mDepAlias of
          Nothing -> assertFailure "expected dependency alias to be published"
          Just _  -> pure ()
        readAlias store ModuleAlias "util" >>= (@?= Nothing)

  , testCase "Workspace module checks: imported exports without views remain checker-policy failures" $
      withSystemTempDirectory "tricu-workspace-consumer-check-missing-view" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "plain = t\n"
        writeFile mainPath "!import \"util\" Util\n\nfoo =@Bool Util.plain\n"
        output <- checkFileWithStore store mainPath
        output @?= "symbol 1 (external Util.plain) expected Bool but got Any"

  , testCase "Workspace module checks: invalid imported view artifacts report artifact diagnostics" $
      withSystemTempDirectory "tricu-workspace-consumer-check-invalid-view" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "id x@Bool =@Bool x\n"
        writeFile mainPath "!import \"util\" Util\n\nfoo x@Bool =@Bool Util.id x\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        Just aliasRef <- readAlias store ModuleAlias "util"
        Just manifest <- getManifest store (objectRefHash aliasRef)
        let corruptRef = ObjectRef "not-a-view-contract-type.v1" "badbad"
            corruptExport ex = ex { moduleExportView = Just corruptRef }
            corruptManifest = manifest { moduleManifestExports = map corruptExport (moduleManifestExports manifest) }
        corruptHash <- putManifest store corruptManifest
        writeAlias store ModuleAlias "util" (ObjectRef (unDomain manifestDomain) corruptHash)
        outcome <- try (checkFileWithStore store mainPath) :: IO (Either SomeException String)
        case outcome of
          Right _ -> assertFailure "expected invalid imported view artifact failure"
          Left err -> show err `containsAll`
            [ "View Contract artifact invalid"
            , "Util.id"
            , "not-a-view-contract-type.v1"
            , "badbad"
            , "unsupported View Contract type object kind"
            ]

  , testCase "Workspace modules: reject annotated exports that fail producer-side View Contract checks" $
      withSystemTempDirectory "tricu-workspace-bad-export-view" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "bad x@String =@Bool x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.bad\n"
        outcome <- try (evaluateFileWithStore (Just store) mainPath) :: IO (Either SomeException Env)
        case outcome of
          Right _ -> assertFailure "expected producer-side View Contract failure"
          Left err -> show err `containsAll`
            [ "Workspace module"
            , "util"
            , "failed View Contract check"
            , "expected Bool but got String"
            ]
        readAlias store ModuleAlias "util" >>= (@?= Nothing)

  , testCase "Unchecked workspace eval ignores bad annotations and publishes no view refs" $
      withSystemTempDirectory "tricu-workspace-unchecked-bad-export-view" $ \dir -> do
        let store = StorePath (dir </> "store")
            libPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile libPath "bad x@String =@Bool x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.bad \"hi\"\n"
        env <- evaluateFileWithContextWithStoreAndMode IgnoreContracts (Just store) Map.empty mainPath
        toString (mainResult env) @?= Right "hi"
        mAlias <- readAlias store ModuleAlias "util"
        case mAlias of
          Nothing -> assertFailure "expected unchecked eval to publish executable module alias"
          Just ref -> do
            mManifest <- getManifest store (objectRefHash ref)
            case mManifest of
              Nothing -> assertFailure "expected unchecked module manifest"
              Just manifest -> case moduleManifestExports manifest of
                [ex] -> moduleExportView ex @?= Nothing
                other -> assertFailure $ "unexpected exports: " ++ show other

  , 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 "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"
                  Nothing
              ]
        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" Nothing ]
          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)

findExport :: Text -> [ModuleExport] -> Maybe ModuleExport
findExport name = find ((== name) . moduleExportName)

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

-- --------------------------------------------------------------------------
-- View Contract tests
-- --------------------------------------------------------------------------

viewContractTests :: TestTree
viewContractTests = testGroup "View Contract Tests"
  [ testCase "typedValue satisfies typedRequire" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgram (typedProgram 0 [(typedValue 0 (viewRef 10) t) (typedRequire 0 (viewRef 10) t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "ok"

  , testCase "typedApply infers result view from Fn" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgram (typedProgram 2 [(typedValue 0 (viewRef 10) t) (typedValue 1 (viewFn [(viewRef 10)] (viewRef 10)) t) (typedApply 2 1 0 t) (typedRequire 2 (viewRef 10) t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "ok"

  , testCase "typedProgram carries abstract executable tree payloads" $ do
      let input = unwords
            [ "matchBool \"yes\" \"no\""
            , "(and?"
            , "  (equal?"
            , "    (checkedProgramTree (checkTypedProgramWith policyStrict"
            , "      (typedProgram 0 [(typedValue 0 (viewFn [(viewRef 10)] (viewRef 10)) (x : x))])))"
            , "    (x : x))"
            , "  (equal?"
            , "    (checkedProgramTree (checkTypedProgramWith policyStrict"
            , "      (typedProgram 2"
            , "        [(typedValue 0 (viewFn [(viewRef 10)] (viewRef 10)) (x : x))"
            , "         (typedValue 1 (viewRef 10) (t t))"
            , "         (typedApply 2 0 1 (t t))"
            , "         (typedRequire 2 (viewRef 10) (t t))])))"
            , "    (t t)))"
            ]
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "checkTypedProgram returns checked-exec wrapper on success" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchBool \"yes\" \"no\" (equal? (recordTag exec) checkedExecTagPure)) (checkTypedProgram (typedProgram 0 [(typedValue 0 (viewRef 10) (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "guarded typedRequire injects checked guard on root success" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : matchBool \"yes\" \"no\" (equal? value (t t))) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewString (t t)) (typedRequire 0 (viewGuarded viewString (x : guardOk x)) (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "guarded typedRequire injects checked guard on root failure" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewString (t t)) (typedRequire 0 (viewGuarded viewString (x : guardFail)) (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "root guarded observations compose in typed-node order" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewString \"x\") (typedRequire 0 (viewGuarded viewString (x : guardOk (append x \"1\"))) \"x\") (typedRequire 0 (viewGuarded viewString (x : guardOk (append x \"2\"))) \"x\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "x12"

  , testCase "guarded typedValue implies base evidence and composes with later guarded require" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 (viewGuarded viewString (x : guardOk (append x \"1\"))) \"x\") (typedRequire 0 (viewGuarded viewString (x : guardOk (append x \"2\"))) \"x\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "x12"

  , testCase "guarded function argument injects before root application" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : matchBool \"yes\" \"no\" (equal? value (t t))) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewGuarded viewString (x : guardOk x))] viewString) (x : x)) (typedValue 1 viewString (t t)) (typedApply 2 0 1 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "guarded function argument failure skips root application" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewGuarded viewString (x : guardFail))] viewString) (x : \"entered\")) (typedValue 1 viewString (t t)) (typedApply 2 0 1 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "guarded function argument failure renders application context" $ do
      let input = "matchResult (diag env : renderDiagnostic diag) (exec env : matchResult (runtimeDiag runtimeEnv : renderDiagnostic runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewGuarded viewString (x : guardFail))] viewString) (x : \"entered\")) (typedValue 1 viewString (t t)) (typedApply 2 0 1 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed at argument 0 of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded String"

  , testCase "non-root guarded requirement composes before argument use" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] viewString) (x : x)) (typedValue 1 viewString \"x\") (typedRequire 1 (viewGuarded viewString (x : guardOk (append x \"1\"))) \"x\") (typedApply 2 0 1 \"x\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "x1"

  , testCase "non-root guarded requirement failure skips argument use" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] viewString) (x : \"entered\")) (typedValue 1 viewString \"x\") (typedRequire 1 (viewGuarded viewString (x : guardFail)) \"x\") (typedApply 2 0 1 \"entered\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "guarded function result injects after root application success" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : matchBool \"yes\" \"no\" (equal? value (t t))) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] (viewGuarded viewString (x : guardOk x))) (x : x)) (typedValue 1 viewString (t t)) (typedApply 2 0 1 (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "guarded function result failure stops at checked boundary" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] (viewGuarded viewString (x : guardFail))) (x : x)) (typedValue 1 viewString (t t)) (typedApply 2 0 1 (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "guarded function result failure renders application context" $ do
      let input = "matchResult (diag env : renderDiagnostic diag) (exec env : matchResult (runtimeDiag runtimeEnv : renderDiagnostic runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] (viewGuarded viewString (x : guardFail))) (x : x)) (typedValue 1 viewString (t t)) (typedApply 2 0 1 (t t))]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed at result of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded String"

  , testCase "nested curried application injects guarded later argument" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 4 [(typedValue 0 (viewFn [(viewString) (viewGuarded viewString (x : guardOk (append x \"!\")))] viewString) (x : y : y)) (typedValue 1 viewString \"a\") (typedApply 2 0 1 (y : y)) (typedValue 3 viewString \"b\") (typedApply 4 2 3 \"b\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "b!"

  , testCase "unreachable guarded symbol does not run guard" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewString \"root\") (typedValue 1 viewString \"unused\") (typedRequire 1 (viewGuarded viewString (x : guardFail)) \"unused\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "root"

  , testCase "later guarded require is a global symbol observation" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] viewString) (x : x)) (typedValue 1 viewString \"x\") (typedApply 2 0 1 \"x\") (typedRequire 1 (viewGuarded viewString (x : guardOk (append x \"!\"))) \"x\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "x!"

  , testCase "repeated reachable uses rerun symbol observations" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 4 [(typedValue 0 (viewFn [(viewString) (viewString)] viewString) (x : y : append x y)) (typedValue 1 viewString \"x\") (typedRequire 1 (viewGuarded viewString (x : guardOk (append x \"!\"))) \"x\") (typedApply 2 0 1 (y : append \"x\" y)) (typedApply 4 2 1 \"xx\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "x!x!"

  , testCase "guarded callee symbol observation runs before application" $ do
      let input = "checkedProgramTree (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] viewString) (x : \"raw\")) (typedRequire 0 (viewGuarded (viewFn [(viewString)] viewString) (f : guardOk (x : \"guarded\"))) (x : \"raw\")) (typedValue 1 viewString \"arg\") (typedApply 2 0 1 \"raw\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guarded"

  , testCase "guarded callee symbol failure skips application" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 0 (viewFn [(viewString)] viewString) (x : \"entered\")) (typedRequire 0 (viewGuarded (viewFn [(viewString)] viewString) (f : guardFail)) (x : \"entered\")) (typedValue 1 viewString \"arg\") (typedApply 2 0 1 \"entered\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "nested curried guarded argument failure skips final callee" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (exec env : matchResult (runtimeDiag runtimeEnv : diagnosticMessage runtimeDiag) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 4 [(typedValue 0 (viewFn [(viewString) (viewGuarded viewString (x : guardFail))] viewString) (x : y : \"entered\")) (typedValue 1 viewString \"a\") (typedApply 2 0 1 (y : \"entered\")) (typedValue 3 viewString \"b\") (typedApply 4 2 3 \"entered\")]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "runChecked guard success unwraps and continues" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (value env : matchBool \"yes\" \"no\" (equal? value (t t))) (runChecked (checkedGuard viewString (x : guardOk x) (t t) (x : checkedPure x)))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "runChecked guard failure does not enter continuation" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (value env : value) (runChecked (checkedGuard viewString (x : guardFail) (t t) (x : checkedPure \"entered\")))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "checkedBind composes checked execution success" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (value env : matchBool \"yes\" \"no\" (equal? value (t t))) (runChecked (checkedBind (checkedPure (t t)) (x : checkedPure x)))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "checkedBind propagates checked execution failure" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (value env : value) (runChecked (checkedBind (checkedGuard viewString (x : guardFail) (t t) (x : checkedPure x)) (x : checkedPure \"entered\")))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "guard failed"

  , testCase "runChecked malformed guard result fails at checked-exec boundary" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (value env : value) (runChecked (checkedGuard viewString (x : record 99 t) (t t) (x : checkedPure x)))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "malformed guard result"

  , testCase "Strict policy rejects missing argument view for known Fn" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgramWith policyStrict (typedProgram 2 [(typedValue 1 (viewFn [(viewRef 10)] (viewRef 10)) t) (typedApply 2 1 0 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "function argument view is not known"

  , testCase "Gradual policy trusts missing argument view for known Fn" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgramWith policyGradual (typedProgram 2 [(typedValue 1 (viewFn [(viewRef 10)] (viewRef 10)) t) (typedApply 2 1 0 t) (typedRequire 0 (viewRef 10) t) (typedRequire 2 (viewRef 10) t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "ok"

  , testCase "Strict policy rejects explicit missing typedRequire" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgramWith policyStrict (typedProgram 0 [(typedRequire 0 (viewRef 10) t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "required view is not known"

  , testCase "Gradual policy trusts explicit missing typedRequire" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgramWith policyGradual (typedProgram 0 [(typedRequire 0 (viewRef 10) t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "ok"

  , testCase "typedApply leaves unknown callees gradual" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgram (typedProgram 2 [(typedApply 2 1 0 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "ok"

  , testCase "Malformed typed node is rejected before flow checking" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgram (typedProgram 0 [(record 99 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "malformed view program"

  , testCase "Raw numeric views are rejected before flow checking" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgram (typedProgram 0 [(typedValue 0 10 t)]))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "malformed view program"

  , testCase "Malformed policy is rejected before program checking" $ do
      let input = "matchResult (diag env : diagnosticMessage diag) (env rest : \"ok\") (checkTypedProgramWith (pair 99 t) (typedProgram 0 t))"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "malformed view policy"

  , testCase "Environment validator accepts only well-formed env entries" $ do
      let input = "matchBool \"yes\" \"no\" (wellFormedEnv? [(envEntry 0 [(viewFact (viewRef 10) evidenceTagTrusted)])])"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "Portable View Contract self-tests all pass" $ do
      let input = "viewContractSelfTests"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofList (replicate 32 (ofString "ok"))

  , testCase "Structured diagnostic tag reports required-view failures" $ do
      let input = "checkerResultErrorTag (checkTypedProgramWith policyStrict listMapWrongOutputContract)"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofNumber 4

  , testCase "Structured diagnostic payload reports actual argument view" $ do
      let input = "matchResult (diag env : matchBool \"yes\" \"no\" (equal? (diagnosticActualView diag) (viewList viewString))) (env rest : \"unexpected-ok\") (checkTypedProgramWith policyStrict listMapWrongListArgContract)"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "yes"

  , testCase "Rendered diagnostic explains expected and actual views" $ do
      let input = "matchResult (diag env : renderDiagnostic diag) (env rest : \"unexpected-ok\") (checkTypedProgramWith policyStrict listMapWrongListArgContract)"
          env = evalTricu allTestLibsEnv (parseTricu input)
      result env @?= ofString "symbol 162 expected List Bool but got List String"

  , testCase "tricu check lowers annotated identity flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "id x@Bool =@Bool x\n"
      output @?= "ok"

  , testCase "tricu check reports annotated body mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "id x@String =@Bool x\n"
      output @?= "symbol 1 (x) expected Bool but got String"

  , testCase "tricu check lowers application flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "f x@Bool =@Bool g x\ng y@Bool =@Bool y\n"
      output @?= "ok"

  , testCase "tricu check reports application argument mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "f x@String =@Bool g x\ng y@Bool =@Bool y\n"
      output @?= "symbol 2 (x) expected Bool but got String"

  , testCase "tricu check maps phantom annotation to exposed lambda binder" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @Bool =@Bool (x : x)\n"
      output @?= "ok"

  , testCase "tricu check reports phantom lambda body mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @String =@Bool (x : x)\n"
      output @?= "symbol 1 (x) expected Bool but got String"

  , testCase "tricu check maps multiple phantoms to lambda spine" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @Bool @String =@String (x y : y)\n"
      output @?= "ok"

  , testCase "tricu check leaves unconsumed phantoms as residual function requirement" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @Bool =@Bool bar\n"
      output @?= "symbol 1 (external bar) expected Fn [Bool] Bool but got Any"

  , testCase "tricu check accepts trusted imported View Contract facts" $ do
      let imported = [ImportedView "Ext.id" (VTFn [VTName "Bool"] (VTName "Bool"))]
      output <- checkSourceWithEnvAndImportedViews allTestLibsEnv imported "foo x@Bool =@Bool Ext.id x\n"
      output @?= "ok"

  , testCase "tricu check judges imported View Contract facts in checker" $ do
      let imported = [ImportedView "Ext.id" (VTFn [VTName "Bool"] (VTName "String"))]
      output <- checkSourceWithEnvAndImportedViews allTestLibsEnv imported "foo x@Bool =@Bool Ext.id x\n"
      output @?= "symbol 3 (Ext.id application result) expected Bool but got String"

  , testCase "tricu lower emits imported View Contract facts as view-tree nodes" $ do
      let imported = [ImportedView "Ext.id" (VTFn [VTName "Bool"] (VTName "Bool"))]
      case lowerSourceWithImportedViews imported "foo x@Bool =@Bool Ext.id x\n" of
        Left err -> assertFailure err
        Right lowered -> lowered @?= "typedProgram 3 [(typedValue 1 (viewFn [(viewBool)] (viewBool)) t) (typedValue 0 (viewFn [(viewBool)] (viewBool)) t) (typedValue 2 (viewBool) t) (typedRequire 2 (viewBool) t) (typedApply 3 1 2 t) (typedRequire 3 (viewBool) t)]"

  , testCase "tricu lower emits symbolic View Contract refs in view-tree nodes" $ do
      case lowerSource "foo x@(Ref \"UserId\") =@(Ref \"UserId\") x\n" of
        Left err -> assertFailure err
        Right lowered -> lowered @?= "typedProgram 1 [(typedValue 0 (viewFn [(viewRef \"UserId\")] (viewRef \"UserId\")) t) (typedValue 1 (viewRef \"UserId\") t) (typedRequire 1 (viewRef \"UserId\") t)]"

  , testCase "tricu check converts resolved module export views into imported facts" $ do
      let viewRef = ObjectRef viewContractTypeKind "abc123"
          resolvedExport = ResolvedExport
            { resolvedExportSourceName = "id"
            , resolvedExportLocalName = "Ext.id"
            , resolvedExportObject = ObjectRef (unDomain treeTermDomain) "def456"
            , resolvedExportAbi = "arboricx.abi.tree.v1"
            , resolvedExportView = Just viewRef
            , resolvedExportTerm = Leaf
            }
          resolvedModule = ResolvedModule "ext" "Ext" "manifest-hash" [resolvedExport]
          loadView ref = pure $ if ref == viewRef
            then Just (VTFn [VTName "Bool"] (VTName "Bool"))
            else Nothing
      imported <- importedViewsFromResolvedModules loadView [resolvedModule]
      imported @?= [ImportedView "Ext.id" (VTFn [VTName "Bool"] (VTName "Bool"))]
      output <- checkSourceWithEnvAndImportedViews allTestLibsEnv imported "foo x@Bool =@Bool Ext.id x\n"
      output @?= "ok"

  , testCase "tricu check reports missing resolved View Contract artifacts" $ do
      let viewRef = ObjectRef viewContractTypeKind "abc123"
          resolvedExport = ResolvedExport
            { resolvedExportSourceName = "id"
            , resolvedExportLocalName = "Ext.id"
            , resolvedExportObject = ObjectRef (unDomain treeTermDomain) "def456"
            , resolvedExportAbi = "arboricx.abi.tree.v1"
            , resolvedExportView = Just viewRef
            , resolvedExportTerm = Leaf
            }
          resolvedModule = ResolvedModule "ext" "Ext" "manifest-hash" [resolvedExport]
      outcome <- try (importedViewsFromResolvedModules (\_ -> pure Nothing) [resolvedModule]) :: IO (Either SomeException [ImportedView])
      case outcome of
        Right _ -> assertFailure "expected missing view artifact failure"
        Left err -> show err `containsAll` ["View Contract artifact invalid", "Ext.id", "arboricx.view-contract.type.v1", "abc123", "artifact not found"]

  , testCase "tricu check recognizes string literal views" $ do
      output <- checkSourceWithEnv allTestLibsEnv "s =@String \"hi\"\n"
      output @?= "ok"

  , testCase "tricu check recognizes byte literal views" $ do
      output <- checkSourceWithEnv allTestLibsEnv "b =@Byte 42\n"
      output @?= "ok"

  , testCase "tricu check recognizes unit literal views" $ do
      output <- checkSourceWithEnv allTestLibsEnv "u =@Unit t\n"
      output @?= "ok"

  , testCase "tricu check recognizes homogeneous list literal views" $ do
      output <- checkSourceWithEnv allTestLibsEnv "xs =@(List String) [(\"a\") (\"b\")]\n"
      output @?= "ok"

  , testCase "tricu check propagates let-bound literal views" $ do
      output <- checkSourceWithEnv allTestLibsEnv "x =@(List String) let y = \"hi\" in [(y)]\n"
      output @?= "ok"

  , testCase "tricu check uses binder views in list literals" $ do
      output <- checkSourceWithEnv allTestLibsEnv "xs x@String =@(List String) [(x) (\"b\")]\n"
      output @?= "ok"

  , testCase "tricu check consumes Fn return annotations through lambda spine" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo =@(Fn [String] String) (x : x)\n"
      output @?= "ok"

  , testCase "tricu check reports Fn return annotation lambda mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo =@(Fn [String] Bool) (x : x)\n"
      output @?= "symbol 1 (x) expected Bool but got String"

  , testCase "tricu check propagates application result views into list literals" $ do
      output <- checkSourceWithEnv allTestLibsEnv "xs =@(List String) [(g \"hi\")]\ng y@String =@String y\n"
      output @?= "ok"

  , testCase "tricu check reports application result view mismatches in list literals" $ do
      output <- checkSourceWithEnv allTestLibsEnv "xs =@(List String) [(g \"hi\")]\ng y@String =@Bool y\n"
      output @?= "symbol 3 (g application result) expected String but got Bool"

  , testCase "tricu check propagates phantom lambda binder views into list literals" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @String =@(List String) (x : [(x)])\n"
      output @?= "ok"

  , testCase "tricu check reports phantom lambda binder list mismatches" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo @Byte =@(List String) (x : [(x)])\n"
      output @?= "symbol 1 (x) expected String but got Byte"

  , testCase "tricu check checks lambda literals in expected Fn lists" $ do
      output <- checkSourceWithEnv allTestLibsEnv "fs =@(List (Fn [String] String)) [((x : x))]\n"
      output @?= "ok"

  , testCase "tricu check reports lambda literals in expected Fn list mismatches" $ do
      output <- checkSourceWithEnv allTestLibsEnv "fs =@(List (Fn [String] Bool)) [((x : x))]\n"
      output @?= "symbol 1 (x) expected Bool but got String"

  , testCase "tricu check propagates expected Fn through partial lambda application" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo =@(Fn [Byte] String) (x y : x) \"hi\"\n"
      output @?= "ok"

  , testCase "tricu check reports expected Fn mismatch through partial lambda application" $ do
      output <- checkSourceWithEnv allTestLibsEnv "foo =@(Fn [Byte] Bool) (x y : x) \"hi\"\n"
      output @?= "symbol 1 (string literal) expected Bool but got String"

  , testCase "tricu check lowers expected Pair constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "p =@(Pair String Byte) pair \"a\" 1\n"
      output @?= "ok"

  , testCase "tricu check reports expected Pair constructor element mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "p =@(Pair String Byte) pair 1 \"a\"\n"
      output @?= "symbol 1 (byte literal) expected String but got Byte"

  , testCase "tricu check lowers expected Maybe just constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe String) just \"a\"\n"
      output @?= "ok"

  , testCase "tricu check reports expected Maybe just element mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe String) just 1\n"
      output @?= "symbol 1 (byte literal) expected String but got Byte"

  , testCase "tricu check lowers expected Maybe nothing constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe String) nothing\n"
      output @?= "ok"

  , testCase "tricu check lowers expected Result ok constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte String) ok \"a\" t\n"
      output @?= "ok"

  , testCase "tricu check reports expected Result ok value mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte String) ok 1 t\n"
      output @?= "symbol 1 (byte literal) expected String but got Byte"

  , testCase "tricu check lowers expected Result err constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte String) err 1 t\n"
      output @?= "ok"

  , testCase "tricu check reports expected Result err value mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte String) err \"a\" t\n"
      output @?= "symbol 1 (string literal) expected Byte but got String"

  , testCase "tricu check lowers nested Maybe List constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe (List String)) just [(\"a\")]\n"
      output @?= "ok"

  , testCase "tricu check reports nested Maybe List constructor element mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe (List String)) just [(1)]\n"
      output @?= "symbol 1 (byte literal) expected String but got Byte"

  , testCase "tricu check lowers nested Pair Maybe constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "p =@(Pair String (Maybe Byte)) pair \"a\" (just 1)\n"
      output @?= "ok"

  , testCase "tricu check reports nested Pair Maybe constructor mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "p =@(Pair String (Maybe Byte)) pair \"a\" (just \"b\")\n"
      output @?= "symbol 2 (string literal) expected Byte but got String"

  , testCase "tricu check lowers nested Result List constructor flow" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte (List String)) ok [(\"a\")] t\n"
      output @?= "ok"

  , testCase "tricu check reports nested Result List constructor mismatch" $ do
      output <- checkSourceWithEnv allTestLibsEnv "r =@(Result Byte (List String)) ok [(1)] t\n"
      output @?= "symbol 1 (byte literal) expected String but got Byte"

  , testCase "tricu check propagates expected views through let into constructors" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe (List String)) let xs = [(\"a\")] in just xs\n"
      output @?= "ok"

  , testCase "tricu check reports let-bound constructor mismatches" $ do
      output <- checkSourceWithEnv allTestLibsEnv "m =@(Maybe (List String)) let xs = [(1)] in just xs\n"
      output @?= "symbol 2 expected List String but got List Byte"

  , testCase "tricu check does not use constructor lowering for shadowed pair" $ do
      output <- checkSourceWithEnv allTestLibsEnv "pair x y = x\np =@(Pair String Byte) pair \"a\" 1\n"
      output @?= "symbol 5 (pair application result) expected Pair String Byte but got Any"

  , testCase "tricu check does not use constructor lowering for shadowed just" $ do
      output <- checkSourceWithEnv allTestLibsEnv "just x = x\nm =@(Maybe String) just \"a\"\n"
      output @?= "symbol 3 (just application result) expected Maybe String but got Any"

  , testCase "tricu check documents do-block lowering with explicit bind operator" $ do
      output <- checkSourceWithEnv allTestLibsEnv "pure x@String =@(Maybe String) just x\nbind m@(Maybe String) f@(Fn [String] (Maybe String)) =@(Maybe String) m\nm =@(Maybe String) do bind\n  x <- pure \"a\"\n  pure x\n"
      output @?= "ok"

  , testCase "tricu check lowerSource emits expected constructor payload typed nodes" $ do
      case lowerSource "m =@(Maybe String) just \"a\"\n" of
        Left err -> assertFailure err
        Right lowered -> do
          assertBool "expected String payload requirement" $
            "typedRequire 1 (viewString)" `isInfixOf` lowered
          assertBool "expected Maybe String constructor declaration" $
            "typedValue 2 (viewMaybe (viewString))" `isInfixOf` lowered

  , testCase "tricu check lowerSource emits expected Fn argument typed nodes" $ do
      case lowerSource "f x@String =@String x\ny =@String f 1\n" of
        Left err -> assertFailure err
        Right lowered ->
          assertBool "expected application argument requirement" $
            "typedRequire 3 (viewString)" `isInfixOf` lowered

  , testCase "tricu check lowerSource emits phantom-to-lambda typed nodes" $ do
      case lowerSource "foo @String =@String (x : x)\n" of
        Left err -> assertFailure err
        Right lowered -> do
          assertBool "expected lambda binder declaration" $
            "typedValue 1 (viewString) t" `isInfixOf` lowered
          assertBool "expected lambda body requirement" $
            "typedRequire 1 (viewString) t" `isInfixOf` lowered

  , testCase "tricu check lowerSource emits list element requirements" $ do
      case lowerSource "xs =@(List String) [(1)]\n" of
        Left err -> assertFailure err
        Right lowered -> do
          assertBool "expected Byte evidence for literal element" $
            "typedValue 1 (viewByte)" `isInfixOf` lowered
          assertBool "expected actual Byte tree payload for literal element" $
            "typedValue 1 (viewByte) (t (t t) t)" `isInfixOf` lowered
          assertBool "expected String requirement for list element" $
            "typedRequire 1 (viewString)" `isInfixOf` lowered

  , testCase "tricu check lowerSource documents constructor shadowing fallback" $ do
      case lowerSource "just x = x\nm =@(Maybe String) just \"a\"\n" of
        Left err -> assertFailure err
        Right lowered -> do
          assertBool "expected normal application result requirement" $
            "typedRequire 3 (viewMaybe (viewString)) t" `isInfixOf` lowered
          assertBool "shadowed just should not emit payload requirement" $
            not ("typedRequire 2 (viewString) t" `isInfixOf` lowered)

  , testCase "tricu check lowerSource emits do-block callback Fn typed nodes" $ do
      case lowerSource "pure x@String =@(Maybe String) just x\nbind m@(Maybe String) f@(Fn [String] (Maybe String)) =@(Maybe String) m\nm =@(Maybe String) do bind\n  x <- pure \"a\"\n  pure x\n" of
        Left err -> assertFailure err
        Right lowered -> do
          assertBool "expected callback lambda declaration" $
            "typedValue 12 (viewFn [(viewString)] (viewMaybe (viewString))) t" `isInfixOf` lowered
          assertBool "expected bind application to declared callback" $
            "typedApply 13 9 12 t" `isInfixOf` lowered

  , testCase "tricu check lowerSourceWithDebug records top and binder names" $ do
      case lowerSourceWithDebug "id x@String =@String x\n" of
        Left err -> assertFailure err
        Right (_, debugNames) -> do
          Map.lookup 0 debugNames @?= Just "id"
          Map.lookup 1 debugNames @?= Just "x"

  , testCase "tricu check lowerSourceWithDebug records literal and application labels" $ do
      case lowerSourceWithDebug "f x@String =@String x\ny =@String f 1\n" of
        Left err -> assertFailure err
        Right (_, debugNames) -> do
          Map.lookup 3 debugNames @?= Just "byte literal"
          Map.lookup 4 debugNames @?= Just "f application result"

  , testCase "tricu check lowerSourceWithDebug records curried application head labels" $ do
      case lowerSourceWithDebug "f x@String y@Byte =@String x\ny =@String f \"a\" 1\n" of
        Left err -> assertFailure err
        Right (_, debugNames) -> do
          Map.lookup 5 debugNames @?= Just "f application result"
          Map.lookup 7 debugNames @?= Just "f application result"

  , testCase "tricu check source syntax success demo" $ do
      output <- checkFile "./demos/viewContracts/sourceSyntax/success.tri"
      output @?= "ok"

  , testCase "tricu check source syntax labeled diagnostic demo" $ do
      output <- checkFile "./demos/viewContracts/sourceSyntax/failure.tri"
      output @?= "symbol 4 (x) expected Bool but got String"

  , testCase "tricu check annotations can reference local view aliases" $
      withSystemTempDirectory "tricu-local-view-alias" $ \dir -> do
        let path = dir </> "alias.tri"
        writeFile path "Nat = viewRef \"Nat\"\n\nidNat x@Nat =@Nat x\n"
        output <- checkFile path
        output @?= "ok"

  , testCase "tricu check annotations can reference guarded local view aliases" $
      withSystemTempDirectory "tricu-guarded-view-alias" $ \dir -> do
        let path = dir </> "guarded-alias.tri"
        writeFile path "userIdGuard = x : guardOk x\nUserId = viewGuarded (viewRef \"UserId\") userIdGuard\n\nidUser x@UserId =@UserId x\n"
        output <- checkFile path
        output @?= "ok"

  , testCase "tricu check runs source-level guarded root failure" $
      withSystemTempDirectory "tricu-guarded-root-failure" $ \dir -> do
        let path = dir </> "guarded-root-failure.tri"
        writeFile path "reject = x : guardFail\nRejectedString = viewGuarded viewString reject\n\nmain =@RejectedString \"x\"\n"
        output <- checkFile path
        output @?= "guard failed at root typedRequire symbol 3 for Guarded String"

  , testCase "tricu check runs source-level guarded root success" $
      withSystemTempDirectory "tricu-guarded-root-success" $ \dir -> do
        let path = dir </> "guarded-root-success.tri"
        writeFile path "accept = x : guardOk x\nAcceptedString = viewGuarded viewString accept\n\nmain =@AcceptedString \"x\"\n"
        output <- checkFile path
        output @?= "ok"

  , testCase "tricu check runs source-level guarded argument failure" $
      withSystemTempDirectory "tricu-guarded-argument-failure" $ \dir -> do
        let path = dir </> "guarded-argument-failure.tri"
        writeFile path "reject = x : guardFail\nRejectedString = viewGuarded viewString reject\n\nidRejected x@RejectedString =@String \"entered\"\nmain =@String idRejected \"x\"\n"
        output <- checkFile path
        output @?= "guard failed at typedRequire symbol 6 for Guarded String"

  , testCase "imported VTGuarded lowers to portable viewGuarded" $ do
      let failGuard = result (evalTricu allTestLibsEnv (parseTricu "(x : guardFail)"))
          imported = [ImportedView "Ext.id" (VTFn [VTGuarded (VTName "String") failGuard] (VTName "String"))]
      case lowerSourceWithImportedViews imported "main =@String Ext.id \"x\"\n" of
        Left err -> assertFailure err
        Right lowered -> assertBool "expected imported guarded view to survive lowering" $ "viewGuarded" `isInfixOf` lowered

  , testCase "tricu check runs imported guarded argument failure" $ do
      let failGuard = result (evalTricu allTestLibsEnv (parseTricu "(x : guardFail)"))
          imported = [ImportedView "Ext.id" (VTFn [VTGuarded (VTName "String") failGuard] (VTName "String"))]
      output <- checkSourceWithEnvAndImportedViews allTestLibsEnv imported "main =@String Ext.id \"x\"\n"
      output @?= "guard failed at typedRequire symbol 2 for Guarded String"

  , testCase "tricu check rejects malformed local view aliases" $
      withSystemTempDirectory "tricu-malformed-view-alias" $ \dir -> do
        let path = dir </> "bad-alias.tri"
        writeFile path "Bad = \"not a view\"\n\nidBad x@Bad =@Bad x\n"
        output <- checkFile path
        output @?= "malformed view program"

  , testCase "tricu check rejects malformed local view constructors" $
      withSystemTempDirectory "tricu-malformed-view-constructor" $ \dir -> do
        let path = dir </> "bad-constructor.tri"
        writeFile path "BadBox a = pair \"not\" a\n\nidBad x@(BadBox String) =@(BadBox String) x\n"
        output <- checkFile path
        output @?= "malformed view program"

  , testCase "tricu check annotations can apply user-defined view constructors" $
      withSystemTempDirectory "tricu-local-view-constructor" $ \dir -> do
        let path = dir </> "constructor.tri"
        writeFile path "Box a = viewPair (viewRef \"Box\") a\n\nidBox x@(Box String) =@(Box String) x\n"
        output <- checkFile path
        output @?= "ok"

  , testCase "Workspace modules publish resolved custom view aliases" $
      withSystemTempDirectory "tricu-workspace-custom-view-alias" $ \dir -> do
        let store = StorePath (dir </> "store")
            utilPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile utilPath "Nat = t 2 [(t 2 10)]\nidNat x@Nat =@Nat x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.idNat 1\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        mAlias <- readAlias store ModuleAlias "util"
        case mAlias of
          Nothing -> assertFailure "expected util module alias"
          Just ref -> do
            mManifest <- getManifest store (objectRefHash ref)
            case mManifest of
              Nothing -> assertFailure "expected util module manifest"
              Just manifest -> case find ((== "idNat") . unpack . moduleExportName) (moduleManifestExports manifest) of
                Nothing -> assertFailure "expected idNat export"
                Just ex -> case moduleExportView ex of
                  Nothing -> assertFailure "expected idNat view ref"
                  Just viewRef -> do
                    view <- getViewType store viewRef
                    view @?= Right (VTFn [VTRef 10] (VTRef 10))

  , testCase "Workspace modules publish string custom view aliases" $
      withSystemTempDirectory "tricu-workspace-string-view-alias" $ \dir -> do
        let store = StorePath (dir </> "store")
            utilPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile utilPath "Nat = t 2 [(t 2 \"Nat\")]\nidNat x@Nat =@Nat x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.idNat 1\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        mAlias <- readAlias store ModuleAlias "util"
        case mAlias of
          Nothing -> assertFailure "expected util module alias"
          Just ref -> do
            mManifest <- getManifest store (objectRefHash ref)
            case mManifest of
              Nothing -> assertFailure "expected util module manifest"
              Just manifest -> case find ((== "idNat") . unpack . moduleExportName) (moduleManifestExports manifest) of
                Nothing -> assertFailure "expected idNat export"
                Just ex -> case moduleExportView ex of
                  Nothing -> assertFailure "expected idNat view ref"
                  Just viewRef -> do
                    view <- getViewType store viewRef
                    view @?= Right (VTFn [VTRefText "Nat"] (VTRefText "Nat"))

  , testCase "Workspace modules publish guarded custom view aliases" $
      withSystemTempDirectory "tricu-workspace-guarded-view-alias" $ \dir -> do
        let store = StorePath (dir </> "store")
            utilPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
            guardTerm = result (evalTricu viewTestEnv (parseTricu "(x : t 30 [(t 0 x)])"))
            expectedView = VTFn [VTGuarded (VTRefText "UserId") guardTerm] (VTGuarded (VTRefText "UserId") guardTerm)
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile utilPath "UserId = t 7 [(t 8 (t 2 [(t 2 \"UserId\")])) (t 9 (x : t 30 [(t 0 x)]))]\nidUser x@UserId =@UserId x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.idUser 1\n"
        _ <- evaluateFileWithStore (Just store) mainPath
        mAlias <- readAlias store ModuleAlias "util"
        case mAlias of
          Nothing -> assertFailure "expected util module alias"
          Just ref -> do
            mManifest <- getManifest store (objectRefHash ref)
            case mManifest of
              Nothing -> assertFailure "expected util module manifest"
              Just manifest -> case find ((== "idUser") . unpack . moduleExportName) (moduleManifestExports manifest) of
                Nothing -> assertFailure "expected idUser export"
                Just ex -> do
                  objectRefKind (moduleExportObject ex) @?= viewTreeKind
                  moduleExportAbi ex @?= "arboricx.abi.view-tree.v1"
                  loadedTree <- getViewTree store (moduleExportObject ex)
                  case moduleExportView ex of
                    Nothing -> assertFailure "expected idUser view ref"
                    Just viewRef -> do
                      objectRefKind viewRef @?= viewContractTypeKind
                      view <- getViewType store viewRef
                      view @?= Right expectedView
                      case loadedTree of
                        Left err -> assertFailure err
                        Right tree -> do
                          rootTerm <- either assertFailure pure (viewTreeRootTerm tree)
                          tree @?= singletonViewTree (Just expectedView) rootTerm

  , testCase "Workspace modules reject malformed custom view aliases" $
      withSystemTempDirectory "tricu-workspace-malformed-view-alias" $ \dir -> do
        let store = StorePath (dir </> "store")
            utilPath = dir </> "util.tri"
            mainPath = dir </> "main.tri"
        writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
        writeFile utilPath "Bad = \"not a view\"\nidBad x@Bad =@Bad x\n"
        writeFile mainPath "!import \"util\" Util\n\nmain = Util.idBad 1\n"
        outcome <- try (evaluateFileWithStore (Just store) mainPath) :: IO (Either SomeException Env)
        case outcome of
          Right _ -> assertFailure "expected malformed custom view alias rejection"
          Left err -> show err `containsAll`
            [ "Workspace module"
            , "util"
            , "failed View Contract check"
            , "malformed view program"
            ]
        readAlias store ModuleAlias "util" >>= (@?= Nothing)

  , testCase "tricu check catches undersaturated annotated function calls via residual Fn view" $ do
      output <- checkSourceWithEnv allTestLibsEnv "f x@String y@String =@String x\nmain =@String f \"a\"\n"
      output @?= "symbol 5 (f application result) expected String but got Fn [String] String"

  , testCase "tricu check catches oversaturated annotated function calls via non-Fn result" $ do
      output <- checkSourceWithEnv allTestLibsEnv "f x@String y@String =@String x\nmain =@String f \"a\" \"b\" \"c\"\n"
      output @?= "symbol 9 (f application result) expected String but got Any"

  , testCase "tricu check source syntax demo includes callee-aware diagnostic" $ do
      output <- checkSourceWithEnv allTestLibsEnv "xs =@(List String) [(g \"hi\")]\ng y@String =@Bool y\n"
      output @?= "symbol 3 (g application result) expected String but got Bool"
  ]

-- --------------------------------------------------------------------------
-- IO driver tests
-- --------------------------------------------------------------------------

ioDriverTests :: TestTree
ioDriverTests = testGroup "IO driver tests"
  [ -- Existing behaviour tests
    testCase "View Contract checked-exec can produce an IO interaction tree" $ do
      final <- runIOSource $
        unlines
          [ "Any = viewAny"
          , "ioSentinel? = (value : and? (equal? (fst value) \"tricuIO\") (equal? (fst (snd value)) 1))"
          , "requireIO = (value : lazyBool (_ : guardOk value) (_ : guardFail) (ioSentinel? value))"
          , "viewIO = viewGuarded Any requireIO"
          , "checkedIO = (action : matchResult (diag env : io (pure (renderDiagnostic diag))) (exec env : matchResult (runtimeDiag runtimeEnv : io (pure (renderDiagnostic runtimeDiag))) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewIO action)])))"
          , "main = checkedIO (io (pure \"checked hello\"))"
          ]
      final @?= ofString "checked hello"

  , testCase "View Contract IO guard rejects non-interaction-tree root" $ do
      final <- runIOSource $
        unlines
          [ "Any = viewAny"
          , "ioSentinel? = (value : and? (equal? (fst value) \"tricuIO\") (equal? (fst (snd value)) 1))"
          , "requireIO = (value : lazyBool (_ : guardOk value) (_ : guardFail) (ioSentinel? value))"
          , "viewIO = viewGuarded Any requireIO"
          , "checkedIO = (action : matchResult (diag env : io (pure (renderDiagnostic diag))) (exec env : matchResult (runtimeDiag runtimeEnv : io (pure (renderDiagnostic runtimeDiag))) (value runtimeEnv : value) (runChecked exec)) (checkTypedProgramWith policyStrict (typedProgram 0 [(typedValue 0 viewIO action)])))"
          , "main = checkedIO \"not io\""
          ]
      final @?= ofString "guard failed at root typedValue symbol 0 for Guarded Any"

  , testCase "source sugar enforces pure View Contracts inside IO continuations" $ do
      final <- runIOSource $
        unlines
          [ "requireNonEmpty = (xs : lazyBool (_ : guardFail) (_ : guardOk xs) (emptyList? xs))"
          , "NonEmptyList elem = viewGuarded (viewList elem) requireNonEmpty"
          , "acceptNames xs@(NonEmptyList String) =@String \"accepted\""
          , "main = io (bind (pure []) (xs : pure (acceptNames xs)))"
          ]
      final @?= ofString "guard failed at argument 0 of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded List String"

  , testCase "source sugar enforces nested pure View Contracts inside IO continuations" $ do
      final <- runIOSource $
        unlines
          [ "requireNonEmpty = (xs : lazyBool (_ : guardFail) (_ : guardOk xs) (emptyList? xs))"
          , "NonEmptyList elem = viewGuarded (viewList elem) requireNonEmpty"
          , "acceptNames xs@(NonEmptyList String) =@String \"accepted\""
          , "main = io (bind (pure []) (xs : pure (append (acceptNames xs) \"!\")))"
          ]
      final @?= ofString "guard failed at typedValue symbol 2 for Guarded List String"

  , testCase "source sugar enforces higher-order View Contracts inside IO continuations" $ do
      final <- runIOSource $
        unlines
          [ "requireNonEmpty = (xs : lazyBool (_ : guardFail) (_ : guardOk xs) (emptyList? xs))"
          , "NonEmptyList elem = viewGuarded (viewList elem) requireNonEmpty"
          , "acceptNames xs@(NonEmptyList String) =@String \"accepted\""
          , "useHandler handler@(Fn [(NonEmptyList String)] String) xs@(List String) =@String handler xs"
          , "main = io (bind (pure []) (xs : pure (useHandler acceptNames xs)))"
          ]
      final @?= ofString "guard failed at typedRequire symbol 1 for Guarded List String"

  , 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
  checkedAst <- case instrumentIOContinuations (parseTricu source) of
    Left err -> assertFailure err
    Right asts -> pure asts
  let evalEnv = evalTricu allTestLibsEnv checkedAst
  let 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)