{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

{-|
Module      : System.IO.Continuation
Description : Continuation-based I/O.
Copyright   : (c) Alias Qli, 2022
License     : BSD-3-Clause
Maintainer  : 2576814881@qq.com
Stability   : experimental
Portability : POSIX

This module implements continuation-based I/O as described in Haskell Report 1.2. It shares 
the same basic types as stream-based I/O.
-}

module System.IO.Continuation
  ( -- * Continuation Types
    SuccCont
  , StrCont
  , StrListCont
  , BinCont
  , FailCont
  , -- * Transactions
    -- | Continuation-based I/O is based on a collection of functions called /transactions/
    -- defined in a continuation style. Please refer to the corresponding constructors under 
    -- 'Request' for documentations.
    done
  , readFile
  , writeFile
  , appendFile
  , readBinFile
  , writeBinFile
  , appendBinFile
  , deleteFile
  , statusFile
  , readChan
  , appendChan
  , readBinChan
  , appendBinChan
  , statusChan
  , echo
  , getArgs
  , getProgName
  , getEnv
  , setEnv
  , -- * Other Functions
    exit
  , abort
  , print
  , prints
  , interact
  , -- * Re-exports
    -- ** Types
    Dialogue
  , Bin
  , Name
  , IOError (..)
  , -- ** Channels
    stdin
  , stdout
  , stderr
  , stdecho
  , -- ** Run the Program
    runDialogue
  ) where

import           Prelude            (Bool, Show (..), String, shows)
import           System.IO.Dialogue

type SuccCont = Dialogue
type StrCont = String -> Dialogue
type StrListCont = [String] -> Dialogue
type BinCont = Bin -> Dialogue
type FailCont = IOError -> Dialogue

strDispatch :: FailCont -> StrCont -> Dialogue
strDispatch :: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ (Response
resp:[Response]
resps) = case Response
resp of
  Str String
val     -> StrCont
succ String
val [Response]
resps
  Failure IOError
msg -> FailCont
fail IOError
msg [Response]
resps

strListDispatch :: FailCont -> StrListCont -> Dialogue
strListDispatch :: FailCont -> StrListCont -> Dialogue
strListDispatch FailCont
fail StrListCont
succ (Response
resp:[Response]
resps) = case Response
resp of
  StrList [String]
val -> StrListCont
succ [String]
val [Response]
resps
  Failure IOError
msg -> FailCont
fail IOError
msg [Response]
resps

binDispatch :: FailCont -> BinCont -> Dialogue
binDispatch :: FailCont -> BinCont -> Dialogue
binDispatch FailCont
fail BinCont
succ (Response
resp:[Response]
resps) = case Response
resp of
  Bn Bin
val      -> BinCont
succ Bin
val [Response]
resps
  Failure IOError
msg -> FailCont
fail IOError
msg [Response]
resps

succDispatch :: FailCont -> SuccCont -> Dialogue
succDispatch :: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ (Response
resp:[Response]
resps) = case Response
resp of
  Response
Success     -> Dialogue
succ [Response]
resps
  Failure IOError
msg -> FailCont
fail IOError
msg [Response]
resps

done :: Dialogue
done :: Dialogue
done [Response]
_ = []

readFile  :: Name -> FailCont -> StrCont -> Dialogue
readFile :: String -> FailCont -> StrCont -> Dialogue
readFile String
name FailCont
fail StrCont
succ [Response]
resps = String -> Request
ReadFile String
name forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

writeFile :: Name -> String -> FailCont -> SuccCont -> Dialogue
writeFile :: String -> String -> FailCont -> Dialogue -> Dialogue
writeFile String
name String
contents FailCont
fail Dialogue
succ [Response]
resps = String -> String -> Request
WriteFile String
name String
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

appendFile :: Name -> String -> FailCont -> SuccCont -> Dialogue
appendFile :: String -> String -> FailCont -> Dialogue -> Dialogue
appendFile String
name String
contents FailCont
fail Dialogue
succ [Response]
resps = String -> String -> Request
AppendFile String
name String
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

readBinFile  :: Name -> FailCont -> BinCont -> Dialogue
readBinFile :: String -> FailCont -> BinCont -> Dialogue
readBinFile String
name FailCont
fail BinCont
succ [Response]
resps = String -> Request
ReadBinFile String
name forall a. a -> [a] -> [a]
: FailCont -> BinCont -> Dialogue
binDispatch FailCont
fail BinCont
succ [Response]
resps

writeBinFile :: Name -> Bin -> FailCont -> SuccCont -> Dialogue
writeBinFile :: String -> Bin -> FailCont -> Dialogue -> Dialogue
writeBinFile String
name Bin
contents FailCont
fail Dialogue
succ [Response]
resps = String -> Bin -> Request
WriteBinFile String
name Bin
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

appendBinFile :: Name -> Bin -> FailCont -> SuccCont -> Dialogue
appendBinFile :: String -> Bin -> FailCont -> Dialogue -> Dialogue
appendBinFile String
name Bin
contents FailCont
fail Dialogue
succ [Response]
resps = String -> Bin -> Request
AppendBinFile String
name Bin
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

deleteFile :: Name -> FailCont -> SuccCont -> Dialogue
deleteFile :: String -> FailCont -> Dialogue -> Dialogue
deleteFile String
name FailCont
fail Dialogue
succ [Response]
resps = String -> Request
DeleteFile String
name forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

statusFile :: Name -> FailCont -> StrCont -> Dialogue
statusFile :: String -> FailCont -> StrCont -> Dialogue
statusFile String
name FailCont
fail StrCont
succ [Response]
resps = String -> Request
StatusFile String
name forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

readChan :: Name -> FailCont -> StrCont -> Dialogue
readChan :: String -> FailCont -> StrCont -> Dialogue
readChan String
name FailCont
fail StrCont
succ [Response]
resps = String -> Request
ReadChan String
name forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

appendChan :: Name -> String -> FailCont -> SuccCont -> Dialogue
appendChan :: String -> String -> FailCont -> Dialogue -> Dialogue
appendChan String
name String
contents FailCont
fail Dialogue
succ [Response]
resps = String -> String -> Request
AppendChan String
name String
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

readBinChan :: Name -> FailCont -> BinCont -> Dialogue
readBinChan :: String -> FailCont -> BinCont -> Dialogue
readBinChan String
name FailCont
fail BinCont
succ [Response]
resps = String -> Request
ReadBinChan String
name forall a. a -> [a] -> [a]
: FailCont -> BinCont -> Dialogue
binDispatch FailCont
fail BinCont
succ [Response]
resps

appendBinChan :: Name -> Bin -> FailCont -> SuccCont -> Dialogue
appendBinChan :: String -> Bin -> FailCont -> Dialogue -> Dialogue
appendBinChan String
name Bin
contents FailCont
fail Dialogue
succ [Response]
resps = String -> Bin -> Request
AppendBinChan String
name Bin
contents forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

statusChan :: Name -> FailCont -> StrCont -> Dialogue
statusChan :: String -> FailCont -> StrCont -> Dialogue
statusChan String
name FailCont
fail StrCont
succ [Response]
resps = String -> Request
StatusChan String
name forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

echo :: Bool -> FailCont -> SuccCont -> Dialogue
echo :: Bool -> FailCont -> Dialogue -> Dialogue
echo Bool
bool FailCont
fail Dialogue
succ [Response]
resps = Bool -> Request
Echo Bool
bool forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

getArgs :: FailCont -> StrListCont -> Dialogue
getArgs :: FailCont -> StrListCont -> Dialogue
getArgs FailCont
fail StrListCont
succ [Response]
resps = Request
GetArgs forall a. a -> [a] -> [a]
: FailCont -> StrListCont -> Dialogue
strListDispatch FailCont
fail StrListCont
succ [Response]
resps

getProgName :: FailCont -> StrCont -> Dialogue
getProgName :: FailCont -> StrCont -> Dialogue
getProgName FailCont
fail StrCont
succ [Response]
resps = Request
GetProgName forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

getEnv :: String -> FailCont -> StrCont -> Dialogue
getEnv :: String -> FailCont -> StrCont -> Dialogue
getEnv String
name FailCont
fail StrCont
succ [Response]
resps = String -> Request
GetEnv String
name forall a. a -> [a] -> [a]
: FailCont -> StrCont -> Dialogue
strDispatch FailCont
fail StrCont
succ [Response]
resps

setEnv :: String -> String -> FailCont -> SuccCont -> Dialogue
setEnv :: String -> String -> FailCont -> Dialogue -> Dialogue
setEnv String
name String
value FailCont
fail Dialogue
succ [Response]
resps = String -> String -> Request
SetEnv String
name String
value forall a. a -> [a] -> [a]
: FailCont -> Dialogue -> Dialogue
succDispatch FailCont
fail Dialogue
succ [Response]
resps

abort :: FailCont
abort :: FailCont
abort IOError
_ = Dialogue
done

exit :: FailCont
exit :: FailCont
exit IOError
err = String -> String -> FailCont -> Dialogue -> Dialogue
appendChan String
stderr String
msg FailCont
abort Dialogue
done
  where
    msg :: String
msg = case IOError
err of
      ReadError String
s   -> String
s
      WriteError String
s  -> String
s
      SearchError String
s -> String
s
      FormatError String
s -> String
s
      OtherError String
s  -> String
s

print :: Show a => a -> Dialogue
print :: forall a. Show a => a -> Dialogue
print a
x = String -> String -> FailCont -> Dialogue -> Dialogue
appendChan String
stdout (forall a. Show a => a -> String
show a
x) FailCont
exit Dialogue
done

prints :: Show a => a -> String -> Dialogue
prints :: forall a. Show a => a -> StrCont
prints a
x String
s = String -> String -> FailCont -> Dialogue -> Dialogue
appendChan String
stdout (forall a. Show a => a -> ShowS
shows a
x String
s) FailCont
exit Dialogue
done

interact :: (String -> String) -> Dialogue
interact :: ShowS -> Dialogue
interact ShowS
f = String -> FailCont -> StrCont -> Dialogue
readChan String
stdin FailCont
exit
  (\String
x -> String -> String -> FailCont -> Dialogue -> Dialogue
appendChan String
stdout (ShowS
f String
x) FailCont
exit Dialogue
done)