{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module System.IO.Continuation
(
SuccCont
, StrCont
, StrListCont
, BinCont
, FailCont
,
done
, readFile
, writeFile
, appendFile
, readBinFile
, writeBinFile
, appendBinFile
, deleteFile
, statusFile
, readChan
, appendChan
, readBinChan
, appendBinChan
, statusChan
, echo
, getArgs
, getProgName
, getEnv
, setEnv
,
exit
, abort
, print
, prints
, interact
,
Dialogue
, Bin
, Name
, IOError (..)
,
stdin
, stdout
, stderr
, stdecho
,
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)