-- | Description: /vendor/ + /referral/

module SupplyChain.Core.VendorAndReferral
  (
    {- * Types -} Vendor (..), Referral (..),
    {- * Alteration -} alterVendor, alterReferral,
  )
  where

import Data.Foldable (Foldable)
import Data.Function ((.))
import Data.Functor (Functor, fmap)
import Data.Traversable (Traversable)
import SupplyChain.Core.Effect (Effect)
import SupplyChain.Core.Job (Job)

import qualified SupplyChain.Core.Job as Job

-- | Makes requests, responds to requests, and performs actions
newtype Vendor up down action =
  Vendor
    { forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
Vendor up down action
-> forall product.
   down product -> Job up action (Referral up down action product)
handle :: forall product.
        down product -> Job up action (Referral up down action product) }

-- | The conclusion of a vendor's handling of a client request
data Referral up down action product =
  Referral
    { forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> product
product :: product -- ^ The requested product
    , forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> Vendor up down action
next :: Vendor up down action
        -- ^ A new vendor to handle subsequent requests
    }

deriving instance Functor (Referral up down action)
deriving instance Foldable (Referral up down action)
deriving instance Traversable (Referral up down action)

alterVendor :: (forall x. Effect up action x -> Job up' action' x)
    -> Vendor up down action -> Vendor up' down action'
alterVendor :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Job up' action' x)
-> Vendor up down action -> Vendor up' down action'
alterVendor forall x. Effect up action x -> Job up' action' x
f Vendor up down action
v =
    Vendor{ handle :: forall product.
down product -> Job up' action' (Referral up' down action' product)
handle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *) product.
(forall x. Effect up action x -> Job up' action' x)
-> Referral up down action product
-> Referral up' down action' product
alterReferral forall x. Effect up action x -> Job up' action' x
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) product.
(forall x. Effect up action x -> Job up' action' x)
-> Job up action product -> Job up' action' product
Job.alter forall x. Effect up action x -> Job up' action' x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
Vendor up down action
-> forall product.
   down product -> Job up action (Referral up down action product)
handle Vendor up down action
v }

alterReferral :: (forall x. Effect up action x -> Job up' action' x)
    -> Referral up down action product -> Referral up' down action' product
alterReferral :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *) product.
(forall x. Effect up action x -> Job up' action' x)
-> Referral up down action product
-> Referral up' down action' product
alterReferral forall x. Effect up action x -> Job up' action' x
f Referral up down action product
s = Referral up down action product
s{ next :: Vendor up' down action'
next = forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Job up' action' x)
-> Vendor up down action -> Vendor up' down action'
alterVendor forall x. Effect up action x -> Job up' action' x
f (forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> Vendor up down action
next Referral up down action product
s) }