!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))

-- ---------------------------------------------------------------------------
-- Convenience helpers
-- ---------------------------------------------------------------------------

print    = s : bind (putStr s)       (_ : pure t)
putStrLn = s : bind (putStr (append s "\n")) (_ : pure t)

-- ---------------------------------------------------------------------------
-- Result-aware file helpers
-- ---------------------------------------------------------------------------

onReadFile = (path errCase okCase :
  bind (readFile path) (result :
    matchResult errCase okCase result))

onWriteFile = (path contents errCase okCase :
  bind (writeFile path contents) (result :
    matchResult errCase okCase result))

-- ---------------------------------------------------------------------------
-- Convenience helpers for the common cases
-- ---------------------------------------------------------------------------

readFileOrPrintError = (path okCase :
  onReadFile path
    (err rest : putStrLn "Read failed")
    okCase)

writeFileOrPrintError = (path contents okCase :
  onWriteFile path contents
    (err rest : putStrLn "Write failed")
    okCase)

copyFile = (src dst :
  bind (readFile src)
    (result :
      matchResult
        (err rest : putStrLn "Read failed")
        (contents rest :
          bind (writeFile dst contents)
            (wr :
              matchResult
                (err rest : putStrLn "Write failed")
                (ok rest   : pure t)
                wr))
        result))