From e33ab4af2abbd6da1ab24663078bb845befd0557 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Tue, 12 May 2026 18:38:24 -0500 Subject: [PATCH] feat(haskell): Interaction Tree IO oops, now we have purely modelled IO :shrug: --- docs/io-in-tricu.md | 354 ++++++++++++++++++++++++++++++++++++++++++++ lib/base.tri | 15 ++ lib/binary.tri | 15 -- lib/conversions.tri | 39 +++++ lib/io.tri | 83 +++++++++++ src/IODriver.hs | 120 +++++++++++++++ src/Main.hs | 36 ++++- test/Spec.hs | 58 ++++++++ tricu.cabal | 4 + 9 files changed, 704 insertions(+), 20 deletions(-) create mode 100644 docs/io-in-tricu.md create mode 100644 lib/conversions.tri create mode 100644 lib/io.tri create mode 100644 src/IODriver.hs diff --git a/docs/io-in-tricu.md b/docs/io-in-tricu.md new file mode 100644 index 0000000..d727aac --- /dev/null +++ b/docs/io-in-tricu.md @@ -0,0 +1,354 @@ +# IO in tricu + +> Host-interpreted interaction trees in Tree Calculus. + +## Philosophy + +tricu is a pure language. Its runtime consists entirely of the `T` type +(`Leaf | Stem T | Fork T T`) and the `apply` reduction rules. Nothing in +the calculus can mutate the world, read a file, or talk to a network. + +This document describes how IO is layered *above* the calculus, not baked +into it. The mechanism is structurally identical to how strings and integers +already work in tricu: source-level constructs that evaluate to pure trees, +which the host interprets according to convention. + +The result is **free-monadic IO** without extending the language runtime, +adding AST nodes, or requiring a type system. The calculus stays pure; the +host alternates between impure actions and pure evaluation. + +--- + +## How it works: the two-phase boundary + +### Phase 1 — Pure evaluation + +A tricu program containing IO constructs is parsed, lambda-eliminated, and +reduced exactly like any other program. `apply` never performs a side +effect. The result is a first-class tree value. + +### Phase 2 — Host execution + +After pure evaluation completes, the host inspects the result. If it carries +the `"tricuIO"` sentinel, the host strips the sentinel and enters a driver loop +that walks the inner action tree, performing effects and calling back into +the pure evaluator between each step. + +This "ping-pong" between host and calculus is the only place impurity lives. + +--- + +## The IO tree encoding + +### Top-level sentinel: `ofString "tricuIO"` + +The result of `main` must be a pair whose left element is the tree-encoded +string `"tricuIO"` and whose right element is a versioned action: + +``` +Fork +├── ofString "tricuIO" -- sentinel (142 nodes) +└── Fork + ├── ofNumber 1 -- ABI version + └── action -- the actual IO program tree +``` + +The `io` constructor in `lib/io.tri` bakes in the version: + +```tri +io = action : pair "tricuIO" (pair 1 action) +``` + +The sentinel serves two purposes: + +1. **Collision resistance.** A 142-node specific structure is effectively + impossible to produce by accident in ordinary data. +2. **Self-describing debuggability.** Evaluating `main` without the `--io` + flag prints `{"tricuIO", [1, ...]}` literally, making the intent obvious. + +The host checks: *is the root a `Fork` whose left child is equal to +`ofString "tricuIO"` and whose right child is a `pair version action`?* +If the version is unrecognized, the driver aborts with a clear error. +Otherwise it enters IO mode on the action tree. + +### Constructor payloads + +The action tree uses tagged pairs. Tags are small integers (the existing +tricu number encoding) because they are inspected on every loop iteration. +The payload of each constructor is built with `pair` (i.e. `Fork`). + +| Tag | Constructor | Payload shape | Continuation receives | +|-----|-------------|---------------|----------------------| +| `0` | `Pure result` | `result` | (terminal) | +| `1` | `PutStr string k` | `pair string k` | `t` (unit) | +| `2` | `GetLine k` | `k` | `String` | +| `3` | `ReadFile path k` | `pair path k` | `Result IOError String` | +| `4` | `WriteFile path contents k` | `pair path (pair contents k)` | `Result IOError Unit` | + +Tag `0` (`Pure`) is the terminal node. All other constructors carry a +continuation `k` — a tricu function (a tree) that the host applies to the +operation's result to obtain the next action. + +### Result encoding + +File operations return explicit `Result` values using the same encoding as +`lib/binary.tri`. Because there is no remaining stream, the `rest` field is +always `t` (unit): + +```tri +ok = value : pair true (pair value t) +err = code : pair false (pair code t) +``` + +The host never throws raw exceptions. It translates OS failures (file not +found, permission denied, etc.) into `err` trees with numeric codes and +hands them to the continuation. The tricu program decides what to do with +them. + +### Visual example: `putStr "hi"` + +After pure evaluation, `main = io (putStr "hi" (\_ : pure t))` becomes: + +``` +Fork +├── ofString "tricuIO" +└── Fork + ├── ofNumber 1 -- ABI version + └── Fork + ├── ofNumber 1 -- PutStr tag + └── Fork -- pair "hi" k + ├── ofString "hi" + │ └── Fork + │ ├── ofNumber 104 -- 'h' + │ └── Fork + │ ├── ofNumber 105 -- 'i' + │ └── Leaf + └── k -- continuation function +``` + +The continuation `k` is the SKI-combinator-lowered body of `(\_ : pure t)`. +It is indistinguishable from ordinary data until the host `apply`s it to +a value and evaluates the result. + +--- + +## The host driver loop + +``` +runIO(env, actionTree): + case actionTree of + + Fork Leaf result: + -- Pure: done + return result + + Fork (Stem Leaf) (Fork str k): + -- PutStr + s = toString(str) + putStr(s) -- impure + next = evalASTSync(env, apply(k, t)) + return runIO(env, next) + + Fork (Fork Leaf (Stem Leaf)) k: + -- GetLine + line = getLine() -- impure + next = evalASTSync(env, apply(k, ofString(line))) + return runIO(env, next) + + Fork (Fork (Stem Leaf) Leaf) (Fork path k): + -- ReadFile + p = toString(path) + checkHostReadPermission(p) + result = hostReadFileAsResult(p) + next = evalASTSync(env, apply(k, result)) + return runIO(env, next) + + Fork (Fork (Stem Leaf) (Fork Leaf (Stem Leaf))) (Fork path (Fork contents k)): + -- WriteFile + p = toString(path) + c = toString(contents) + checkHostWritePermission(p) + result = hostWriteFileAsResult(p, c) + next = evalASTSync(env, apply(k, result)) + return runIO(env, next) +``` + +Key properties: + +- **No effects during `apply`.** The calculus stays pure. +- **Fresh pure evaluation per step.** After each impure action, the host + calls back into the ordinary evaluator to reduce the continuation. +- **First-class continuations.** The continuation is a tree; it can be + stored, passed around, or transformed by pure tricu code before the + host ever sees it. +- **Controlled failure.** File operations return `Result` trees; host + exceptions are caught and converted into `err` values before they reach + the calculus. + +--- + +## Library conventions (`lib/io.tri`) + +The IO constructors are ordinary tricu definitions. They are not primitives. + +```tri +io = action : pair "tricuIO" (pair 1 action) +pure = x : pair 0 x +putStr = s k : pair 1 (pair s k) +getLine = k : pair 2 k +readFile = p k : pair 3 (pair p k) +writeFile = p c k : pair 4 (pair p (pair c k)) +``` + +### Why `readFile` and `writeFile` are sufficient + +These two operations are powerful primitives on Unix-like systems. Standard +input, output, environment variables, pipes, and special files in `/proc` or +`/dev` are all reachable through the filesystem namespace. Additional +constructors (`GetEnv`, `ExitWith`, `GetArgs`) are convenience wrappers +that save the program from manually parsing `/proc/self/environ` or +writing exit codes to special paths. The host is free to restrict which +paths are accessible. + +--- + +## Example program + +```tri +!import "io.tri" !Local + +main = io ( + putStr "Name: " (\_ : + getLine (\name : + putStr "Hello, " (\_ : + putStr name (\_ : + pure t))))) +``` + +The program is written in continuation-passing style. Each operation +receives a continuation that receives the result and returns the next +action. This matches the underlying tree encoding directly. + +--- + +## Relationship to existing tricu features + +IO is not a new kind of extension. It follows the same pattern already used +for strings, integers, and lambda abstraction: + +| Feature | Source syntax | AST representation | Pure tree | Host interpretation | +|---------|---------------|-------------------|-----------|---------------------| +| Strings | `"hello"` | `SStr "hello"` | `ofString "hello"` | Display with quotes | +| Integers | `42` | `SInt 42` | `ofNumber 42` | Display as decimal | +| Lambdas | `(x : x)` | `SLambda ["x"] (SVar "x")` | SKI combinators | N/A — eliminated | +| IO | `io (...)` | `SApp` trees | Tagged sentinel pair | Enter driver loop | + +The `T` type, `apply`, and the parser's core grammar require **no changes**. +Only the host CLI and a new library file are needed. + +--- + +## Implementation notes for host authors + +### Required additions + +1. **`lib/io.tri`** — constructor definitions. +2. **Host sentinel check** — after evaluating `main`, test the root shape + and ABI version. +3. **`runIO` driver** — pattern-match on tags, alternate between effects and pure + `evalASTSync` calls. +4. **CLI integration** — an `--io` flag or `!run` REPL command to enable the driver. + +### Host contract: strict validation + +The IO driver must be a strict validator, not a permissive interpreter. + +- Every tag must have exactly the expected payload shape. A tag `1` without + a `pair string k` payload is a dynamic error. +- String payloads must decode cleanly with `toString`; malformed character + sequences must fail rather than silently truncate. +- File paths must satisfy host policy (e.g. sandboxing, disallow lists, + or capability restrictions). The host decides which paths are legal. +- File operations must return `Result` trees. Host exceptions are caught + and converted to `err` values before reaching the calculus. +- Continuations must reduce to another valid action tree or `Pure`. If the + pure evaluator returns an unrecognized shape, the driver aborts with a + clear dynamic error rather than guessing. +- Unrecognized ABI versions must be rejected immediately. + +These checks are runtime-only. The calculus does not enforce them; the host +does. + +### Recommended restrictions + +- Do **not** modify `apply` or `evalASTSync` to perform effects. Keep the + calculus pure. +- Do **not** add new `TricuAST` constructors for IO. Use ordinary `SApp` trees. +- Tag numbers are host convention; document them if you extend the set. +- The `"tricuIO"` sentinel string and the ABI version are part of the + convention. Changing either breaks compatibility. + +### Extending the IO vocabulary + +New constructors receive new tags, documented payload shapes, and explicit +result conventions. Existing programs that do not use the new tag are +unaffected. If a breaking change to payload shapes is ever needed, bump +the ABI version and teach the host to recognize both. + +--- + +## Comparison to Haskell's `IO` + +| Property | Haskell | tricu | +|----------|---------|-------| +| Purity guarantee | Type system (`IO` is a distinct type) | Host convention (sentinel check) | +| Sequencing shape | `RealWorld#` token threaded by RTS | Host driver loop calls pure evaluator between steps | +| Linearity | Enforced statically by compiler | Enforced dynamically by host loop (tree walked once) | +| Inspectability | `IO a` is opaque; cannot pattern-match | IO tree is first-class data; can be constructed, deconstructed, and transformed in pure tricu code | +| Entry point | `main :: IO ()` required by compiler | `main` checked for sentinel when `--io` is passed | + +Haskell's type system provides static guarantees. tricu provides a +Haskell-like sequencing shape that is dynamically enforced by host +interpretation. Incorrectly-shaped IO trees are caught at runtime, not +compile time. + +--- + +## Future-proofing + +The ABI is designed so that a future type system can describe the same +boundary statically without changing the runtime encoding. + +Conceptually, the constructors have stable shapes: + +```text +Pure : a -> IO a +PutStr : String -> (Unit -> IO a) -> IO a +GetLine : (String -> IO a) -> IO a +ReadFile : Path -> (Result IOError String -> IO a) -> IO a +WriteFile : Path -> String -> (Result IOError Unit -> IO a) -> IO a +``` + +Even though tricu cannot check these types today, the host preserves them: +- Every constructor has a predictable tag and documented payload layout. +- Every continuation receives exactly one well-defined result value. +- File operations return `Result` trees instead of throwing host exceptions. +- The ABI version marker leaves room for protocol evolution. + +Capabilities and sandboxing are host policy, not tree shape. The CLI should +restrict paths with flags such as `--allow-read` and `--allow-write`. A +future typed system may add unforgeable capability types; today's host +enforces restrictions dynamically. + +--- + +## Summary + +tricu programs construct pure descriptions of effects. The host executes one +submitted description according to policy. IO is not part of the calculus; +it is a **host convention** layered on top, using the same "host introduces +structured values" mechanism already employed for strings and numbers. The +result is a free-monadic interaction tree that any host can execute, any +program can manipulate as data, and any Merkle DAG can store. Sequencing +and linearity are enforced dynamically by the host, not statically by the +language. diff --git a/lib/base.tri b/lib/base.tri index a6e7641..7eadaaf 100644 --- a/lib/base.tri +++ b/lib/base.tri @@ -72,3 +72,18 @@ succ = y (self : (t (t t)) (_ tail : t t (self tail)) t)) + +ok = value rest : pair true (pair value rest) +err = code rest : pair false (pair code rest) + +matchResult = (errCase okCase result : + matchPair + (tag payload : + matchPair + (value rest : + matchBool + (okCase value rest) + (errCase value rest) + tag) + payload) + result) diff --git a/lib/binary.tri b/lib/binary.tri index b7f00e0..5c84117 100644 --- a/lib/binary.tri +++ b/lib/binary.tri @@ -6,21 +6,6 @@ errUnexpectedEof = 1 errUnexpectedBytes = 2 errUnexpectedByte = 3 -ok = value rest : pair true (pair value rest) -err = code rest : pair false (pair code rest) - -matchResult = (errCase okCase result : - matchPair - (tag payload : - matchPair - (value rest : - matchBool - (okCase value rest) - (errCase value rest) - tag) - payload) - result) - readU8 = (bytes : matchList (err errUnexpectedEof t) (h r : ok h r) diff --git a/lib/conversions.tri b/lib/conversions.tri new file mode 100644 index 0000000..f9de661 --- /dev/null +++ b/lib/conversions.tri @@ -0,0 +1,39 @@ +!import "base.tri" !Local +!import "list.tri" !Local + +pred = y (self : triage + 0 + (_ : 0) + (bit rest : + matchBool + -- odd: 2n + 1 -> 2n + (matchBool + 0 + (pair 0 rest) + (equal? rest 0)) + -- even: 2n -> 2n - 1 + (matchBool + 0 + (pair 1 (self rest)) + (equal? rest 0)) + bit)) + +incDecRev = y (self : matchList + "1" + (digit rest : + matchBool + (pair 48 (self rest)) + (pair (succ digit) rest) + (equal? digit 57))) + +showNumberRev_ = y (self n acc : + matchBool + acc + (self (pred n) (incDecRev acc)) + (equal? n 0)) + +showNumber = (n : + matchBool + "0" + (reverse (showNumberRev_ n t)) + (equal? n 0)) diff --git a/lib/io.tri b/lib/io.tri new file mode 100644 index 0000000..73e197b --- /dev/null +++ b/lib/io.tri @@ -0,0 +1,83 @@ +!import "base.tri" !Local +!import "binary.tri" !Local +!import "list.tri" !Local +!import "conversions.tri" !Local + +-- IO constructors for host-interpreted interaction trees. +-- See docs/io-in-tricu.md for the full protocol. + +version = 1 + +io = action : pair "tricuIO" (pair version action) +pure = x : pair 0 x +putStr = s k : pair 1 (pair s k) +getLine = k : pair 2 k +readFile = p k : pair 3 (pair p k) +writeFile = p c k : pair 4 (pair p (pair c k)) + +-- --------------------------------------------------------------------------- +-- CPS sequencing helpers +-- --------------------------------------------------------------------------- + +-- Print a string and finish successfully. +print = s : putStr s (_ : pure t) + +-- Print a string plus newline and finish successfully. +printLn = s : putStr (append s "\n") (_ : pure t) + +-- CPS print with newline. +putStrLn = s k : putStr (append s "\n") k + +-- Sequence after putStr, ignoring Unit. +afterPutStr = s next : putStr s (_ : next) + +-- Sequence after putStrLn, ignoring Unit. +afterPutStrLn = s next : putStr (append s "\n") (_ : next) + +-- --------------------------------------------------------------------------- +-- Result-aware file helpers +-- --------------------------------------------------------------------------- + +-- Read a file, forcing the caller to handle both success and error. +onReadFile = (path errCase okCase : + readFile path (result : + matchResult errCase okCase result)) + +-- Write a file, forcing the caller to handle both success and error. +onWriteFile = (path contents errCase okCase : + writeFile path contents (result : + matchResult errCase okCase result)) + +-- --------------------------------------------------------------------------- +-- Convenience helpers for the common cases +-- --------------------------------------------------------------------------- + +-- Read a file; on error print a message and finish. +readFileOrPrintError = (path okCase : + onReadFile path + (err rest : + putStrLn "Read failed" (_ : + pure t)) + okCase) + +-- Write a file; on error print a message and finish. +writeFileOrPrintError = (path contents okCase : + onWriteFile path contents + (err rest : + putStrLn "Write failed" (_ : + pure t)) + okCase) + +-- Copy src to dst, then continue with k on success. +copyFile = (src dst k : + onReadFile src + (err rest : + putStrLn "Read failed" (_ : + pure t)) + (contents rest : + onWriteFile dst contents + (err rest : + putStrLn "Write failed" (_ : + pure t)) + (ok rest : + k t))) diff --git a/src/IODriver.hs b/src/IODriver.hs new file mode 100644 index 0000000..3695f1f --- /dev/null +++ b/src/IODriver.hs @@ -0,0 +1,120 @@ +module IODriver + ( IOPermissions(..) + , defaultPerms + , checkIOSentinel + , runIO + ) where + +import Research (T(..), apply, toString, toNumber, ofString, ofNumber) +import System.IO (putStr, getLine) +import qualified System.IO as IO +import Control.Exception (try, IOException) +import Control.Monad (unless) +import System.Exit (die) +import System.IO.Error (isDoesNotExistError, isPermissionError, isAlreadyExistsError) +import Data.List (isPrefixOf) + +data IOPermissions = IOPermissions + { allowRead :: [FilePath] + , allowWrite :: [FilePath] + } + +defaultPerms :: IOPermissions +defaultPerms = IOPermissions [] [] + +checkIOSentinel :: T -> Either String (Integer, T) +checkIOSentinel tree = + case tree of + Fork sentinel (Fork version action) -> do + s <- toString sentinel + case s of + "tricuIO" -> do + v <- toNumber version + return (v, action) + _ -> Left "sentinel mismatch (expected \"tricuIO\")" + _ -> Left "root is not an IO sentinel pair" + +runIO :: IOPermissions -> T -> IO T +runIO perms actionTree = go actionTree + where + go tree = + case tree of + Fork tag payload -> do + tagNum <- case toNumber tag of + Right n -> return n + Left err -> die $ "Invalid IO action tag: " ++ err + dispatch tagNum payload + _ -> die $ "Invalid IO action tree: expected pair tag payload, got " ++ show tree + + dispatch tagNum payload = case tagNum of + 0 -> return payload -- Pure + + 1 -> case payload of + Fork str k -> do + s <- decodeString str "PutStr" + putStr s + go (apply k Leaf) + _ -> die "Invalid PutStr payload: expected pair string continuation" + + 2 -> do + line <- getLine + go (apply payload (ofString line)) + + 3 -> case payload of + Fork path k -> do + p <- decodeString path "ReadFile" + checkReadPerm p + content <- tryReadFile p + go (apply k content) + _ -> die "Invalid ReadFile payload: expected pair path continuation" + + 4 -> case payload of + Fork path rest -> case rest of + Fork contents k -> do + p <- decodeString path "WriteFile" + c <- decodeString contents "WriteFile" + checkWritePerm p + res <- tryWriteFile p c + go (apply k res) + _ -> die "Invalid WriteFile payload: expected pair contents continuation" + _ -> die "Invalid WriteFile payload: expected pair path (pair contents continuation)" + + _ -> die $ "Unknown IO action tag: " ++ show tagNum + + decodeString t ctx = + case toString t of + Right s -> return s + Left err -> die $ "Invalid " ++ ctx ++ " string: " ++ err + + checkReadPerm p = + unless (pathAllowed p (allowRead perms)) $ + die $ "Permission denied: read not allowed for " ++ p + + checkWritePerm p = + unless (pathAllowed p (allowWrite perms)) $ + die $ "Permission denied: write not allowed for " ++ p + + pathAllowed _ [] = True -- No restrictions + pathAllowed p prefixes = any (\prefix -> prefix `isPrefixOf` p) prefixes + + tryReadFile path = do + result <- try (IO.readFile path) :: IO (Either IOException String) + case result of + Right content -> return $ okResult (ofString content) + Left e -> return $ errResult (ioErrorCode e) + + tryWriteFile path contents = do + result <- try (IO.writeFile path contents) :: IO (Either IOException ()) + case result of + Right () -> return $ okResult Leaf + Left e -> return $ errResult (ioErrorCode e) + + okResult val = Fork (Stem Leaf) (Fork val Leaf) -- pair true (pair val t) + errResult code = Fork Leaf (Fork (ofNumber code) Leaf) -- pair false (pair code t) + + ioErrorCode :: IOException -> Integer + ioErrorCode e + | isDoesNotExistError e = 1 + | isPermissionError e = 2 + | isAlreadyExistsError e = 3 + | otherwise = 4 diff --git a/src/Main.hs b/src/Main.hs index deeb768..1567604 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,6 +5,7 @@ import System.Exit (die) import Server (runServerWithPath) import Eval (evalTricu, evalTricuWithStore, mainResult, result) import FileEval (evaluateFileWithContext, evaluateFileWithStore, compileFile) +import IODriver (IOPermissions(..), checkIOSentinel, runIO) import Parser (parseTricu) import REPL (repl) import Research (T, EvaluatedForm(..), Env, formatT, exportDag) @@ -32,10 +33,13 @@ import System.Environment (lookupEnv) data TricuArgs = Repl | Eval - { evalFiles :: [FilePath] - , evalFormat :: EvaluatedForm - , evalOutput :: FilePath - , evalDb :: Maybe FilePath + { evalFiles :: [FilePath] + , evalFormat :: EvaluatedForm + , evalOutput :: FilePath + , evalDb :: Maybe FilePath + , evalIo :: Bool + , evalAllowRead :: [FilePath] + , evalAllowWrite :: [FilePath] } | ArboricxCompile { compileInput :: FilePath @@ -98,6 +102,20 @@ evalParser = Eval <> metavar "PATH" <> help "Content store database path" )) + <*> switch + ( long "io" + <> help "Interpret the result as an IO action tree and execute it" + ) + <*> many (option str + ( long "allow-read" + <> metavar "PATH" + <> help "Allow reading from PATH prefix (repeatable)" + )) + <*> many (option str + ( long "allow-write" + <> metavar "PATH" + <> help "Allow writing to PATH prefix (repeatable)" + )) compileParser :: Parser TricuArgs compileParser = ArboricxCompile @@ -273,10 +291,18 @@ runEval opts = do _ -> do finalEnv <- foldM (evaluateFileWithStore mconn) Map.empty files return $ mainResult finalEnv + finalT <- if evalIo opts + then case checkIOSentinel resultT of + Right (1, action) -> do + let perms = IOPermissions (evalAllowRead opts) (evalAllowWrite opts) + runIO perms action + Right (v, _) -> die $ "Unsupported IO ABI version: " ++ show v + Left err -> die $ "IO mode requested but " ++ err + else return resultT case mconn of Just conn -> close conn Nothing -> return () - writeOutput out (formatT form resultT) + writeOutput out (formatT form finalT) runCompile :: TricuArgs -> IO () runCompile opts = do diff --git a/test/Spec.hs b/test/Spec.hs index 8bf5cfc..29dc5c6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -8,10 +8,12 @@ import REPL import Research import Wire import ContentStore +import IODriver import Control.Exception (evaluate, try, SomeException) import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) +import System.IO.Temp (withSystemTempDirectory) import Data.Bits (xor) import Data.Char (digitToInt) import Data.List (isInfixOf) @@ -51,6 +53,7 @@ tests = testGroup "Tricu Tests" , wireTests , tricuReaderTests , byteListUtilities + , ioDriverTests ] lexer :: TestTree @@ -1252,3 +1255,58 @@ byteListUtilities = testGroup "Byte List Utility Tests" let env = evalTricu library (parseTricu input) result env @?= falseT ] + +-- -------------------------------------------------------------------------- +-- IO driver tests +-- -------------------------------------------------------------------------- + +ioDriverTests :: TestTree +ioDriverTests = testGroup "IO driver tests" + [ testCase "readFile through onReadFile returns file contents" $ + withSystemTempDirectory "tricu-io-read" $ \dir -> do + let sourcePath = dir ++ "/input.txt" + writeFile sourcePath "abc123" + final <- runIOSource $ + unlines + [ "main = io (onReadFile \"" ++ sourcePath ++ "\"" + , " (err rest : pure \"read failed\")" + , " (contents rest : pure contents))" + ] + final @?= ofString "abc123" + + , testCase "readFile error path returns explicit error branch" $ + withSystemTempDirectory "tricu-io-read-missing" $ \dir -> do + let sourcePath = dir ++ "/missing.txt" + final <- runIOSource $ + unlines + [ "main = io (onReadFile \"" ++ sourcePath ++ "\"" + , " (err rest : pure \"read failed\")" + , " (contents rest : pure contents))" + ] + final @?= ofString "read failed" + + , testCase "chains multiple readFile actions through Result-aware helper" $ + withSystemTempDirectory "tricu-io-chain" $ \dir -> do + let firstPath = dir ++ "/first.txt" + secondPath = dir ++ "/second.txt" + writeFile firstPath "abc" + writeFile secondPath "def" + final <- runIOSource $ + unlines + [ "main = io (onReadFile \"" ++ firstPath ++ "\"" + , " (err rest : pure \"first read failed\")" + , " (first rest : onReadFile \"" ++ secondPath ++ "\"" + , " (err rest : pure \"second read failed\")" + , " (second rest : pure (append first second))))" + ] + final @?= ofString "abcdef" + ] + +runIOSource :: String -> IO T +runIOSource source = do + ioEnv <- evaluateFile "./lib/io.tri" + env <- evalTricuWithStore Nothing ioEnv (parseTricu source) + case checkIOSentinel (mainResult env) of + Right (1, action) -> runIO defaultPerms action + Right (v, _) -> assertFailure ("Unsupported IO ABI version: " ++ show v) + Left err -> assertFailure ("Expected IO sentinel: " ++ err) diff --git a/tricu.cabal b/tricu.cabal index 6489386..cff4def 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -68,6 +68,7 @@ executable tricu ContentStore Eval FileEval + IODriver Lexer Parser Paths_tricu @@ -109,9 +110,11 @@ test-suite tricu-tests , stm , tasty , tasty-hunit + , temporary , text , time , transformers + , unix , vector , wai , warp @@ -121,6 +124,7 @@ test-suite tricu-tests ContentStore Eval FileEval + IODriver Lexer Parser Paths_tricu