James Eversole
2e2db07bd6
+ let bindings + where bindings + do notation I explored enough of the alternative language design space and decided that we should commit fully to Lambda style. That means no more highly tacit/concatenative point-free/partial programs as default. We'll keep taking advantage of those capabilities when it makes sense, but the library will continue to see massive overhauls.
163 lines
5.0 KiB
Plaintext
163 lines
5.0 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)
|
|
|
|
listDirectory = p : pair 23 p
|
|
renameFile = old new : pair 24 (pair old new)
|
|
createDirectory = p : pair 25 p
|
|
deleteFile = p : pair 26 p
|
|
fileExists = p : pair 27 p
|
|
|
|
sha256Hex = bs : pair 28 bs
|
|
currentTime = pair 29 t
|
|
|
|
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)
|
|
|
|
mapErrIO prefix action =
|
|
onResult_ action
|
|
(e : pure (err (append prefix e) t))
|
|
(v : pure (ok v t))
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- 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)
|
|
|
|
onListDirectory = path : onResult (listDirectory path)
|
|
onRenameFile = old new : onResult (renameFile old new)
|
|
onCreateDirectory = path : onResult (createDirectory path)
|
|
onDeleteFile = path : onResult (deleteFile path)
|
|
onFileExists = path : onResult (fileExists path)
|
|
onSha256Hex = bs : onResult (sha256Hex bs)
|
|
onCurrentTime = onResult currentTime
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- 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)))
|