-- | Description: functions to combine vendors and jobs

module SupplyChain.Core.Connect
  (
    {- * Vendor to job -} (>-), (>+),
    {- * Vendor to vendor -} (>->),
    {- * Referral -} joinReferral,
  )
  where

import Control.Monad ((>>=))
import Data.Functor ((<&>), fmap)

import SupplyChain.Core.Job (Job)
import SupplyChain.Core.Referral (Referral (Referral))
import SupplyChain.Core.Vendor (Vendor (Vendor, handle))

import qualified SupplyChain.Core.Job as Job
import qualified SupplyChain.Core.Referral as Referral
import qualified SupplyChain.Core.Vendor as Vendor

infixl 6 >-
infixl 6 >+
infixl 7 >->

{-| Modify a job with a vendor that interprets its requests -}
(>-) :: Vendor up down action -- ^ Upstream
     -> Job down action product -- ^ Downstream
     -> Job up action product
Vendor up down action
up >- :: forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product -> Job up action product
>- Job down action product
down = Vendor up down action
up forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ Job down action product
down forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> product
Referral.product

{-| Connect two vendors; the first interprets requests made by the second -}
(>->) :: Vendor up middle action -- ^ Upstream
      -> Vendor middle down action -- ^ Downstream
      -> Vendor up down action
Vendor up middle action
up >-> :: forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *).
Vendor up middle action
-> Vendor middle down action -> Vendor up down action
>-> Vendor middle down action
down = Vendor { handle :: forall product.
down product -> Job up action (Referral up down action product)
handle = \down product
request ->
    Vendor up middle action
up forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ (forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
Vendor up down action
-> forall product.
   down product -> Job up action (Referral up down action product)
Vendor.handle Vendor middle down action
down down product
request) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *) product.
Referral up middle action (Referral middle down action product)
-> Referral up down action product
joinReferral }

{-| Sort of resembles what a 'Control.Monad.join' implementation for 'Referral'
    might look like, modulo a subtle difference in the types -}
joinReferral :: Referral up middle action (Referral middle down action product)
    -> Referral up down action product
joinReferral :: forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *) product.
Referral up middle action (Referral middle down action product)
-> Referral up down action product
joinReferral (Referral (Referral product
product Vendor middle down action
nextDown) Vendor up middle action
nextUp) =
    forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
product -> Vendor up down action -> Referral up down action product
Referral product
product (Vendor up middle action
nextUp forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *).
Vendor up middle action
-> Vendor middle down action -> Vendor up down action
>-> Vendor middle down action
nextDown)

{-| Connect a vendor to a job, producing a job which returns both the product
    and a new version of the vendor.

    Use this function instead of '(>-)' if you need to attach a succession
    of jobs to one stateful vendor. -}
(>+) :: Vendor up down action -- ^ Upstream
     -> Job down action product -- ^ Downstream
     -> Job up action (Referral up down action product)
Vendor up down action
up >+ :: forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ Job down action product
job = case Job down action product
job of
    Job.Pure product
product -> forall product (up :: * -> *) (action :: * -> *).
product -> Job up action product
Job.Pure (forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
product -> Vendor up down action -> Referral up down action product
Referral product
product Vendor up down action
up)
    Job.Perform action x
action x -> product
extract -> forall (action :: * -> *) product (up :: * -> *) x.
action x -> (x -> product) -> Job up action product
Job.Perform action x
action x -> product
extract forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
product -> Vendor up down action -> Referral up down action product
`Referral` Vendor up down action
up)
    Job.Request down x
request x -> product
extract -> forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
Vendor up down action
-> forall product.
   down product -> Job up action (Referral up down action product)
Vendor.handle Vendor up down action
up down x
request forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> product
extract
    Job.Bind Job down action x
a x -> Job down action product
b -> Vendor up down action
up forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ Job down action x
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Referral x
x Vendor up down action
up') -> Vendor up down action
up' forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ x -> Job down action product
b x
x