module SupplyChain.Core.VendorAndReferral
(
Vendor (..), Referral (..),
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
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) }
data Referral up down action product =
Referral
{ forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> product
product :: product
, forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> Vendor up down action
next :: Vendor up down action
}
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) }