{-# LANGUAGE  TypeOperators, FlexibleContexts, Rank2Types  #-}
{-|
Description : Examples of Control.Ev.Eff
Copyright   : (c) 2020, Microsoft Research; Daan Leijen; Ningning Xie
License     : MIT
Maintainer  : xnning@hku.hk; daan@microsoft.com
Stability   : Experimental

Examples from /"Effect Handlers in Haskell, Evidently"/, Ningning Xie and Daan Leijen, Haskell 2020.
-}
module Examples where
import Control.Ev.Eff
import Prelude hiding (flip)
import Data.Char
import Data.Maybe

-- BEGIN:reader
data Reader a e ans = Reader { Reader a e ans -> Op () a e ans
ask :: Op () a e ans }
-- END:reader

-- BEGIN:readerhr
hr :: a -> Reader a e ans
hr :: a -> Reader a e ans
hr a
x = Reader :: forall a e ans. Op () a e ans -> Reader a e ans
Reader{ ask :: Op () a e ans
ask = (() -> (a -> Eff e ans) -> Eff e ans) -> Op () a e ans
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\ () a -> Eff e ans
k -> a -> Eff e ans
k a
x) }
-- END:readerhr

-- BEGIN:readerh
reader :: a -> Eff (Reader a :* e) ans -> Eff e ans
reader :: a -> Eff (Reader a :* e) ans -> Eff e ans
reader a
x Eff (Reader a :* e) ans
action = Reader a e ans -> Eff (Reader a :* e) ans -> Eff e ans
forall (h :: * -> * -> *) e ans.
h e ans -> Eff (h :* e) ans -> Eff e ans
handler (a -> Reader a e ans
forall a e ans. a -> Reader a e ans
hr a
x) Eff (Reader a :* e) ans
action
-- END:readerh

-- when to introduce function
-- show type of: handler :: h e ans -> Eff (h :* e) -> Eff e

-- BEGIN:readerex1
sample1 :: Eff e [Char]
sample1 = [Char] -> Eff (Reader [Char] :* e) [Char] -> Eff e [Char]
forall a e ans. a -> Eff (Reader a :* e) ans -> Eff e ans
reader [Char]
"world" (Eff (Reader [Char] :* e) [Char] -> Eff e [Char])
-> Eff (Reader [Char] :* e) [Char] -> Eff e [Char]
forall a b. (a -> b) -> a -> b
$
          do [Char]
s <- (forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff (Reader [Char] :* e) [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
             [Char] -> Eff (Reader [Char] :* e) [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"hello " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
-- END:readerex1

-- BEGIN:readermult
greetOrExit::(Reader String :? e, Reader Bool :? e)
                => Eff e String
greetOrExit :: Eff e [Char]
greetOrExit
  = do [Char]
s <- (forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff e [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
       Bool
isExit <- (forall e' ans. Reader Bool e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader Bool e' ans -> Op () Bool e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
       if Bool
isExit then [Char] -> Eff e [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"goodbye " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
       else [Char] -> Eff e [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"hello " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
-- END:readermult

-- BEGIN:readernoctx
greetMaybe :: (Reader String :? e) => Eff e (Maybe String)
greetMaybe :: Eff e (Maybe [Char])
greetMaybe = do [Char]
s <- (forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff e [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
                if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s then Maybe [Char] -> Eff e (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                else Maybe [Char] -> Eff e (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"hello " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s))
-- END:readernoctx

-- BEGIN:readergreet
greet :: (Reader String :? e) => Eff e String
greet :: Eff e [Char]
greet = do [Char]
s <- (forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff e [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
           [Char] -> Eff e [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"hello " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
-- END:readergreet

-- BEGIN:readerex
helloWorld :: Eff e String
helloWorld :: Eff e [Char]
helloWorld = [Char] -> Eff (Reader [Char] :* e) [Char] -> Eff e [Char]
forall a e ans. a -> Eff (Reader a :* e) ans -> Eff e ans
reader [Char]
"world" Eff (Reader [Char] :* e) [Char]
forall e. (Reader [Char] :? e) => Eff e [Char]
greet
-- END:readerex

-- BEGIN:exn
data Exn e ans
     = Exn { Exn e ans -> forall a. Op () a e ans
failure :: forall a. Op () a e ans }
-- END:exn

failure' :: Exn e ans -> Op () a e ans
failure' :: Exn e ans -> Op () a e ans
failure' Exn e ans
exn = Exn e ans -> forall a. Op () a e ans
forall e ans. Exn e ans -> forall a. Op () a e ans
failure Exn e ans
exn

-- BEGIN:toMaybe
toMaybe :: Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe :: Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe
  = (a -> Maybe a)
-> Exn e (Maybe a) -> Eff (Exn :* e) a -> Eff e (Maybe a)
forall ans a (h :: * -> * -> *) e.
(ans -> a) -> h e a -> Eff (h :* e) ans -> Eff e a
handlerRet a -> Maybe a
forall a. a -> Maybe a
Just (Exn e (Maybe a) -> Eff (Exn :* e) a -> Eff e (Maybe a))
-> Exn e (Maybe a) -> Eff (Exn :* e) a -> Eff e (Maybe a)
forall a b. (a -> b) -> a -> b
$ Exn :: forall e ans. (forall a. Op () a e ans) -> Exn e ans
Exn{
      failure :: forall a. Op () a e (Maybe a)
failure = (() -> (a -> Eff e (Maybe a)) -> Eff e (Maybe a))
-> Op () a e (Maybe a)
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\ () a -> Eff e (Maybe a)
_ -> Maybe a -> Eff e (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) }
-- END:toMaybe

-- BEGIN:exceptDefault
exceptDefault :: a -> Eff (Exn :* e) a -> Eff e a
exceptDefault :: a -> Eff (Exn :* e) a -> Eff e a
exceptDefault a
x
  = Exn e a -> Eff (Exn :* e) a -> Eff e a
forall (h :: * -> * -> *) e ans.
h e ans -> Eff (h :* e) ans -> Eff e ans
handler (Exn e a -> Eff (Exn :* e) a -> Eff e a)
-> Exn e a -> Eff (Exn :* e) a -> Eff e a
forall a b. (a -> b) -> a -> b
$
    Exn :: forall e ans. (forall a. Op () a e ans) -> Exn e ans
Exn{ failure :: forall a. Op () a e a
failure = (() -> (a -> Eff e a) -> Eff e a) -> Op () a e a
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\ () a -> Eff e a
_ -> a -> Eff e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x) }
-- END:exceptDefault

-- BEGIN:exnex
safeDiv :: (Exn :? e) => Int -> Int -> Eff e Int
safeDiv :: Int -> Int -> Eff e Int
safeDiv Int
x Int
0 = (forall e' ans. Exn e' ans -> Op () Int e' ans) -> () -> Eff e Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Exn e' ans -> Op () Int e' ans
forall e ans a. Exn e ans -> Op () a e ans
failure' ()
safeDiv Int
x Int
y = Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
y)
-- END:exnex

safeHead :: (Exn :? e) => String -> Eff e Char
safeHead :: [Char] -> Eff e Char
safeHead []    = (forall e' ans. Exn e' ans -> Op () Char e' ans)
-> () -> Eff e Char
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Exn e' ans -> Op () Char e' ans
forall e ans a. Exn e ans -> Op () a e ans
failure' ()
safeHead (Char
x:[Char]
_) = Char -> Eff e Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x

sample3 :: Eff e (Maybe (Maybe Char))
sample3 = [Char]
-> Eff (Reader [Char] :* e) (Maybe (Maybe Char))
-> Eff e (Maybe (Maybe Char))
forall a e ans. a -> Eff (Reader a :* e) ans -> Eff e ans
reader [Char]
"" (Eff (Reader [Char] :* e) (Maybe (Maybe Char))
 -> Eff e (Maybe (Maybe Char)))
-> Eff (Reader [Char] :* e) (Maybe (Maybe Char))
-> Eff e (Maybe (Maybe Char))
forall a b. (a -> b) -> a -> b
$
          Eff (Exn :* (Reader [Char] :* e)) (Maybe Char)
-> Eff (Reader [Char] :* e) (Maybe (Maybe Char))
forall e a. Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe (Eff (Exn :* (Reader [Char] :* e)) (Maybe Char)
 -> Eff (Reader [Char] :* e) (Maybe (Maybe Char)))
-> Eff (Exn :* (Reader [Char] :* e)) (Maybe Char)
-> Eff (Reader [Char] :* e) (Maybe (Maybe Char))
forall a b. (a -> b) -> a -> b
$
          do [Char]
s <- (forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff (Exn :* (Reader [Char] :* e)) [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()
             Char
c <- [Char] -> Eff (Exn :* (Reader [Char] :* e)) Char
forall e. (Exn :? e) => [Char] -> Eff e Char
safeHead [Char]
s
             Maybe Char -> Eff (Exn :* (Reader [Char] :* e)) (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)

-- introduce handlerRet

-- BEGIN:state
data State a e ans = State { State a e ans -> Op () a e ans
get :: Op () a e ans
                           , State a e ans -> Op a () e ans
put :: Op a () e ans }
-- END:state

-- BEGIN:statex
state :: a -> Eff (State a :* e) ans -> Eff e ans
state :: a -> Eff (State a :* e) ans -> Eff e ans
state a
init
  = a
-> State a (Local a :* e) ans
-> Eff (State a :* e) ans
-> Eff e ans
forall a (h :: * -> * -> *) e ans.
a -> h (Local a :* e) ans -> Eff (h :* e) ans -> Eff e ans
handlerLocal a
init (State a (Local a :* e) ans -> Eff (State a :* e) ans -> Eff e ans)
-> State a (Local a :* e) ans
-> Eff (State a :* e) ans
-> Eff e ans
forall a b. (a -> b) -> a -> b
$
    State :: forall a e ans. Op () a e ans -> Op a () e ans -> State a e ans
State{ get :: Op () a (Local a :* e) ans
get = (() -> Eff (Local a :* e) a) -> Op () a (Local a :* e) ans
forall a e b ans. (a -> Eff e b) -> Op a b e ans
function (\ () -> (forall e' ans. Local a e' ans -> Op () a e' ans)
-> () -> Eff (Local a :* e) a
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Local a e' ans -> Op () a e' ans
forall a e ans. Local a e ans -> Op () a e ans
lget ())
         , put :: Op a () (Local a :* e) ans
put = (a -> Eff (Local a :* e) ()) -> Op a () (Local a :* e) ans
forall a e b ans. (a -> Eff e b) -> Op a b e ans
function (\ a
x  -> (forall e' ans. Local a e' ans -> Op a () e' ans)
-> a -> Eff (Local a :* e) ()
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Local a e' ans -> Op a () e' ans
forall a e ans. Local a e ans -> Op a () e ans
lput a
x) }
-- END:statex

-- BEGIN:stateex
add :: (State Int :? e) => Int -> Eff e ()
add :: Int -> Eff e ()
add Int
i = do Int
j <- (forall e' ans. State Int e' ans -> Op () Int e' ans)
-> () -> Eff e Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Int e' ans -> Op () Int e' ans
forall a e ans. State a e ans -> Op () a e ans
get ()
           (forall e' ans. State Int e' ans -> Op Int () e' ans)
-> Int -> Eff e ()
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Int e' ans -> Op Int () e' ans
forall a e ans. State a e ans -> Op a () e ans
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j)
-- END:stateex

-- BEGIN:invert
invert :: (State Bool :? e) => Eff e Bool
invert :: Eff e Bool
invert = do Bool
b <- (forall e' ans. State Bool e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Bool e' ans -> Op () Bool e' ans
forall a e ans. State a e ans -> Op () a e ans
get ()
            (forall e' ans. State Bool e' ans -> Op Bool () e' ans)
-> Bool -> Eff e ()
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Bool e' ans -> Op Bool () e' ans
forall a e ans. State a e ans -> Op a () e ans
put (Bool -> Bool
not Bool
b)
            (forall e' ans. State Bool e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Bool e' ans -> Op () Bool e' ans
forall a e ans. State a e ans -> Op () a e ans
get ()
-- END:invert

-- BEGIN:double
test :: Eff e Bool
test :: Eff e Bool
test = Bool -> Eff (State Bool :* e) Bool -> Eff e Bool
forall a e ans. a -> Eff (State a :* e) ans -> Eff e ans
state Bool
True (Eff (State Bool :* e) Bool -> Eff e Bool)
-> Eff (State Bool :* e) Bool -> Eff e Bool
forall a b. (a -> b) -> a -> b
$ do Eff (State Bool :* e) Bool
forall e. (State Bool :? e) => Eff e Bool
invert
                       Bool
b <- (forall e' ans. State Bool e' ans -> Op () Bool e' ans)
-> () -> Eff (State Bool :* e) Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Bool e' ans -> Op () Bool e' ans
forall a e ans. State a e ans -> Op () a e ans
get ()
                       Bool -> Eff (State Bool :* e) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
-- END:double

adder :: Eff e [Char]
adder = Int -> Eff (State Int :* e) [Char] -> Eff e [Char]
forall a e ans. a -> Eff (State a :* e) ans -> Eff e ans
state (Int
1::Int) (Eff (State Int :* e) [Char] -> Eff e [Char])
-> Eff (State Int :* e) [Char] -> Eff e [Char]
forall a b. (a -> b) -> a -> b
$
        do Int -> Eff (State Int :* e) ()
forall e. (State Int :? e) => Int -> Eff e ()
add Int
41
           Int
i <- (forall e' ans. State Int e' ans -> Op () Int e' ans)
-> () -> Eff (State Int :* e) Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. State Int e' ans -> Op () Int e' ans
forall a e ans. State a e ans -> Op () a e ans
get ()
           [Char] -> Eff (State Int :* e) [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"the final state is: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i::Int))




-- BEGIN:output
data Output e ans = Output { Output e ans -> Op [Char] () e ans
out :: Op String () e ans }

output :: Eff (Output :* e) ans -> Eff e (ans,String)
output :: Eff (Output :* e) ans -> Eff e (ans, [Char])
output
  = [[Char]]
-> (ans -> [[Char]] -> (ans, [Char]))
-> Output (Local [[Char]] :* e) (ans, [Char])
-> Eff (Output :* e) ans
-> Eff e (ans, [Char])
forall a ans b (h :: * -> * -> *) e.
a
-> (ans -> a -> b)
-> h (Local a :* e) b
-> Eff (h :* e) ans
-> Eff e b
handlerLocalRet [] (\ans
x [[Char]]
ss -> (ans
x,[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
ss)) (Output (Local [[Char]] :* e) (ans, [Char])
 -> Eff (Output :* e) ans -> Eff e (ans, [Char]))
-> Output (Local [[Char]] :* e) (ans, [Char])
-> Eff (Output :* e) ans
-> Eff e (ans, [Char])
forall a b. (a -> b) -> a -> b
$
    Output :: forall e ans. Op [Char] () e ans -> Output e ans
Output { out :: Op [Char] () (Local [[Char]] :* e) (ans, [Char])
out = ([Char] -> Eff (Local [[Char]] :* e) ())
-> Op [Char] () (Local [[Char]] :* e) (ans, [Char])
forall a e b ans. (a -> Eff e b) -> Op a b e ans
function (\[Char]
x -> ([[Char]] -> [[Char]]) -> Eff (Local [[Char]] :* e) ()
forall a e. (a -> a) -> Eff (Local a :* e) ()
localModify ([Char]
x[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:)) }

-- END:output


-- BEGIN:amb
data Amb e ans
     = Amb { Amb e ans -> Op () Bool e ans
flip :: Op () Bool e ans }
-- END:amb

-- BEGIN:xor
xor :: (Amb :? e) => Eff e Bool
xor :: Eff e Bool
xor = do Bool
x <- (forall e' ans. Amb e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Amb e' ans -> Op () Bool e' ans
flip ()
         Bool
y <- (forall e' ans. Amb e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Amb e' ans -> Op () Bool e' ans
flip ()
         Bool -> Eff e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool
x Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
y) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
x Bool -> Bool -> Bool
&& Bool
y))
-- END:xor

-- BEGIN:allresults
allResults :: Eff (Amb :* e) a -> Eff e [a]
allResults :: Eff (Amb :* e) a -> Eff e [a]
allResults = (a -> [a]) -> Amb e [a] -> Eff (Amb :* e) a -> Eff e [a]
forall ans a (h :: * -> * -> *) e.
(ans -> a) -> h e a -> Eff (h :* e) ans -> Eff e a
handlerRet (\a
x -> [a
x]) (Amb :: forall e ans. Op () Bool e ans -> Amb e ans
Amb{
  flip :: Op () Bool e [a]
flip = (() -> (Bool -> Eff e [a]) -> Eff e [a]) -> Op () Bool e [a]
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\ () Bool -> Eff e [a]
k ->
            do [a]
xs <- Bool -> Eff e [a]
k Bool
True
               [a]
ys <- Bool -> Eff e [a]
k Bool
False
               [a] -> Eff e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys)) })
-- END:allresults

-- BEGIN:backtrack
firstResult :: Eff (Amb :* e) (Maybe a) ->
                 Eff e (Maybe a)
firstResult :: Eff (Amb :* e) (Maybe a) -> Eff e (Maybe a)
firstResult = Amb e (Maybe a) -> Eff (Amb :* e) (Maybe a) -> Eff e (Maybe a)
forall (h :: * -> * -> *) e ans.
h e ans -> Eff (h :* e) ans -> Eff e ans
handler Amb :: forall e ans. Op () Bool e ans -> Amb e ans
Amb{
  flip :: Op () Bool e (Maybe a)
flip = (() -> (Bool -> Eff e (Maybe a)) -> Eff e (Maybe a))
-> Op () Bool e (Maybe a)
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\ () Bool -> Eff e (Maybe a)
k ->
           do Maybe a
xs <- Bool -> Eff e (Maybe a)
k Bool
True
              case Maybe a
xs of
                Just a
_  -> Maybe a -> Eff e (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
xs
                Maybe a
Nothing -> Bool -> Eff e (Maybe a)
k Bool
False) }
-- END:backtrack



-- BEGIN:solutions
solutions :: Eff (Exn :* Amb :* e) a -> Eff e [a]
solutions :: Eff (Exn :* (Amb :* e)) a -> Eff e [a]
solutions Eff (Exn :* (Amb :* e)) a
action
  = ([Maybe a] -> [a]) -> Eff e [Maybe a] -> Eff e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes (Eff (Amb :* e) (Maybe a) -> Eff e [Maybe a]
forall e a. Eff (Amb :* e) a -> Eff e [a]
allResults (Eff (Exn :* (Amb :* e)) a -> Eff (Amb :* e) (Maybe a)
forall e a. Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe Eff (Exn :* (Amb :* e)) a
action))
-- END:solutions

-- BEGIN:eager
eager :: Eff (Exn :* Amb :* e) a -> Eff e (Maybe a)
eager :: Eff (Exn :* (Amb :* e)) a -> Eff e (Maybe a)
eager Eff (Exn :* (Amb :* e)) a
action = Eff (Amb :* e) (Maybe a) -> Eff e (Maybe a)
forall e a. Eff (Amb :* e) (Maybe a) -> Eff e (Maybe a)
firstResult (Eff (Exn :* (Amb :* e)) a -> Eff (Amb :* e) (Maybe a)
forall e a. Eff (Exn :* e) a -> Eff e (Maybe a)
toMaybe Eff (Exn :* (Amb :* e)) a
action)
-- END:eager

-- BEGIN:choice
choice :: (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice :: Eff e a -> Eff e a -> Eff e a
choice Eff e a
p1 Eff e a
p2 = do Bool
b <- (forall e' ans. Amb e' ans -> Op () Bool e' ans)
-> () -> Eff e Bool
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Amb e' ans -> Op () Bool e' ans
flip ()
                  if Bool
b then Eff e a
p1 else Eff e a
p2
-- END:choice

-- BEGIN:manyeg
many :: (Amb :? e) => Eff e a -> Eff e [a]
many :: Eff e a -> Eff e [a]
many Eff e a
p = Eff e [a] -> Eff e [a] -> Eff e [a]
forall e a. (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice (Eff e a -> Eff e [a]
forall e a. (Amb :? e) => Eff e a -> Eff e [a]
many1 Eff e a
p) ([a] -> Eff e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

many1 :: (Amb :? e) => Eff e a -> Eff e [a]
many1 :: Eff e a -> Eff e [a]
many1 Eff e a
p = do a
x <- Eff e a
p; [a]
xs <- Eff e a -> Eff e [a]
forall e a. (Amb :? e) => Eff e a -> Eff e [a]
many Eff e a
p; [a] -> Eff e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
-- END:manyeg

-- BEGIN:parse
data Parse e ans = Parse {
  Parse e ans -> forall a. Op ([Char] -> Maybe (a, [Char])) a e ans
satisfy :: forall a.
        Op (String -> (Maybe (a, String))) a e ans }
-- END:parse

satisfy' :: Parse e ans -> Op (String -> (Maybe (a, String))) a e ans
satisfy' :: Parse e ans -> Op ([Char] -> Maybe (a, [Char])) a e ans
satisfy' Parse e ans
parse = Parse e ans -> forall a. Op ([Char] -> Maybe (a, [Char])) a e ans
forall e ans.
Parse e ans -> forall a. Op ([Char] -> Maybe (a, [Char])) a e ans
satisfy Parse e ans
parse

-- BEGIN:parsefun
parse :: (Exn :? e) =>
  String -> Eff (Parse :* e) b -> Eff e (b, String)
parse :: [Char] -> Eff (Parse :* e) b -> Eff e (b, [Char])
parse [Char]
input
  = [Char]
-> (b -> [Char] -> (b, [Char]))
-> Parse (Local [Char] :* e) (b, [Char])
-> Eff (Parse :* e) b
-> Eff e (b, [Char])
forall a ans b (h :: * -> * -> *) e.
a
-> (ans -> a -> b)
-> h (Local a :* e) b
-> Eff (h :* e) ans
-> Eff e b
handlerLocalRet [Char]
input (\b
x [Char]
s -> (b
x, [Char]
s)) (Parse (Local [Char] :* e) (b, [Char])
 -> Eff (Parse :* e) b -> Eff e (b, [Char]))
-> Parse (Local [Char] :* e) (b, [Char])
-> Eff (Parse :* e) b
-> Eff e (b, [Char])
forall a b. (a -> b) -> a -> b
$
    Parse :: forall e ans.
(forall a. Op ([Char] -> Maybe (a, [Char])) a e ans) -> Parse e ans
Parse { satisfy :: forall a.
Op ([Char] -> Maybe (a, [Char])) a (Local [Char] :* e) (b, [Char])
satisfy = (([Char] -> Maybe (a, [Char]))
 -> (a -> Eff (Local [Char] :* e) (b, [Char]))
 -> Eff (Local [Char] :* e) (b, [Char]))
-> Op
     ([Char] -> Maybe (a, [Char])) a (Local [Char] :* e) (b, [Char])
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation ((([Char] -> Maybe (a, [Char]))
  -> (a -> Eff (Local [Char] :* e) (b, [Char]))
  -> Eff (Local [Char] :* e) (b, [Char]))
 -> Op
      ([Char] -> Maybe (a, [Char])) a (Local [Char] :* e) (b, [Char]))
-> (([Char] -> Maybe (a, [Char]))
    -> (a -> Eff (Local [Char] :* e) (b, [Char]))
    -> Eff (Local [Char] :* e) (b, [Char]))
-> Op
     ([Char] -> Maybe (a, [Char])) a (Local [Char] :* e) (b, [Char])
forall a b. (a -> b) -> a -> b
$ \[Char] -> Maybe (a, [Char])
p a -> Eff (Local [Char] :* e) (b, [Char])
k ->
      do [Char]
input <- (forall e' ans. Local [Char] e' ans -> Op () [Char] e' ans)
-> () -> Eff (Local [Char] :* e) [Char]
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Local [Char] e' ans -> Op () [Char] e' ans
forall a e ans. Local a e ans -> Op () a e ans
lget ()
         case ([Char] -> Maybe (a, [Char])
p [Char]
input) of
            Maybe (a, [Char])
Nothing -> (forall e' ans. Exn e' ans -> Op () (b, [Char]) e' ans)
-> () -> Eff (Local [Char] :* e) (b, [Char])
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Exn e' ans -> Op () (b, [Char]) e' ans
forall e ans a. Exn e ans -> Op () a e ans
failure' ()
            Just (a
x, [Char]
rest) -> do (forall e' ans. Local [Char] e' ans -> Op [Char] () e' ans)
-> [Char] -> Eff (Local [Char] :* e) ()
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Local [Char] e' ans -> Op [Char] () e' ans
forall a e ans. Local a e ans -> Op a () e ans
lput [Char]
rest
                                 a -> Eff (Local [Char] :* e) (b, [Char])
k a
x }
-- END:parsefun

-- BEGIN:symbol
symbol :: (Parse :? e) => Char -> Eff e Char
symbol :: Char -> Eff e Char
symbol Char
c = (forall e' ans.
 Parse e' ans -> Op ([Char] -> Maybe (Char, [Char])) Char e' ans)
-> ([Char] -> Maybe (Char, [Char])) -> Eff e Char
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans.
Parse e' ans -> Op ([Char] -> Maybe (Char, [Char])) Char e' ans
forall e ans a.
Parse e ans -> Op ([Char] -> Maybe (a, [Char])) a e ans
satisfy' (\[Char]
input -> case [Char]
input of
    (Char
d:[Char]
rest) | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> (Char, [Char]) -> Maybe (Char, [Char])
forall a. a -> Maybe a
Just (Char
c, [Char]
rest)
    [Char]
_ -> Maybe (Char, [Char])
forall a. Maybe a
Nothing)

digit :: (Parse :? e) => Eff e Int
digit :: Eff e Int
digit = (forall e' ans.
 Parse e' ans -> Op ([Char] -> Maybe (Int, [Char])) Int e' ans)
-> ([Char] -> Maybe (Int, [Char])) -> Eff e Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans.
Parse e' ans -> Op ([Char] -> Maybe (Int, [Char])) Int e' ans
forall e ans a.
Parse e ans -> Op ([Char] -> Maybe (a, [Char])) a e ans
satisfy' (\[Char]
input -> case [Char]
input of
    (Char
d:[Char]
rest) | Char -> Bool
isDigit Char
d -> (Int, [Char]) -> Maybe (Int, [Char])
forall a. a -> Maybe a
Just (Char -> Int
digitToInt Char
d, [Char]
rest)
    [Char]
_ -> Maybe (Int, [Char])
forall a. Maybe a
Nothing)
-- END:symbol

-- BEGIN:expr
expr :: (Parse :? e, Amb :? e) => Eff e Int
expr :: Eff e Int
expr = Eff e Int -> Eff e Int -> Eff e Int
forall e a. (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice (do Int
i <- Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
term; Char -> Eff e Char
forall e. (Parse :? e) => Char -> Eff e Char
symbol Char
'+'; Int
j <- Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
term
                  Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j))
              Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
term

term :: (Parse :? e, Amb :? e) => Eff e Int
term :: Eff e Int
term = Eff e Int -> Eff e Int -> Eff e Int
forall e a. (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice (do Int
i <- Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
factor; Char -> Eff e Char
forall e. (Parse :? e) => Char -> Eff e Char
symbol Char
'*'; Int
j <- Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
factor
                  Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j))
              Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
factor

factor :: (Parse :? e, Amb :? e) => Eff e Int
factor :: Eff e Int
factor = Eff e Int -> Eff e Int -> Eff e Int
forall e a. (Amb :? e) => Eff e a -> Eff e a -> Eff e a
choice (do Char -> Eff e Char
forall e. (Parse :? e) => Char -> Eff e Char
symbol Char
'('; Int
i <- Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
expr; Char -> Eff e Char
forall e. (Parse :? e) => Char -> Eff e Char
symbol Char
')'
                    Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i)
                Eff e Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
number

number :: (Parse :? e, Amb :? e) => Eff e Int
number :: Eff e Int
number = do [Int]
xs <- Eff e Int -> Eff e [Int]
forall e a. (Amb :? e) => Eff e a -> Eff e [a]
many1 Eff e Int
forall e. (Parse :? e) => Eff e Int
digit
            Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Eff e Int) -> Int -> Eff e Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
n Int
d -> Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) Int
0 [Int]
xs

-- END:expr

test1 :: [(Int, [Char])]
test1 = Eff () [(Int, [Char])] -> [(Int, [Char])]
forall a. Eff () a -> a
runEff (Eff (Exn :* (Amb :* ())) (Int, [Char]) -> Eff () [(Int, [Char])]
forall e a. Eff (Exn :* (Amb :* e)) a -> Eff e [a]
solutions ([Char]
-> Eff (Parse :* (Exn :* (Amb :* ()))) Int
-> Eff (Exn :* (Amb :* ())) (Int, [Char])
forall e b.
(Exn :? e) =>
[Char] -> Eff (Parse :* e) b -> Eff e (b, [Char])
parse [Char]
"1+2*3" Eff (Parse :* (Exn :* (Amb :* ()))) Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
expr))
-- [(7,""),(3,"*3"),(1,"+2*3")]

test2 :: Maybe (Int, [Char])
test2 = Eff () (Maybe (Int, [Char])) -> Maybe (Int, [Char])
forall a. Eff () a -> a
runEff (Eff (Exn :* (Amb :* ())) (Int, [Char])
-> Eff () (Maybe (Int, [Char]))
forall e a. Eff (Exn :* (Amb :* e)) a -> Eff e (Maybe a)
eager ([Char]
-> Eff (Parse :* (Exn :* (Amb :* ()))) Int
-> Eff (Exn :* (Amb :* ())) (Int, [Char])
forall e b.
(Exn :? e) =>
[Char] -> Eff (Parse :* e) b -> Eff e (b, [Char])
parse [Char]
"1+2*3" Eff (Parse :* (Exn :* (Amb :* ()))) Int
forall e. (Parse :? e, Amb :? e) => Eff e Int
expr))
-- Just (7,"")


-- BEGIN:evil
data Evil e ans = Evil { Evil e ans -> Op () () e ans
evil :: Op () () e ans }

hevil :: Eff (Evil :* e) a -> Eff e (() -> Eff e a)
hevil :: Eff (Evil :* e) a -> Eff e (() -> Eff e a)
hevil = (a -> () -> Eff e a)
-> Evil e (() -> Eff e a)
-> Eff (Evil :* e) a
-> Eff e (() -> Eff e a)
forall ans a (h :: * -> * -> *) e.
(ans -> a) -> h e a -> Eff (h :* e) ans -> Eff e a
handlerRet (\a
x -> (\()
_ -> a -> Eff e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)) (Evil :: forall e ans. Op () () e ans -> Evil e ans
Evil{
          evil :: Op () () e (() -> Eff e a)
evil = (() -> (() -> Eff e (() -> Eff e a)) -> Eff e (() -> Eff e a))
-> Op () () e (() -> Eff e a)
forall a b e ans.
(a -> (b -> Eff e ans) -> Eff e ans) -> Op a b e ans
operation (\()
_ () -> Eff e (() -> Eff e a)
k ->
                    (() -> Eff e a) -> Eff e (() -> Eff e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (\()
_ -> do () -> Eff e a
f <- () -> Eff e (() -> Eff e a)
k (); () -> Eff e a
f ()))
        })
-- END:evil

-- BEGIN:evilbody
ebody :: (Reader Int :? e, Evil :? e) => Eff e Int
ebody :: Eff e Int
ebody = do Int
x <- (forall e' ans. Reader Int e' ans -> Op () Int e' ans)
-> () -> Eff e Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader Int e' ans -> Op () Int e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()    -- x == 1
           (forall e' ans. Evil e' ans -> Op () () e' ans) -> () -> Eff e ()
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Evil e' ans -> Op () () e' ans
evil ()
           Int
y <- (forall e' ans. Reader Int e' ans -> Op () Int e' ans)
-> () -> Eff e Int
forall (h :: * -> * -> *) e a b.
(h :? e) =>
(forall e' ans. h e' ans -> Op a b e' ans) -> a -> Eff e b
perform forall e' ans. Reader Int e' ans -> Op () Int e' ans
forall a e ans. Reader a e ans -> Op () a e ans
ask ()    -- y == 2 !
           Int -> Eff e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y)
-- END:evilbody

-- BEGIN:nonscoped
nonscoped :: Eff e Int
nonscoped :: Eff e Int
nonscoped = do () -> Eff (Reader Int :* e) Int
f <- Int
-> Eff (Reader Int :* e) (() -> Eff (Reader Int :* e) Int)
-> Eff e (() -> Eff (Reader Int :* e) Int)
forall a e ans. a -> Eff (Reader a :* e) ans -> Eff e ans
reader (Int
1::Int) (Eff (Evil :* (Reader Int :* e)) Int
-> Eff (Reader Int :* e) (() -> Eff (Reader Int :* e) Int)
forall e a. Eff (Evil :* e) a -> Eff e (() -> Eff e a)
hevil Eff (Evil :* (Reader Int :* e)) Int
forall e. (Reader Int :? e, Evil :? e) => Eff e Int
ebody)
               Int -> Eff (Reader Int :* e) Int -> Eff e Int
forall a e ans. a -> Eff (Reader a :* e) ans -> Eff e ans
reader (Int
2::Int) (() -> Eff (Reader Int :* e) Int
f ())
-- END:nonscoped