-- | Description: a /job/ makes requests, performs actions, and returns

module SupplyChain.Core.Job
  (
    {- * Type -} Job (FreeMonad, Pure, Effect, Request, Perform, Bind),
    {- * Constructing -} effect, perform, order,
    {- * Running -} run, eval,
    {- * Alteration -} 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

{-| Monadic context that supports making requests, performing actions,
    and returning a single result -}
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

-- | Send a request via the job's upstream 'Interface'
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 an action in a job's 'Action' context
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 a job in its 'Action' context
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

-- | Run a job that performs no actions
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