module SupplyChain.Core.Job
(
Job (FreeMonad, Pure, Effect, Request, Perform, Bind),
effect, perform, order,
run, eval,
alter,
)
where
import Control.Applicative (Applicative)
import Control.Monad (Monad)
import Data.Function ((.), id)
import Data.Functor (Functor)
import Data.Functor.Const (Const)
import Data.Void (Void)
import SupplyChain.Core.Effect (Effect)
import SupplyChain.Core.FreeMonad (FreeMonad)
import qualified SupplyChain.Core.Effect as Effect
import qualified SupplyChain.Core.FreeMonad as FreeMonad
newtype Job up action product =
FreeMonad { forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad :: FreeMonad (Effect up action) product }
pattern Pure :: product -> Job up action product
pattern $bPure :: forall product (up :: * -> *) (action :: * -> *).
product -> Job up action product
$mPure :: forall {r} {product} {up :: * -> *} {action :: * -> *}.
Job up action product -> (product -> r) -> ((# #) -> r) -> r
Pure product = FreeMonad (FreeMonad.Pure product)
pattern Effect :: Effect up action x -> (x -> product) -> Job up action product
pattern $bEffect :: forall (up :: * -> *) (action :: * -> *) product x.
Effect up action x -> (x -> product) -> Job up action product
$mEffect :: forall {r} {up :: * -> *} {action :: * -> *} {product}.
Job up action product
-> (forall {x}. Effect up action x -> (x -> product) -> r)
-> ((# #) -> r)
-> r
Effect effect extract = FreeMonad (FreeMonad.Map effect extract)
pattern Request :: up x -> (x -> product) -> Job up action product
pattern $bRequest :: forall (up :: * -> *) product (action :: * -> *) x.
up x -> (x -> product) -> Job up action product
$mRequest :: forall {r} {up :: * -> *} {product} {action :: * -> *}.
Job up action product
-> (forall {x}. up x -> (x -> product) -> r) -> ((# #) -> r) -> r
Request request extract = Effect (Effect.Request request) extract
pattern Perform :: action x -> (x -> product) -> Job up action product
pattern $bPerform :: forall (action :: * -> *) product (up :: * -> *) x.
action x -> (x -> product) -> Job up action product
$mPerform :: forall {r} {action :: * -> *} {product} {up :: * -> *}.
Job up action product
-> (forall {x}. action x -> (x -> product) -> r)
-> ((# #) -> r)
-> r
Perform action extract = Effect (Effect.Perform action) extract
pattern Bind :: (Job up action x) -> (x -> Job up action a) -> Job up action a
pattern $bBind :: forall (up :: * -> *) (action :: * -> *) a x.
Job up action x -> (x -> Job up action a) -> Job up action a
$mBind :: forall {r} {up :: * -> *} {action :: * -> *} {a}.
Job up action a
-> (forall {x}. Job up action x -> (x -> Job up action a) -> r)
-> ((# #) -> r)
-> r
Bind a b <- FreeMonad (FreeMonad.Bind (FreeMonad -> a) ((FreeMonad .) -> b))
where Bind Job up action x
a x -> Job up action a
b = forall (up :: * -> *) (action :: * -> *) product.
FreeMonad (Effect up action) product -> Job up action product
FreeMonad (forall (f :: * -> *) a x.
FreeMonad f x -> (x -> FreeMonad f a) -> FreeMonad f a
FreeMonad.Bind (forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad Job up action x
a) (forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Job up action a
b))
{-# complete Pure, Effect, Bind #-}
{-# complete Pure, Request, Perform, Bind #-}
deriving instance Functor (Job up action)
deriving instance Applicative (Job up action)
deriving instance Monad (Job up action)
effect :: Effect up action product -> Job up action product
effect :: forall (up :: * -> *) (action :: * -> *) product.
Effect up action product -> Job up action product
effect Effect up action product
x = forall (up :: * -> *) (action :: * -> *) product x.
Effect up action x -> (x -> product) -> Job up action product
Effect Effect up action product
x forall a. a -> a
id
order :: up product -> Job up action product
order :: forall (up :: * -> *) product (action :: * -> *).
up product -> Job up action product
order up product
x = forall (up :: * -> *) product (action :: * -> *) x.
up x -> (x -> product) -> Job up action product
Request up product
x forall a. a -> a
id
perform :: action product -> Job up action product
perform :: forall (action :: * -> *) product (up :: * -> *).
action product -> Job up action product
perform action product
x = forall (action :: * -> *) product (up :: * -> *) x.
action x -> (x -> product) -> Job up action product
Perform action product
x forall a. a -> a
id
run :: Monad action => Job (Const Void) action product -> action product
run :: forall (action :: * -> *) product.
Monad action =>
Job (Const Void) action product -> action product
run = forall (effect :: * -> *) (f :: * -> *) a.
Monad effect =>
(forall x. f x -> effect x) -> FreeMonad f a -> effect a
FreeMonad.run forall {k} (action :: k -> *) (product :: k).
Effect (Const Void) action product -> action product
Effect.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad
eval :: Job (Const Void) (Const Void) product -> product
eval :: forall product. Job (Const Void) (Const Void) product -> product
eval = forall (f :: * -> *) a. (forall x. f x -> x) -> FreeMonad f a -> a
FreeMonad.eval forall {k} (x :: k) product.
Effect (Const Void) (Const Void) x -> product
Effect.absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad
alter :: (forall x. Effect up action x -> Job up' action' x)
-> Job up action product -> Job up' action' product
alter :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
(action' :: * -> *) product.
(forall x. Effect up action x -> Job up' action' x)
-> Job up action product -> Job up' action' product
alter forall x. Effect up action x -> Job up' action' x
f = forall (up :: * -> *) (action :: * -> *) product.
FreeMonad (Effect up action) product -> Job up action product
FreeMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (f' :: * -> *) a.
(forall x. f x -> FreeMonad f' x)
-> FreeMonad f a -> FreeMonad f' a
FreeMonad.alter (forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Effect up action x -> Job up' action' x
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> FreeMonad (Effect up action) product
freeMonad