{-# LANGUAGE TypeOperators, FlexibleContexts, Rank2Types #-}
module Examples where
import Control.Ev.Eff
import Prelude hiding (flip)
import Data.Char
import Data.Maybe
data Reader a e ans = Reader { ask :: Op () a e ans }
hr :: a -> Reader a e ans
hr x = Reader{ ask = operation (\ () k -> k x) }
reader :: a -> Eff (Reader a :* e) ans -> Eff e ans
reader x action = handler (hr x) action
sample1 = reader "world" $
do s <- perform ask ()
return ("hello " ++ s)
greetOrExit::(Reader String :? e, Reader Bool :? e)
=> Eff e String
greetOrExit
= do s <- perform ask ()
isExit <- perform ask ()
if isExit then return ("goodbye " ++ s)
else return ("hello " ++ s)
greetMaybe :: (Reader String :? e) => Eff e (Maybe String)
greetMaybe = do s <- perform ask ()
if null s then return Nothing
else return (Just ("hello " ++ s))
greet :: (Reader String :? e) => Eff e String
greet = do s <- perform ask ()
return ("hello " ++ s)
helloWorld :: Eff e String
helloWorld = reader "world" greet
data Exn e ans
= Exn { failure :: forall a. Op () a e ans }
toMaybe :: Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe
= handlerRet Just $ Exn{
failure = operation (\ () _ -> return Nothing) }
exceptDefault :: a -> Eff (Exn :* e) a -> Eff e a
exceptDefault x
= handler $
Exn{ failure = operation (\ () _ -> return x) }
safeDiv :: (Exn :? e) => Int -> Int -> Eff e Int
safeDiv x 0 = perform failure ()
safeDiv x y = return (x `div` y)
safeHead :: (Exn :? e) => String -> Eff e Char
safeHead [] = perform failure ()
safeHead (x:_) = return x
sample3 = reader "" $
toMaybe $
do s <- perform ask ()
c <- safeHead s
return (Just c)
data State a e ans = State { get :: Op () a e ans
, put :: Op a () e ans }
state :: a -> Eff (State a :* e) ans -> Eff e ans
state init
= handlerLocal init $
State{ get = function (\ () -> perform lget ())
, put = function (\ x -> perform lput x) }
add :: (State Int :? e) => Int -> Eff e ()
add i = do j <- perform get ()
perform put (i + j)
invert :: (State Bool :? e) => Eff e Bool
invert = do b <- perform get ()
perform put (not b)
perform get ()
test :: Eff e Bool
test = state True $ do invert
b <- perform get ()
return b
adder = state (1::Int) $
do add 41
i <- perform get ()
return ("the final state is: " ++ show (i::Int))
data Output e ans = Output { out :: Op String () e ans }
output :: Eff (Output :* e) ans -> Eff e (ans,String)
output
= handlerLocalRet [] (\x ss -> (x,concat ss)) $
Output { out = function (\x -> localModify (x:)) }
data Amb e ans
= Amb { flip :: Op () Bool e ans }
xor :: (Amb :? e) => Eff e Bool
xor = do x <- perform flip ()
y <- perform flip ()
return ((x && not y) || (not x && y))
allResults :: Eff (Amb :* e) a -> Eff e [a]
allResults = handlerRet (\x -> [x]) (Amb{
flip = operation (\ () k ->
do xs <- k True
ys <- k False
return (xs ++ ys)) })
firstResult :: Eff (Amb :* e) (Maybe a) ->
Eff e (Maybe a)
firstResult = handler Amb{
flip = operation (\ () k ->
do xs <- k True
case xs of
Just _ -> return xs
Nothing -> k False) }
solutions :: Eff (Exn :* Amb :* e) a -> Eff e [a]
solutions action
= fmap catMaybes (allResults (toMaybe action))
eager :: Eff (Exn :* Amb :* e) a -> Eff e (Maybe a)
eager action = firstResult (toMaybe action)
choice :: (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice p1 p2 = do b <- perform flip ()
if b then p1 else p2
many :: (Amb :? e) => Eff e a -> Eff e [a]
many p = choice (many1 p) (return [])
many1 :: (Amb :? e) => Eff e a -> Eff e [a]
many1 p = do x <- p; xs <- many p; return (x:xs)
data Parse e ans = Parse {
satisfy :: forall a.
Op (String -> (Maybe (a, String))) a e ans }
parse :: (Exn :? e) =>
String -> Eff (Parse :* e) b -> Eff e (b, String)
parse input
= handlerLocalRet input (\x s -> (x, s)) $
Parse { satisfy = operation $ \p k ->
do input <- perform lget ()
case (p input) of
Nothing -> perform failure ()
Just (x, rest) -> do perform lput rest
k x }
symbol :: (Parse :? e) => Char -> Eff e Char
symbol c = perform satisfy (\input -> case input of
(d:rest) | d == c -> Just (c, rest)
_ -> Nothing)
digit :: (Parse :? e) => Eff e Int
digit = perform satisfy (\input -> case input of
(d:rest) | isDigit d -> Just (digitToInt d, rest)
_ -> Nothing)
expr :: (Parse :? e, Amb :? e) => Eff e Int
expr = choice (do i <- term; symbol '+'; j <- term
return (i + j))
term
term :: (Parse :? e, Amb :? e) => Eff e Int
term = choice (do i <- factor; symbol '*'; j <- factor
return (i * j))
factor
factor :: (Parse :? e, Amb :? e) => Eff e Int
factor = choice (do symbol '('; i <- expr; symbol ')'
return i)
number
number :: (Parse :? e, Amb :? e) => Eff e Int
number = do xs <- many1 digit
return $ foldl (\n d -> 10 * n + d) 0 xs
test1 = runEff (solutions (parse "1+2*3" expr))
test2 = runEff (eager (parse "1+2*3" expr))
data Evil e ans = Evil { evil :: Op () () e ans }
hevil :: Eff (Evil :* e) a -> Eff e (() -> Eff e a)
hevil = handlerRet (\x -> (\_ -> return x)) (Evil{
evil = operation (\_ k ->
return (\_ -> do f <- k (); f ()))
})
ebody :: (Reader Int :? e, Evil :? e) => Eff e Int
ebody = do x <- perform ask ()
perform evil ()
y <- perform ask ()
return (x+y)
nonscoped :: Eff e Int
nonscoped = do f <- reader (1::Int) (hevil ebody)
reader (2::Int) (f ())