module Main where

import Eval
import FileEval
import Lexer
import Parser
import REPL
import Research
import Wire
import ContentStore

import Control.Exception      (evaluate, try, SomeException)
import Control.Monad.IO.Class (liftIO)
import Data.Bits              (xor)
import Data.List              (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.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Set as Set
import Database.SQLite.Simple (close, Connection)

main :: IO ()
main = defaultMain tests

tricuTestString :: String -> String
tricuTestString s = show $ result (evalTricu Map.empty $ parseTricu s)

tests :: TestTree
tests = testGroup "Tricu Tests"
  [ lexer
  , parser
  , simpleEvaluation
  , lambdas
  , providedLibraries
  , fileEval
  , modules
  , demos
  , decoding
  , elimLambdaSingle
  , stressElimLambda
  , byteMarshallingTests
  , wireTests
  , byteListUtilities
  , binaryReaderTests
  ]

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

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

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

providedLibraries :: TestTree
providedLibraries = testGroup "Library Tests"
  [ testCase "Triage test Leaf" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "test t"
          env = decodeResult $ result $ evalTricu library (parseTricu input)
      env @?= "\"Leaf\""

  , testCase "Triage test (Stem Leaf)" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "test (t t)"
          env = decodeResult $ result $ evalTricu library (parseTricu input)
      env @?= "\"Stem\""

  , testCase "Triage test (Fork Leaf Leaf)" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "test (t t t)"
          env = decodeResult $ result $ evalTricu library (parseTricu input)
      env @?= "\"Fork\""

  , testCase "Boolean NOT: true" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "not? true"
          env = result $ evalTricu library (parseTricu input)
      env @?= Leaf

  , testCase "Boolean NOT: false" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "not? false"
          env = result $ evalTricu library (parseTricu input)
      env @?= Stem Leaf


  , testCase "Boolean AND TF" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "and? (t t) (t)"
          env = evalTricu library (parseTricu input)
      result env @?= Leaf

  , testCase "Boolean AND FT" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "and? (t) (t t)"
          env = evalTricu library (parseTricu input)
      result env @?= Leaf

  , testCase "Boolean AND FF" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "and? (t) (t)"
          env = evalTricu library (parseTricu input)
      result env @?= Leaf

  , testCase "Boolean AND TT" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "and? (t t) (t t)"
          env = evalTricu library (parseTricu input)
      result env @?= Stem Leaf

  , testCase "List head" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "head [(t) (t t) (t t t)]"
          env = evalTricu library (parseTricu input)
      result env @?= Leaf

  , testCase "List tail" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "head (tail (tail [(t) (t t) (t t t)]))"
          env = evalTricu library (parseTricu input)
      result env @?= Fork Leaf Leaf

  , testCase "List map" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))"
          env = evalTricu library (parseTricu input)
      result env @?= Fork Leaf Leaf

  , testCase "Empty list check" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "emptyList? []"
          env = evalTricu library (parseTricu input)
      result env @?= Stem Leaf

  , testCase "Non-empty list check" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "not? (emptyList? [(1) (2) (3)])"
          env = evalTricu library (parseTricu input)
      result env @?= Stem Leaf

  , testCase "Concatenate strings" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "append \"Hello, \" \"world!\""
          env = decodeResult $ result $ evalTricu library (parseTricu input)
      env @?= "\"Hello, world!\""

  , testCase "Verifying Equality" $ do
      library <- evaluateFile "./lib/list.tri"
      let input = "equal? (t t t) (t t t)"
          env = evalTricu library (parseTricu input)
      result env @?= Stem Leaf
  ]

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
      library <- liftIO $ evaluateFile "./lib/list.tri"
      fEnv    <- liftIO $ evaluateFileWithContext library "./test/map.tri"
      (mainResult fEnv) @?= Stem Leaf

  , testCase "Eval and decoding string" $ do
      library <- liftIO $ evaluateFile "./lib/list.tri"
      res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
      decodeResult (result res) @?= "\"String test!\""
  ]

modules :: TestTree
modules = testGroup "Test modules"
  [ testCase "Detect cyclic dependencies" $ do
      result <- try (liftIO $ evaluateFileResult "./test/cycle-1.tri") :: IO (Either SomeException T)
      case result of
        Left e -> do
          let errorMsg = show e
          if "Encountered cyclic import" `isInfixOf` errorMsg
            then return ()
            else assertFailure $ "Unexpected error: " ++ errorMsg
        Right _ -> assertFailure "Expected cyclic dependencies"
  , testCase "Module imports and namespacing" $ do
      res <- liftIO $ evaluateFileResult "./test/namespace-A.tri"
      res @?= Leaf
  , testCase "Multiple imports" $ do
      res <- liftIO $ evaluateFileResult "./test/vars-A.tri"
      res @?= Leaf
  , testCase "Error on unresolved variable" $ do
      result <- try (liftIO $ evaluateFileResult "./test/unresolved-A.tri") :: IO (Either SomeException T)
      case result of
        Left e -> do
          let errorMsg = show e
          if "undefinedVar" `isInfixOf` errorMsg
            then return ()
            else assertFailure $ "Unexpected error: " ++ errorMsg
        Right _ -> assertFailure "Expected unresolved variable error"
  , testCase "Multi-level imports" $ do
      res <- liftIO $ evaluateFileResult "./test/multi-level-A.tri"
      res @?= Leaf
  , testCase "Lambda expression namespaces" $ do
      res <- liftIO $ evaluateFileResult "./test/lambda-A.tri"
      res @?= Leaf
  , testCase "Local namespace import chain" $ do
      res <- liftIO $ evaluateFileResult "./test/local-ns/1.tri"
      res @?=  Fork (Stem Leaf) (Fork (Stem Leaf) Leaf)
  ]


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

-- --------------------------------------------------------------------------
-- Wire module tests
-- --------------------------------------------------------------------------

-- | Helper: create a temporary file-backed DB, store a term, return the
--   connection and the term (so callers can compare after round-trip).
storeTermInTempDB :: String -> IO (Connection, Text, T)
storeTermInTempDB src = do
  conn <- newContentStore
  let asts     = parseTricu src
      finalEnv = evalTricu Map.empty asts
      term     = result finalEnv
  -- storeMerkleNodes returns MerkleHash as Text; storeTerm expects [String]
  _ <- storeTerm conn [] term
  return (conn, hashTerm term, term)

-- | Load a term from a DB by its stored hash Text.
loadTermByHash :: Connection -> Text -> IO T
loadTermByHash conn h = do
  maybeTerm <- loadTree conn h
  case maybeTerm of
    Just t  -> return t
    Nothing -> errorWithoutStackTrace $ "hash not found in store: " ++ Data.Text.unpack h

-- | Flip one byte in a ByteString at the given index.
corruptByte :: ByteString -> Int -> ByteString
corruptByte bs i = BS.take i bs <> BS.pack [(BS.index bs i `xor` 0x01)] <> BS.drop (i + 1) bs

wireTests :: TestTree
wireTests = testGroup "Wire Tests"
  [ testCase "Portable bundle: header and manifest declare Tree Calculus object format" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "id = a : a"
        , "main = id t"
        ]
      wireData <- exportBundle srcConn [termHash]
      BS.take 8 wireData @?= BS.pack [0x41, 0x52, 0x42, 0x4f, 0x52, 0x49, 0x58, 0x00]
      case decodeBundle wireData of
        Left err -> assertFailure $ "decodeBundle failed: " ++ err
        Right bundle -> do
          let manifest = bundleManifest bundle
              tree = manifestTree manifest
              hashSpec = treeNodeHash tree
              runtime = manifestRuntime manifest
          manifestSchema manifest @?= "arborix.bundle.manifest.v1"
          manifestBundleType manifest @?= "tree-calculus-executable-object"
          manifestClosure manifest @?= ClosureComplete
          treeCalculus tree @?= "tree-calculus.v1"
          treeNodePayload tree @?= "arborix.merkle.payload.v1"
          nodeHashAlgorithm hashSpec @?= "sha256"
          nodeHashDomain hashSpec @?= "arborix.merkle.node.v1"
          runtimeSemantics runtime @?= "tree-calculus.v1"
          runtimeAbi runtime @?= "arborix.abi.tree.v1"
          runtimeCapabilities runtime @?= []
          bundleRoots bundle @?= [termHash]
          map exportRoot (manifestExports manifest) @?= [termHash]
      close srcConn

  , testCase "Portable bundle: named exports are manifest aliases for Merkle roots" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "validateEmail = a : a"
        , "main = validateEmail t"
        ]
      wireData <- exportNamedBundle srcConn [("validateEmail", termHash)]
      case decodeBundle wireData of
        Left err -> assertFailure $ "decodeBundle failed: " ++ err
        Right bundle -> do
          bundleRoots bundle @?= [termHash]
          case manifestExports (bundleManifest bundle) of
            [exported] -> do
              exportName exported @?= "validateEmail"
              exportRoot exported @?= termHash
              exportKind exported @?= "term"
              exportAbi exported @?= "arborix.abi.tree.v1"
            exports -> assertFailure $ "Expected one export, got: " ++ show exports
      close srcConn

  , testCase "Portable bundle: renaming an export changes bundle bytes but not tree identity" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "f = a : a"
        , "main = f t"
        ]
      mainBundleData <- exportNamedBundle srcConn [("main", termHash)]
      renamedBundleData <- exportNamedBundle srcConn [("validate", termHash)]
      assertBool "Renaming an export should change the manifest/bundle bytes"
        (mainBundleData /= renamedBundleData)
      case (decodeBundle mainBundleData, decodeBundle renamedBundleData) of
        (Right mainBundle, Right renamedBundle) -> do
          bundleRoots mainBundle @?= [termHash]
          bundleRoots renamedBundle @?= [termHash]
          map exportRoot (manifestExports $ bundleManifest mainBundle)
            @?= map exportRoot (manifestExports $ bundleManifest renamedBundle)
          map exportName (manifestExports $ bundleManifest mainBundle) @?= ["main"]
          map exportName (manifestExports $ bundleManifest renamedBundle) @?= ["validate"]
        (Left err, _) -> assertFailure $ "decodeBundle main failed: " ++ err
        (_, Left err) -> assertFailure $ "decodeBundle renamed failed: " ++ err
      close srcConn

  , testCase "Portable bundle: exact byte export is deterministic" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "x = t t"
        , "main = t x"
        ]
      first <- exportBundle srcConn [termHash]
      second <- exportBundle srcConn [termHash]
      first @?= second
      close srcConn

  , testCase "Portable bundle: raw section tampering is rejected by digest verification" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "x = t"
        , "main = t x"
        ]
      wireData <- exportBundle srcConn [termHash]
      let tampered = corruptByte wireData (BS.length wireData - 1)
      case decodeBundle tampered of
        Left err -> assertBool ("Expected section digest mismatch, got: " ++ err)
          ("digest mismatch" `isInfixOf` err)
        Right _ -> assertFailure "Expected decodeBundle to reject tampered section bytes"
      close srcConn

  , testCase "Portable bundle: unsupported manifest semantics are rejected" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "x = t"
        , "main = t x"
        ]
      wireData <- exportBundle srcConn [termHash]
      case decodeBundle wireData of
        Left err -> assertFailure $ "decodeBundle failed: " ++ err
        Right bundle -> do
          let 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"
      close srcConn

  , testCase "Portable bundle: import registers manifest export names in fresh content store" $ do
      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
        [ "validateEmail = a : a"
        , "main = validateEmail t"
        ]
      wireData <- exportNamedBundle srcConn [("validateEmail", termHash)]
      dstConn <- newContentStore
      _ <- importBundle dstConn wireData
      loadedByHash <- loadTermByHash dstConn termHash
      loadedByName <- loadTerm dstConn "validateEmail"
      loadedByHash @?= originalTerm
      loadedByName @?= Just originalTerm
      close srcConn
      close dstConn

  , testCase "Round-trip: store, export, import, load" $ do
      -- Store a term
      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
        [ "x = t"
        , "y = t x"
        , "z = t y"
        , "main = z"
        ]
      -- Export by root hash
      wireData <- exportBundle srcConn [termHash]
      -- Import into a fresh DB
      dstConn <- newContentStore
      _ <- importBundle dstConn wireData
      -- Load the term back and compare
      loadedTerm <- loadTermByHash dstConn termHash
      loadedTerm @?= originalTerm
      -- Cleanup
      close srcConn
      close dstConn

  , testCase "Round-trip: evaluate from original, export, import, load root" $ do
      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
        [ "add = a b : t (t a) b"
        , "val = add (t t) (t)"
        , "main = val"
        ]
      -- Export
      wireData <- exportBundle srcConn [termHash]
      -- Import into fresh DB
      dstConn <- newContentStore
      _ <- importBundle dstConn wireData
      -- Load the root term by hash and compare
      loadedTerm <- loadTermByHash dstConn termHash
      loadedTerm @?= originalTerm
      close srcConn
      close dstConn

  , testCase "Negative: corrupt payload byte causes import to fail" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "x = t"
        , "y = t x"
        , "z = t y"
        , "main = z"
        ]
      wireData <- exportBundle srcConn [termHash]
      -- Decode, mutate one node's payload byte, re-encode
      case decodeBundle wireData of
        Left err -> assertFailure $ "decodeBundle failed: " ++ err
        Right bundle -> do
          let (h, payload) =
                head
                  [ (h', p)
                  | (h', p) <- Map.toList (bundleNodes bundle)
                  , BS.length p > 0
                  ]
              payload' = BS.pack [(BS.head payload `xor` 0x01)] <> BS.tail payload
              bundle' = bundle { bundleNodes = Map.insert h payload' (bundleNodes bundle) }
              wireData' = encodeBundle bundle'
          dstConn <- newContentStore
          result <- try (importBundle dstConn wireData') :: IO (Either SomeException [MerkleHash])
          case result of
            Left e ->
              assertBool ("Expected hash mismatch or invalid payload, got: " ++ show e)
                $ "mismatch" `isInfixOf` show e || "invalid" `isInfixOf` show e
            Right _ ->
              assertFailure "Expected import to fail on corrupted payload"
          close dstConn
      close srcConn

  , testCase "Negative: missing child node causes import to fail" $ do
      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
        [ "x = t"
        , "y = t x"
        , "z = t y"
        , "main = z"
        ]
      wireData <- exportBundle srcConn [termHash]
      -- Decode, remove a node, re-encode
      case decodeBundle wireData of
        Left err -> assertFailure $ "decodeBundle failed: " ++ err
        Right bundle -> do
          let nodeList = Map.toList (bundleNodes bundle)
              trimmed = Map.fromList (tail nodeList)
              newBundle = bundle { bundleNodes = trimmed }
              newWire = encodeBundle newBundle
          dstConn <- newContentStore
          result <- try (importBundle dstConn newWire) :: IO (Either SomeException [MerkleHash])
          case result of
            Left e ->
              assertBool ("Expected verify error, got: " ++ show e) True
            Right _ ->
              assertFailure "Expected import to fail on missing child node"
          close dstConn
      close srcConn
    ]

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

byteListUtilities :: TestTree
byteListUtilities = testGroup "Byte List Utility Tests"
  [ testCase "isNil: empty list is nil" $ do
      let input = "bytesNil? []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= trueT

  , testCase "isNil: non-empty list is not nil" $ do
      let input = "bytesNil? [(1)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT

  , testCase "head: empty list is nothing" $ do
      let input = "bytesHead []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= nothingT

  , testCase "head: non-empty list returns first element" $ do
      let input = "bytesHead [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= justT (byteT 1)

  , testCase "tail: empty list is nothing" $ do
      let input = "bytesTail []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= nothingT

  , testCase "tail: non-empty list returns rest" $ do
      let input = "bytesTail [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= justT (bytesT [2])

  , testCase "length: empty list is zero" $ do
      let input = "bytesLength []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= ofNumber 0

  , testCase "length: single element list is one" $ do
      let input = "bytesLength [(1)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= ofNumber 1

  , testCase "length: three element list is three" $ do
      let input = "bytesLength [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= ofNumber 3

  , testCase "append: empty ++ [1,2] = [1,2]" $ do
      let input = "bytesAppend [] [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2]

  , testCase "append: [1,2] ++ [3] = [1,2,3]" $ do
      let input = "bytesAppend [(1) (2)] [(3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2,3]

  , testCase "append: [1,2] ++ empty = [1,2]" $ do
      let input = "bytesAppend [(1) (2)] []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2]

  , testCase "take: take 0 any list = empty" $ do
      let input = "bytesTake 0 [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT []

  , testCase "take: take 2 [1,2,3] = [1,2]" $ do
      let input = "bytesTake 2 [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2]

  , testCase "take: take 5 [1,2] = [1,2] (overlong)" $ do
      let input = "bytesTake 5 [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2]

  , testCase "drop: drop 0 any list = list" $ do
      let input = "bytesDrop 0 [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [1,2,3]

  , testCase "drop: drop 2 [1,2,3] = [3]" $ do
      let input = "bytesDrop 2 [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [3]

  , testCase "drop: drop 5 [1,2] = empty (overlong)" $ do
      let input = "bytesDrop 5 [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT []

  , testCase "splitAt: splitAt 0 [1,2] = pair [] [1,2]" $ do
      let input = "bytesSplitAt 0 [(1) (2)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (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)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (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)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= pairT (bytesT [1,2]) (bytesT [])

  , testCase "byteEq: equal bytes are equal" $ do
      let input = "byteEq? 1 1"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= trueT

  , testCase "byteEq: unequal bytes are not equal" $ do
      let input = "byteEq? 1 2"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT

  , testCase "bytesEq: empty == empty" $ do
      let input = "bytesEq? [] []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= trueT

  , testCase "bytesEq: empty != [1]" $ do
      let input = "bytesEq? [] [(1)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT

  , testCase "bytesEq: [1] != empty" $ do
      let input = "bytesEq? [(1)] []"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT

  , testCase "bytesEq: equal lists are equal" $ do
      let input = "bytesEq? [(1) (2) (3)] [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= trueT

  , testCase "bytesEq: different last element" $ do
      let input = "bytesEq? [(1) (2) (3)] [(1) (2) (4)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT

  , testCase "bytesEq: different lengths" $ do
      let input = "bytesEq? [(1) (2)] [(1) (2) (3)]"
      library <- evaluateFile "./lib/bytes.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= falseT
  ]

-- --------------------------------------------------------------------------
-- Binary reader tests (binary.tri)
-- --------------------------------------------------------------------------
okT :: T -> T -> T
okT value rest = pairT trueT (pairT value rest)

errT :: T -> T -> T
errT code rest = pairT falseT (pairT code rest)

eofT :: T
eofT = byteT 1

unitT :: T
unitT = Leaf

unexpectedBytesT :: T
unexpectedBytesT = byteT 2

unexpectedByteT :: T
unexpectedByteT = byteT 3

binaryReaderTests :: TestTree
binaryReaderTests = testGroup "Binary Reader Tests"
  [ testCase "readU8: empty input returns err" $ do
      let input = "readU8 []"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [])

  , testCase "readU8: single byte returns ok" $ do
      let input = "readU8 [(7)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (byteT 7) (bytesT [])

  , testCase "readU8: multi-byte returns first byte and rest" $ do
      let input = "readU8 [(7) (8)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (byteT 7) (bytesT [8])

  , testCase "readBytes 0: returns ok with empty bytes and original input" $ do
      let input = "readBytes 0 [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT []) (bytesT [1,2])

  , testCase "readBytes 2: exact read returns ok with taken and rest" $ do
      let input = "readBytes 2 [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2]) (bytesT [3])

  , testCase "readBytes 3: exact read with no remainder" $ do
      let input = "readBytes 3 [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2,3]) (bytesT [])

  , testCase "readBytes 5: overlong read returns err preserving input" $ do
      let input = "readBytes 5 [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1,2])

  -- ------------------------------------------------------------------------
  -- Binary Result Matcher Tests
  -- ------------------------------------------------------------------------

  , testCase "matchResult: ok branch returns value" $ do
      let input = "matchResult (code rest : 0) (value rest : value) (ok 7 [])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= byteT 7

  , testCase "matchResult: err branch returns code" $ do
      let input = "matchResult (code rest : code) (value rest : 0) (err 1 [])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= byteT 1

  , testCase "matchResult: ok branch receives rest" $ do
      let input = "matchResult (code rest : []) (value rest : rest) (ok 7 [(8)])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [8]

  , testCase "matchResult: err branch receives rest" $ do
      let input = "matchResult (code rest : rest) (value rest : []) (err 1 [(7) (8)])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= bytesT [7,8]

  , testCase "matchResult: transforms readU8 ok result" $ do
      let input = "matchResult (code rest : code) (value rest : value) (readU8 [(7) (8)])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= byteT 7

  , testCase "matchResult: transforms readU8 err result" $ do
      let input = "matchResult (code rest : code) (value rest : value) (readU8 [])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= byteT 1

  -- ------------------------------------------------------------------------
  -- Binary expectBytes Tests
  -- ------------------------------------------------------------------------

  , testCase "expectBytes: empty expected matches and preserves input" $ do
      let input = "expectBytes [] [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT unitT (bytesT [1,2])

  , testCase "expectBytes: single byte consumed, rest preserved" $ do
      let input = "expectBytes [(1)] [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT unitT (bytesT [2])

  , testCase "expectBytes: exact match with trailing data" $ do
      let input = "expectBytes [(1) (2)] [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT unitT (bytesT [3])

  , testCase "expectBytes: mismatch returns err with original input" $ do
      let input = "expectBytes [(1) (2)] [(1) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT unexpectedBytesT (bytesT [1,3])

  , testCase "expectBytes: overlong expected returns errEof with original input" $ do
      let input = "expectBytes [(1) (2) (3)] [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1,2])

  -- ------------------------------------------------------------------------
  -- Binary expectU8 Tests
  -- ------------------------------------------------------------------------

  , testCase "expectU8: matches and preserves rest" $ do
      let input = "expectU8 7 [(7) (8)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT unitT (bytesT [8])

  , testCase "expectU8: mismatch returns err with original input" $ do
      let input = "expectU8 7 [(8)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT unexpectedByteT (bytesT [8])

  , testCase "expectU8: empty input returns errEof with original input" $ do
      let input = "expectU8 7 []"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [])

  -- ------------------------------------------------------------------------
  -- Binary fixed-size readers (read2 / read4)
  -- ------------------------------------------------------------------------

  , testCase "read2: reads two bytes and preserves rest" $ do
      let input = "read2 [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2]) (bytesT [3])

  , testCase "read2: exact two-byte read" $ do
      let input = "read2 [(1) (2)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2]) (bytesT [])

  , testCase "read2: one byte returns EOF preserving input" $ do
      let input = "read2 [(1)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1])

  , testCase "read2: empty input returns EOF" $ do
      let input = "read2 []"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [])

  , testCase "read4: reads four bytes and preserves rest" $ do
      let input = "read4 [(1) (2) (3) (4) (5)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2,3,4]) (bytesT [5])

  , testCase "read4: exact four-byte read" $ do
      let input = "read4 [(1) (2) (3) (4)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2,3,4]) (bytesT [])

  , testCase "read4: short input returns EOF preserving input" $ do
      let input = "read4 [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1,2,3])

  , testCase "read4: empty input returns EOF" $ do
      let input = "read4 []"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [])

  -- ------------------------------------------------------------------------
  -- Binary Result sequencing combinators (mapResult / bindResult)
  -- ------------------------------------------------------------------------

  , testCase "mapResult: maps ok value and preserves rest" $ do
      let input = "mapResult (x : bytesLength x) (ok [(1) (2)] [(3)])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (ofNumber 2) (bytesT [3])

  , testCase "mapResult: preserves err unchanged" $ do
      let input = "mapResult (x : bytesLength x) (err 1 [(7)])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [7])

  , testCase "bindResult: ok invokes continuation" $ do
      let input = "bindResult (ok 7 [(8)]) (value rest : ok rest [])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [8]) (bytesT [])

  , testCase "bindResult: err skips continuation" $ do
      let input = "bindResult (err 1 [(8)]) (value rest : ok value [])"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [8])

  -- ------------------------------------------------------------------------
  -- Binary fixed-size byte readers with BE byte-swap naming
  -- ------------------------------------------------------------------------

  , testCase "readU16BEBytes: reads two raw bytes" $ do
      let input = "readU16BEBytes [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2]) (bytesT [3])

  , testCase "readU16BEBytes: short input EOF" $ do
      let input = "readU16BEBytes [(1)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1])

  , testCase "readU32BEBytes: reads four raw bytes" $ do
      let input = "readU32BEBytes [(1) (2) (3) (4) (5)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT (bytesT [1,2,3,4]) (bytesT [5])

  , testCase "readU32BEBytes: short input EOF" $ do
      let input = "readU32BEBytes [(1) (2) (3)]"
      library <- evaluateFile "./lib/binary.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [1,2,3])

  -- ------------------------------------------------------------------------
  -- Arborix magic recognition
  -- ------------------------------------------------------------------------

  , testCase "readArborixMagic: accepts magic and preserves rest" $ do
      let input = "readArborixMagic [(65) (82) (66) (79) (82) (73) (88) (0) (1) (2)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT unitT (bytesT [1,2])

  , testCase "readArborixMagic: rejects wrong magic preserving input" $ do
      let input = "readArborixMagic [(65) (82) (66) (79) (82) (73) (88) (1) (9)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT unexpectedBytesT (bytesT [65,82,66,79,82,73,88,1,9])

  , testCase "readArborixMagic: short input returns EOF preserving input" $ do
      let input = "readArborixMagic [(65) (82) (66) (79)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [65,82,66,79])

  -- ------------------------------------------------------------------------
  -- Arborix header parsing
  -- ------------------------------------------------------------------------

  , testCase "readArborixHeader: parses version and section count" $ do
      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT
        (pairT (bytesT [0,1])
          (pairT (bytesT [0,0])
            (bytesT [0,0,0,0])))
        (bytesT [])

  , testCase "readArborixHeader: preserves trailing bytes" $ do
      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0) (9) (8)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= okT
        (pairT (bytesT [0,1])
          (pairT (bytesT [0,0])
            (bytesT [0,0,0,0])))
        (bytesT [9,8])

  , testCase "readArborixHeader: rejects wrong magic preserving input" $ do
      let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (1) (0) (1)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT unexpectedBytesT (bytesT [65,82,66,79,82,73,88,1,0,1])

  , testCase "readArborixHeader: short input returns EOF preserving input" $ do
      let input = "readArborixHeader [(65) (82)]"
      library <- evaluateFile "./lib/arborix.tri"
      let env = evalTricu library (parseTricu input)
      result env @?= errT eofT (bytesT [65,82])
  ]