141 lines
4.3 KiB
Plaintext
141 lines
4.3 KiB
Plaintext
!import "base.tri" !Local
|
|
!import "list.tri" !Local
|
|
!import "conversions.tri" !Local
|
|
|
|
-- IO constructors for host-interpreted interaction trees.
|
|
-- Free-monad style: Bind is the single sequencing mechanism.
|
|
|
|
version = 1
|
|
|
|
io = action : pair "tricuIO" (pair version action)
|
|
|
|
pure = x : pair 0 x
|
|
bind = action k : pair 1 (pair action k)
|
|
|
|
putStr = s : pair 10 s
|
|
getLine = pair 11 t
|
|
|
|
readFile = p : pair 20 p
|
|
writeFile = p c : pair 21 (pair p c)
|
|
putBytes = bs : pair 12 bs
|
|
writeBytes = p c : pair 22 (pair p c)
|
|
|
|
ask = pair 30 t
|
|
local = f action : pair 31 (pair f action)
|
|
|
|
get = pair 40 t
|
|
put = s : pair 41 s
|
|
|
|
fork = action : pair 60 action
|
|
await = handle : pair 61 handle
|
|
yield = pair 62 t
|
|
sleep = ms : pair 63 ms
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Generic sequencing combinators
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
thenIO = a b : bind a (_ : b)
|
|
mapIO = action f : bind action (x : pure (f x))
|
|
void = action : bind action (_ : pure t)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Conditional execution
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
when = cond action : matchBool action (pure t) cond
|
|
unless = cond action : matchBool (pure t) action cond
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Infinite loop
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
forever = y (self : action :
|
|
bind action (_ :
|
|
self action))
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Result-aware combinators
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- Propagate driver Result on error; run okCase on success.
|
|
onOk = action okCase :
|
|
bind action (result :
|
|
matchResult
|
|
(err rest : pure result)
|
|
okCase
|
|
result)
|
|
|
|
-- Same as onOk, but the okCase only receives the value (rest is dropped).
|
|
onOk_ = action okCase :
|
|
bind action (result :
|
|
matchResult
|
|
(err rest : pure result)
|
|
(val _ : okCase val)
|
|
result)
|
|
|
|
-- Generalized Result handler with explicit branches.
|
|
onResult = action errCase okCase :
|
|
bind action (result :
|
|
matchResult errCase okCase result)
|
|
|
|
-- Same as onResult, but handlers only receive the value/msg (rest is dropped).
|
|
onResult_ = action errCase okCase :
|
|
bind action (result :
|
|
matchResult
|
|
(err _ : errCase err)
|
|
(val _ : okCase val)
|
|
result)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Convenience helpers
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
print = s : void (putStr s)
|
|
putStrLn = s : void (putStr (append s "\n"))
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Result-aware file helpers
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
onReadFile = path : onResult (readFile path)
|
|
|
|
onWriteFile = path contents : onResult (writeFile path contents)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Convenience helpers for the common cases
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
readFileOrPrintError = (path okCase :
|
|
onReadFile path
|
|
(err rest : putStrLn (append "Read failed: " err))
|
|
okCase)
|
|
|
|
writeFileOrPrintError = (path contents okCase :
|
|
onWriteFile path contents
|
|
(err rest : putStrLn (append "Write failed: " err))
|
|
okCase)
|
|
|
|
copyFile = (src dst :
|
|
onResult (readFile src)
|
|
(err rest : putStrLn (append "Read failed: " err))
|
|
(contents rest :
|
|
onResult (writeFile dst contents)
|
|
(err rest : putStrLn (append "Write failed: " err))
|
|
(_ _ : pure t)))
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Resource-safe combinators
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
finally = action cleanup :
|
|
bind action (result :
|
|
bind cleanup (_ :
|
|
pure result))
|
|
|
|
bracket = acquire release use :
|
|
bind acquire (resource :
|
|
bind (use resource) (result :
|
|
bind (release resource) (_ :
|
|
pure result)))
|