-- | Description: /job/ + /vendor/

module SupplyChain.Core.JobAndVendor
  (
    {- * Types -} Job (..), Vendor (..),
    {- * Alteration -} alterJob, alterVendor,
    {- * Conversion -} loop, once,
  )
  where

import SupplyChain.Core.Effect (Effect)
import SupplyChain.Core.Job (Job)
import SupplyChain.Core.Referral (Referral (Referral))
import SupplyChain.Core.Unit (Unit (Unit))
import SupplyChain.Core.Vendor (Vendor (Vendor, handle))
import SupplyChain.Core.VendorAndReferral (alterVendor)

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

import Data.Functor

alterJob :: (forall x. Effect up action x -> Job up' action' x)
    -> Job up action product -> Job up' action' product
alterJob :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) product.
(forall x. Effect up action x -> Job up' action' x)
-> Job up action product -> Job up' action' product
alterJob = 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

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 Job up action product
j = Vendor up (Unit product) action
go
  where
    go :: Vendor up (Unit product) action
go = Vendor{ handle :: forall product.
Unit product product
-> Job up action (Referral up (Unit product) action product)
handle = \Unit product product
Unit -> Job up action product
j forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \product
product -> forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
product -> Vendor up down action -> Referral up down action product
Referral product
product Vendor up (Unit product) action
go }

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 Vendor up (Unit product) action
v = forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
Vendor up down action
-> forall product.
   down product -> Job up action (Referral up down action product)
handle Vendor up (Unit product) action
v forall {k} (a :: k) (b :: k). (a ~ b) => Unit a b
Unit 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