module SupplyChain.Core.FreeMonad
(
FreeMonad (Step, Bind, Pure, Map),
run, eval,
alter,
)
where
import Control.Applicative (Applicative (pure, (<*>)))
import Control.Monad (Monad ((>>=)))
import Data.Function ((&), ($), (.))
import Data.Functor (Functor, (<&>))
import SupplyChain.Core.FreePointedFunctor (FreePointedFunctor)
import qualified Control.Monad as Monad
import qualified SupplyChain.Core.FreePointedFunctor as FreePointedFunctor
data FreeMonad f a =
Step (FreePointedFunctor f a)
| forall x. Bind (FreeMonad f x) (x -> FreeMonad f a)
pattern Pure :: a -> FreeMonad f a
pattern $bPure :: forall a (f :: * -> *). a -> FreeMonad f a
$mPure :: forall {r} {a} {f :: * -> *}.
FreeMonad f a -> (a -> r) -> ((# #) -> r) -> r
Pure a = Step (FreePointedFunctor.Pure a)
pattern Map :: f x -> (x -> a) -> FreeMonad f a
pattern $bMap :: forall (f :: * -> *) a x. f x -> (x -> a) -> FreeMonad f a
$mMap :: forall {r} {f :: * -> *} {a}.
FreeMonad f a
-> (forall {x}. f x -> (x -> a) -> r) -> ((# #) -> r) -> r
Map action extract = Step (FreePointedFunctor.Map action extract)
{-# complete Pure, Map, Bind #-}
deriving instance Functor (FreeMonad f)
instance Applicative (FreeMonad f) where pure :: forall a. a -> FreeMonad f a
pure = forall a (f :: * -> *). a -> FreeMonad f a
Pure; <*> :: forall a b. FreeMonad f (a -> b) -> FreeMonad f a -> FreeMonad f b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
Monad.ap
instance Monad (FreeMonad f) where >>= :: forall a b. FreeMonad f a -> (a -> FreeMonad f b) -> FreeMonad f b
(>>=) = forall (f :: * -> *) a x.
FreeMonad f x -> (x -> FreeMonad f a) -> FreeMonad f a
Bind
run :: Monad effect =>
(forall x. f x -> effect x)
-> FreeMonad f a -> effect a
run :: forall (effect :: * -> *) (f :: * -> *) a.
Monad effect =>
(forall x. f x -> effect x) -> FreeMonad f a -> effect a
run (forall x. f x -> effect x
runEffect :: forall x. f x -> effect x) = forall x. FreeMonad f x -> effect x
recur
where
runPF :: FreePointedFunctor f x -> effect x
runPF :: forall x. FreePointedFunctor f x -> effect x
runPF = forall (effect :: * -> *) (f :: * -> *) product.
Monad effect =>
(forall x. f x -> effect x)
-> FreePointedFunctor f product -> effect product
FreePointedFunctor.run forall x. f x -> effect x
runEffect
recur :: FreeMonad f x -> effect x
recur :: forall x. FreeMonad f x -> effect x
recur = \case
Step FreePointedFunctor f x
a -> forall x. FreePointedFunctor f x -> effect x
runPF FreePointedFunctor f x
a
Bind (Step FreePointedFunctor f x
a) x -> FreeMonad f x
b -> forall x. FreePointedFunctor f x -> effect x
runPF FreePointedFunctor f x
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
x -> forall x. FreeMonad f x -> effect x
recur forall a b. (a -> b) -> a -> b
$ x -> FreeMonad f x
b x
x
Bind (Bind FreeMonad f x
a x -> FreeMonad f x
b) x -> FreeMonad f x
c -> forall x. FreeMonad f x -> effect x
recur FreeMonad f x
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
x -> forall x. FreeMonad f x -> effect x
recur forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a x.
FreeMonad f x -> (x -> FreeMonad f a) -> FreeMonad f a
Bind (x -> FreeMonad f x
b x
x) x -> FreeMonad f x
c
eval :: (forall x. f x -> x)
-> FreeMonad f a
-> a
eval :: forall (f :: * -> *) a. (forall x. f x -> x) -> FreeMonad f a -> a
eval (forall x. f x -> x
evalEffect :: forall x. f x -> x) = forall x. FreeMonad f x -> x
recur
where
evalPF :: FreePointedFunctor f x -> x
evalPF :: forall x. FreePointedFunctor f x -> x
evalPF = forall (f :: * -> *) product.
(forall x. f x -> x) -> FreePointedFunctor f product -> product
FreePointedFunctor.eval forall x. f x -> x
evalEffect
recur :: FreeMonad f x -> x
recur :: forall x. FreeMonad f x -> x
recur = \case
Step FreePointedFunctor f x
a -> forall x. FreePointedFunctor f x -> x
evalPF FreePointedFunctor f x
a
Bind (Step FreePointedFunctor f x
a) x -> FreeMonad f x
b -> forall x. FreePointedFunctor f x -> x
evalPF FreePointedFunctor f x
a forall a b. a -> (a -> b) -> b
& \x
x -> forall x. FreeMonad f x -> x
recur forall a b. (a -> b) -> a -> b
$ x -> FreeMonad f x
b x
x
Bind (Bind FreeMonad f x
a x -> FreeMonad f x
b) x -> FreeMonad f x
c -> forall x. FreeMonad f x -> x
recur FreeMonad f x
a forall a b. a -> (a -> b) -> b
& \x
x -> forall x. FreeMonad f x -> x
recur forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a x.
FreeMonad f x -> (x -> FreeMonad f a) -> FreeMonad f a
Bind (x -> FreeMonad f x
b x
x) x -> FreeMonad f x
c
alter :: (forall x. f x -> FreeMonad f' x)
-> FreeMonad f a -> FreeMonad f' a
alter :: forall (f :: * -> *) (f' :: * -> *) a.
(forall x. f x -> FreeMonad f' x)
-> FreeMonad f a -> FreeMonad f' a
alter (forall x. f x -> FreeMonad f' x
f :: forall x. f x -> FreeMonad f' x) = forall x. FreeMonad f x -> FreeMonad f' x
recur
where
recur :: FreeMonad f x -> FreeMonad f' x
recur :: forall x. FreeMonad f x -> FreeMonad f' x
recur = \case
Pure x
x -> forall a (f :: * -> *). a -> FreeMonad f a
Pure x
x
Map f x
action x -> x
extract -> forall x. f x -> FreeMonad f' x
f f x
action forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> x -> x
extract
Bind FreeMonad f x
a x -> FreeMonad f x
b -> forall (f :: * -> *) a x.
FreeMonad f x -> (x -> FreeMonad f a) -> FreeMonad f a
Bind (forall x. FreeMonad f x -> FreeMonad f' x
recur FreeMonad f x
a) (forall x. FreeMonad f x -> FreeMonad f' x
recur forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> FreeMonad f x
b)