module SupplyChain.JobAndVendor
(
(>-), (>+),
once, loop, loop',
)
where
import SupplyChain.Core.Job (Job)
import SupplyChain.Core.Referral (Referral (Referral))
import SupplyChain.Core.Unit (Unit)
import SupplyChain.Core.Vendor (Vendor (Vendor, handle))
import qualified SupplyChain.Core.JobAndVendor as Core
import qualified SupplyChain.Core.Connect as Core
import Data.Functor ((<&>))
(>-) :: Vendor up down action
-> Job down action product
-> Job up action product
>- :: forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product -> Job up action product
(>-) = forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Vendor up down action
-> Job down action product -> Job up action product
(Core.>-)
(>+) :: Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
>+ :: 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 :: * -> *) product.
Vendor up down action
-> Job down action product
-> Job up action (Referral up down action product)
(Core.>+)
loop :: Job up action product
-> Vendor up (Unit product) action
loop :: forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> Vendor up (Unit product) action
loop = forall (up :: * -> *) (action :: * -> *) product.
Job up action product -> Vendor up (Unit product) action
Core.loop
once :: Vendor up (Unit product) action
-> Job up action product
once :: forall (up :: * -> *) product (action :: * -> *).
Vendor up (Unit product) action -> Job up action product
once = forall (up :: * -> *) product (action :: * -> *).
Vendor up (Unit product) action -> Job up action product
Core.once
loop' :: (forall x. down x -> Job up action x)
-> Vendor up down action
loop' :: forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> Job up action x) -> Vendor up down action
loop' forall x. down x -> Job up action x
f = Vendor up down action
go where go :: Vendor up down action
go = Vendor{ handle :: forall product.
down product -> Job up action (Referral up down action product)
handle = \down product
x -> forall x. down x -> Job up action x
f down product
x 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
go) }