module Prelude.Gofer (
strict,
const,
id,
curry,
uncurry,
fst,
snd,
fst3,
snd3,
thd3,
(.),
flip,
($),
(&&), (||),
not,
and, or,
any, all,
otherwise,
ord, chr,
isAscii, isControl, isPrint, isSpace,
isUpper, isLower, isAlpha, isDigit, isAlphanum,
minChar, maxChar,
(==), (/=),
(<), (<=), (>), (>=),
max, min,
range,
index,
inRange,
enumFrom,
enumFromThen,
enumFromTo,
enumFromThenTo,
(+), (), (*), (/),
negate,
fromInteger_ ,
sin,
asin,
cos,
acos,
tan,
atan,
log,
exp,
sqrt,
atan2,
truncate,
pi,
div,
quot,
rem,
mod,
subtract,
even, odd,
gcd,
lcm,
(^),
abs,
signum,
sum, product,
sums, products,
head,
last,
tail,
init,
(++),
genericLength,
length,
(!!),
iterate,
repeat,
cycle,
copy,
nub,
reverse,
elem, notElem,
maximum, minimum,
concat,
transpose,
null,
(\\),
map,
filter,
foldl,
foldl1,
foldl',
scanl,
scanl1,
scanl',
foldr,
foldr1,
scanr,
scanr1,
take,
drop,
splitAt,
takeWhile,
takeUntil,
dropWhile,
span, break,
lines,
words,
unlines,
unwords,
merge,
sort,
insert,
qsort,
zip,
zip3,
zip4,
zip5,
zip6,
zip7,
zipWith,
zipWith3,
zipWith4,
zipWith5,
zipWith6,
zipWith7,
unzip,
cjustify, ljustify, rjustify,
space,
layn,
until,
until',
error,
undefined,
asTypeOf,
ShowS,
showsPrec,
showList,
shows,
show,
showChar,
showString,
stdin,
stdout,
stderr,
stdecho,
Request(..), Response(..), IOError(..),
Dialogue, SuccCont, StrCont, StrListCont, FailCont,
done,
readFile,
writeFile,
appendFile,
readChan,
appendChan,
echo,
getArgs,
getProgName,
getEnv,
strDispatch,
succDispatch,
strListDispatch,
abort,
exit,
print,
prints,
interact,
run,
openfile,
help
) where
import GHC.Base (Float(..), Int(..), Bool(..), String, Char(..))
import qualified GHC.Base as GHC (ord, chr, seq, error)
import qualified GHC.Base as GHC ( eqInt,leInt,plusInt,minusInt,timesInt
, negateInt, divInt, modInt, remInt,quotInt)
import GHC.Prim (eqFloat#, leFloat#, eqChar#, leChar# )
import GHC.Float ( plusFloat, showSignedFloat
, minusFloat, divideFloat, timesFloat, negateFloat, int2Float
, sinFloat, asinFloat, cosFloat, acosFloat, tanFloat, atanFloat
, logFloat, logBase, expFloat, sqrtFloat, atanFloat, float2Int)
import qualified System.IO.Unsafe as GHC (unsafePerformIO)
import qualified System.IO as GHC (readFile)
import qualified GHC.Show as GHC (showSignedInt, shows)
import qualified GHC.Float as GHC (showSignedFloat)
import qualified GHC.Real as GHC (fromRational)
import qualified GHC.Num as GHC (fromInteger)
import GHC.Base (fail, (>>), (>>=))
fromRational = GHC.fromRational
fromInteger = GHC.fromInteger
help = "press :? for a list of commands"
infixl 9 !!
infixr 9 .
infixr 8 ^
infixl 7 *
infix 7 / , `div`, `quot`, `rem`, `mod`
infixl 6 +,
infix 5 \\
infixr 5 ++, :
infix 4 ==, /=, <, <=, >=, >
infix 4 `elem`, `notElem`
infixr 3 &&
infixr 2 ||
infixr 0 $
strict f x = x `GHC.seq` f x
const :: a -> b -> a
const k x = k
id :: a -> a
id x = x
curry :: ((a,b) -> c) -> a -> b -> c
curry f a b = f (a,b)
uncurry :: (a -> b -> c) -> (a,b) -> c
uncurry f (a,b) = f a b
fst :: (a,b) -> a
fst (x,_) = x
snd :: (a,b) -> b
snd (_,y) = y
fst3 :: (a,b,c) -> a
fst3 (x,_,_) = x
snd3 :: (a,b,c) -> b
snd3 (_,x,_) = x
thd3 :: (a,b,c) -> c
thd3 (_,_,x) = x
(.) :: (b -> c) -> (a -> b) -> (a -> c)
(f . g) x = f (g x)
flip :: (a -> b -> c) -> b -> a -> c
flip f x y = f y x
($) :: (a -> b) -> a -> b
f $ x = f x
(&&), (||) :: Bool -> Bool -> Bool
False && x = False
True && x = x
False || x = x
True || x = True
not :: Bool -> Bool
not True = False
not False = True
and, or :: [Bool] -> Bool
and = foldr (&&) True
or = foldr (||) False
any, all :: (a -> Bool) -> [a] -> Bool
any p = or . map p
all p = and . map p
otherwise :: Bool
otherwise = True
ord :: Char -> Int
ord = GHC.ord
chr :: Int -> Char
chr = GHC.chr
isAscii, isControl, isPrint, isSpace :: Char -> Bool
isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool
isAscii c = ord c < 128
isControl c = c < ' ' || c == '\DEL'
isPrint c = c >= ' ' && c <= '~'
isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' ||
c == '\f' || c == '\v'
isUpper c = c >= 'A' && c <= 'Z'
isLower c = c >= 'a' && c <= 'z'
isAlpha c = isUpper c || isLower c
isDigit c = c >= '0' && c <= '9'
isAlphanum c = isAlpha c || isDigit c
toUpper, toLower :: Char -> Char
toUpper c | isLower c = chr (ord c ord 'a' + ord 'A')
| otherwise = c
toLower c | isUpper c = chr (ord c ord 'A' + ord 'a')
| otherwise = c
minChar, maxChar :: Char
minChar = chr 0
maxChar = chr 255
class Eq a where
(==), (/=) :: a -> a -> Bool
x /= y = not (x == y)
class Eq a => Ord a where
(<), (<=), (>), (>=) :: a -> a -> Bool
max, min :: a -> a -> a
x < y = x <= y && x /= y
x >= y = y <= x
x > y = y < x
max x y | x >= y = x
| y >= x = y
min x y | x <= y = x
| y <= x = y
class Ord a => Ix a where
range :: (a,a) -> [a]
index :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
class Ord a => Enum a where
enumFrom :: a -> [a]
enumFromThen :: a -> a -> [a]
enumFromTo :: a -> a -> [a]
enumFromThenTo :: a -> a -> a -> [a]
enumFromTo n m = takeWhile (m>=) (enumFrom n)
enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m)
(enumFromThen n n')
class (Eq a, Text a) => Num a where
(+), (), (*), (/) :: a -> a -> a
negate :: a -> a
fromInteger_ :: Int -> a
primEqInt = GHC.eqInt
primLeInt = GHC.leInt
primPlusInt = GHC.plusInt
primMinusInt = GHC.minusInt
primDivInt = GHC.divInt
primMulInt = GHC.timesInt
primNegInt = GHC.negateInt
instance Eq () where () == () = True
instance Ord () where () <= () = True
instance Eq Int where (==) = primEqInt
instance Ord Int where (<=) = primLeInt
instance Ix Int where
range (m,n) = [m..n]
index b@(m,n) i
| inRange b i = i m
| otherwise = error "index out of range"
inRange (m,n) i = m <= i && i <= n
instance Enum Int where
enumFrom n = iterate (1+) n
enumFromThen n m = iterate ((mn)+) n
instance Num Int where
(+) = primPlusInt
() = primMinusInt
(*) = primMulInt
(/) = primDivInt
negate = primNegInt
fromInteger_ x = x
primEqFloat (F# x) (F# y) = x `eqFloat#` y
primLeFloat (F# x) (F# y) = x `leFloat#` y
primPlusFloat = plusFloat
primMinusFloat = minusFloat
primDivFloat = divideFloat
primMulFloat = timesFloat
primNegFloat = negateFloat
primIntToFloat = int2Float
instance Eq Float where (==) = primEqFloat
instance Ord Float where (<=) = primLeFloat
instance Enum Float where
enumFrom n = iterate (1.0+) n
enumFromThen n m = iterate ((mn)+) n
instance Num Float where
(+) = primPlusFloat
() = primMinusFloat
(*) = primMulFloat
(/) = primDivFloat
negate = primNegFloat
fromInteger_ = primIntToFloat
sin = sinFloat
asin = asinFloat
cos = cosFloat
acos = acosFloat
tan = tanFloat
atan = atanFloat
log = logFloat
exp = expFloat
sqrt = sqrtFloat
atan2 = atanFloat
truncate = float2Int
pi :: Float
pi = 3.1415926535
primEqChar (C# c1) (C# c2) = c1 `eqChar#` c2
primLeChar (C# c1) (C# c2) = c1 `leChar#` c2
instance Eq Char where (==) = primEqChar
instance Ord Char where (<=) = primLeChar
instance Ix Char where
range (c,c') = [c..c']
index b@(m,n) i
| inRange b i = ord i ord m
| otherwise = error "index out of range"
inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci
instance Enum Char where
enumFrom c = map chr [ord c .. ord maxChar]
enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar]
where lastChar = if c' < c then minChar else maxChar
instance Eq a => Eq [a] where
[] == [] = True
[] == (y:ys) = False
(x:xs) == [] = False
(x:xs) == (y:ys) = x==y && xs==ys
instance Ord a => Ord [a] where
[] <= _ = True
(_:_) <= [] = False
(x:xs) <= (y:ys) = x<y || (x==y && xs<=ys)
instance (Eq a, Eq b) => Eq (a,b) where
(x,y) == (u,v) = x==u && y==v
instance (Ord a, Ord b) => Ord (a,b) where
(x,y) <= (u,v) = x<u || (x==u && y<=v)
instance Eq Bool where
True == True = True
False == False = True
_ == _ = False
instance Ord Bool where
False <= x = True
True <= x = x
div = GHC.divInt
quot = GHC.quotInt
rem = GHC.remInt
mod = GHC.modInt
subtract :: Num a => a -> a -> a
subtract = flip ()
even, odd :: Int -> Bool
even x = x `rem` 2 == 0
odd = not . even
gcd :: Int -> Int -> Int
gcd x y = gcd' (abs x) (abs y)
where gcd' x 0 = x
gcd' x y = gcd' y (x `rem` y)
lcm :: Int -> Int -> Int
lcm _ 0 = 0
lcm 0 _ = 0
lcm x y = abs ((x `quot` gcd x y) * y)
(^) :: Num a => a -> Int -> a
x ^ 0 = fromInteger_ 1
x ^ (n+1) = f x n x
where f _ 0 y = y
f x n y = g x n where
g x n | even n = g (x*x) (n`quot`2)
| otherwise = f x (n1) (x*y)
abs :: (Num a, Ord a) => a -> a
abs x | x>=fromInteger_ 0 = x
| otherwise = negate x
signum :: (Num a, Ord a) => a -> Int
signum x
| x==fromInteger_ 0 = 0
| x> fromInteger_ 0 = 1
| otherwise = 1
sum, product :: Num a => [a] -> a
sum = foldl' (+) (fromInteger_ 0)
product = foldl' (*) (fromInteger_ 1)
sums, products :: Num a => [a] -> [a]
sums = scanl (+) (fromInteger_ 0)
products = scanl (*) (fromInteger_ 1)
head :: [a] -> a
head (x:_) = x
last :: [a] -> a
last [x] = x
last (_:xs) = last xs
tail :: [a] -> [a]
tail (_:xs) = xs
init :: [a] -> [a]
init [x] = []
init (x:xs) = x : init xs
(++) :: [a] -> [a] -> [a]
[] ++ ys = ys
(x:xs) ++ ys = x:(xs++ys)
genericLength :: Num a => [b] -> a
genericLength = foldl' (\n _ -> n + fromInteger_ 1) (fromInteger_ 0)
length :: [a] -> Int
length = foldl' (\n _ -> n+1) 0
(!!) :: [a] -> Int -> a
(x:_) !! 0 = x
(_:xs) !! (n+1) = xs !! n
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
repeat :: a -> [a]
repeat x = xs where xs = x:xs
cycle :: [a] -> [a]
cycle xs = xs' where xs'=xs++xs'
copy :: Int -> a -> [a]
copy n x = take n xs where xs = x:xs
nub :: Eq a => [a] -> [a]
nub [] = []
nub (x:xs) = x : nub (filter (x/=) xs)
reverse :: [a] -> [a]
reverse = foldl (flip (:)) []
elem, notElem :: Eq a => a -> [a] -> Bool
elem = any . (==)
notElem = all . (/=)
maximum, minimum :: Ord a => [a] -> a
maximum = foldl1 max
minimum = foldl1 min
concat :: [[a]] -> [a]
concat = foldr (++) []
transpose :: [[a]] -> [[a]]
transpose = foldr
(\xs xss -> zipWith (:) xs (xss ++ repeat []))
[]
null :: [a] -> Bool
null [] = True
null (_:_) = False
(\\) :: Eq a => [a] -> [a] -> [a]
(\\) = foldl del
where [] `del` _ = []
(x:xs) `del` y
| x == y = xs
| otherwise = x : xs `del` y
map :: (a -> b) -> [a] -> [b]
map f [] = []
map f (x:xs) = f x : map f xs
filter :: (a -> Bool) -> [a] -> [a]
filter _ [] = []
filter p (x:xs)
| p x = x : xs'
| otherwise = xs'
where xs' = filter p xs
foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs) = foldl f x xs
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' f a [] = a
foldl' f a (x:xs) = strict (foldl' f) (f a x) xs
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f q xs = q : (case xs of
[] -> []
x:xs -> scanl f (f q x) xs)
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 f (x:xs) = scanl f x xs
scanl' :: (a -> b -> a) -> a -> [b] -> [a]
scanl' f q xs = q : (case xs of
[] -> []
x:xs -> strict (scanl' f) (f q x) xs)
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 f [x] = x
foldr1 f (x:xs) = f x (foldr1 f xs)
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr f q0 [] = [q0]
scanr f q0 (x:xs) = f x q : qs
where qs@(q:_) = scanr f q0 xs
scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 f [x] = [x]
scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
take :: Int -> [a] -> [a]
take 0 _ = []
take _ [] = []
take (n+1) (x:xs) = x : take n xs
drop :: Int -> [a] -> [a]
drop 0 xs = xs
drop _ [] = []
drop (n+1) (_:xs) = drop n xs
splitAt :: Int -> [a] -> ([a], [a])
splitAt 0 xs = ([],xs)
splitAt _ [] = ([],[])
splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p [] = []
takeUntil p (x:xs)
| p x = [x]
| otherwise = x : takeUntil p xs
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p [] = []
dropWhile p xs@(x:xs')
| p x = dropWhile p xs'
| otherwise = xs
span, break :: (a -> Bool) -> [a] -> ([a],[a])
span p [] = ([],[])
span p xs@(x:xs')
| p x = let (ys,zs) = span p xs' in (x:ys,zs)
| otherwise = ([],xs)
break p = span (not . p)
lines :: String -> [String]
lines "" = []
lines s = l : (if null s' then [] else lines (tail s'))
where (l, s') = break ('\n'==) s
words :: String -> [String]
words s = case dropWhile isSpace s of
"" -> []
s' -> w : words s''
where (w,s'') = break isSpace s'
unlines :: [String] -> String
unlines = concat . map (\l -> l ++ "\n")
unwords :: [String] -> String
unwords [] = []
unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
| x <= y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys
sort :: Ord a => [a] -> [a]
sort = foldr insert []
insert :: Ord a => a -> [a] -> [a]
insert x [] = [x]
insert x (y:ys)
| x <= y = x:y:ys
| otherwise = y:insert x ys
qsort :: Ord a => [a] -> [a]
qsort [] = []
qsort (x:xs) = qsort [ u | u<-xs, u<x ] ++
[ x ] ++
qsort [ u | u<-xs, u>=x ]
zip :: [a] -> [b] -> [(a,b)]
zip = zipWith (\a b -> (a,b))
zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
zip3 = zipWith3 (\a b c -> (a,b,c))
zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
zip4 = zipWith4 (\a b c d -> (a,b,c,d))
zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e))
zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)]
zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f))
zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)]
zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g))
zipWith :: (a->b->c) -> [a]->[b]->[c]
zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
zipWith _ _ _ = []
zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith3 z (a:as) (b:bs) (c:cs)
= z a b c : zipWith3 z as bs cs
zipWith3 _ _ _ _ = []
zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
= z a b c d : zipWith4 z as bs cs ds
zipWith4 _ _ _ _ _ = []
zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f]
zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
= z a b c d e : zipWith5 z as bs cs ds es
zipWith5 _ _ _ _ _ _ = []
zipWith6 :: (a->b->c->d->e->f->g)
-> [a]->[b]->[c]->[d]->[e]->[f]->[g]
zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
= z a b c d e f : zipWith6 z as bs cs ds es fs
zipWith6 _ _ _ _ _ _ _ = []
zipWith7 :: (a->b->c->d->e->f->g->h)
-> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
= z a b c d e f g : zipWith7 z as bs cs ds es fs gs
zipWith7 _ _ _ _ _ _ _ _ = []
unzip :: [(a,b)] -> ([a],[b])
unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], [])
cjustify, ljustify, rjustify :: Int -> String -> String
cjustify n s = space halfm ++ s ++ space (m halfm)
where m = n length s
halfm = m `div` 2
ljustify n s = s ++ space (n length s)
rjustify n s = space (n length s) ++ s
space :: Int -> String
space n = copy n ' '
layn :: [String] -> String
layn = lay 1 where lay :: Int -> [String] -> String
lay _ [] = []
lay n (x:xs) = rjustify 4 (show n) ++ ") "
++ x ++ "\n" ++ lay (n+1) xs
until :: (a -> Bool) -> (a -> a) -> a -> a
until p f x | p x = x
| otherwise = until p f (f x)
until' :: (a -> Bool) -> (a -> a) -> a -> [a]
until' p f = takeUntil p . iterate f
error = GHC.error
undefined :: a
undefined | False = undefined
asTypeOf :: a -> a -> a
x `asTypeOf` _ = x
type ShowS = String -> String
class Text a where
showsPrec :: Int -> a -> ShowS
showList :: [a] -> ShowS
showList [] = showString "[]"
showList (x:xs) = showChar '[' . shows x . showl xs
where showl [] = showChar ']'
showl (x:xs) = showChar ',' . shows x . showl xs
shows :: Text a => a -> ShowS
shows = showsPrec 0
show :: Text a => a -> String
show x = shows x ""
showChar :: Char -> ShowS
showChar = (:)
showString :: String -> ShowS
showString = (++)
instance Text () where
showsPrec d () = showString "()"
instance Text Bool where
showsPrec d True = showString "True"
showsPrec d False = showString "False"
primShowsInt = GHC.showSignedInt
instance Text Int where showsPrec = primShowsInt
primShowsFloat :: Int -> Float -> String -> String
primShowsFloat = GHC.showSignedFloat (GHC.shows :: Float -> ShowS)
instance Text Float where showsPrec = primShowsFloat
instance Text Char where
showsPrec p c = showString [q, c, q] where q = '\''
showList cs = showChar '"' . showl cs
where showl "" = showChar '"'
showl ('"':cs) = showString "\\\"" . showl cs
showl (c:cs) = showChar c . showl cs
instance Text a => Text [a] where
showsPrec p = showList
instance (Text a, Text b) => Text (a,b) where
showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .
shows y . showChar ')'
stdin = "stdin"
stdout = "stdout"
stderr = "stderr"
stdecho = "stdecho"
data Request =
ReadFile String
| WriteFile String String
| AppendFile String String
| ReadChan String
| AppendChan String String
| Echo Bool
| GetArgs
| GetProgName
| GetEnv String
data Response = Success
| Str String
| Failure IOError
| StrList [String]
data IOError = WriteError String
| ReadError String
| SearchError String
| FormatError String
| OtherError String
type Dialogue = [Response] -> [Request]
type SuccCont = Dialogue
type StrCont = String -> Dialogue
type StrListCont = [String] -> Dialogue
type FailCont = IOError -> Dialogue
done :: Dialogue
readFile :: String -> FailCont -> StrCont -> Dialogue
writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue
appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue
readChan :: String -> FailCont -> StrCont -> Dialogue
appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue
echo :: Bool -> FailCont -> SuccCont -> Dialogue
getArgs :: FailCont -> StrListCont -> Dialogue
getProgName :: FailCont -> StrCont -> Dialogue
getEnv :: String -> FailCont -> StrCont -> Dialogue
done resps = []
readFile name fail succ resps =
(ReadFile name) : strDispatch fail succ resps
writeFile name contents fail succ resps =
(WriteFile name contents) : succDispatch fail succ resps
appendFile name contents fail succ resps =
(AppendFile name contents) : succDispatch fail succ resps
readChan name fail succ resps =
(ReadChan name) : strDispatch fail succ resps
appendChan name contents fail succ resps =
(AppendChan name contents) : succDispatch fail succ resps
echo bool fail succ resps =
(Echo bool) : succDispatch fail succ resps
getArgs fail succ resps =
GetArgs : strListDispatch fail succ resps
getProgName fail succ resps =
GetProgName : strDispatch fail succ resps
getEnv name fail succ resps =
(GetEnv name) : strDispatch fail succ resps
strDispatch fail succ (resp:resps) =
case resp of Str val -> succ val resps
Failure msg -> fail msg resps
succDispatch fail succ (resp:resps) =
case resp of Success -> succ resps
Failure msg -> fail msg resps
strListDispatch fail succ (resp:resps) =
case resp of StrList val -> succ val resps
Failure msg -> fail msg resps
abort :: FailCont
abort err = done
exit :: FailCont
exit err = appendChan stderr msg abort done
where msg = case err of ReadError s -> s
WriteError s -> s
SearchError s -> s
FormatError s -> s
OtherError s -> s
print :: Text a => a -> Dialogue
print x = appendChan stdout (show x) exit done
prints :: Text a => a -> String -> Dialogue
prints x s = appendChan stdout (shows x s) exit done
interact :: (String -> String) -> Dialogue
interact f = readChan stdin exit
(\x -> appendChan stdout (f x) exit done)
run :: (String -> String) -> Dialogue
run f = echo False exit (interact f)
openfile :: String -> String
openfile f = GHC.unsafePerformIO (GHC.readFile f)