!import "prelude"  !Local
!import "patterns" !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)))