feat(haskell): Interaction Tree IO
oops, now we have purely modelled IO 🤷
This commit is contained in:
354
docs/io-in-tricu.md
Normal file
354
docs/io-in-tricu.md
Normal file
@@ -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.
|
||||
15
lib/base.tri
15
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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
39
lib/conversions.tri
Normal file
39
lib/conversions.tri
Normal file
@@ -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))
|
||||
83
lib/io.tri
Normal file
83
lib/io.tri
Normal file
@@ -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)))
|
||||
120
src/IODriver.hs
Normal file
120
src/IODriver.hs
Normal file
@@ -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
|
||||
36
src/Main.hs
36
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
|
||||
|
||||
58
test/Spec.hs
58
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)
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user