-- | A /vendor/ responds to requests, makes requests, and performs actions

module SupplyChain.Vendor
  (
    {- * Type -} Vendor (Vendor, handle),
    {- * Connection -} (>->), id,
    {- * Some simple vendors -} function, action, map, absurd,
    {- * Running -} run, eval, eval',
    {- * Alteration -} alter, alter',
  )
  where

import SupplyChain.Core.Effect (Effect)
import SupplyChain.Core.Job (Job, effect)
import SupplyChain.Core.Referral (Referral (..))
import SupplyChain.Core.Vendor (Vendor (..))
import SupplyChain.JobAndVendor (loop')

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

import Control.Applicative (pure)
import Control.Monad (Monad)
import Data.Function ((.))
import Data.Functor.Const (Const)
import Data.Void (Void)

-- | 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
>-> :: forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *).
Vendor up middle action
-> Vendor middle down action -> Vendor up down action
(>->) = forall (up :: * -> *) (middle :: * -> *) (action :: * -> *)
       (down :: * -> *).
Vendor up middle action
-> Vendor middle down action -> Vendor up down action
(Connect.>->)

{-| Run a vendor in its action context

   The vendor must not make requests, so its upstream interface
   is @Const Void@. -}
run :: Monad action => Vendor (Const Void) down action -- ^ Vendor
    -> down product -- ^ Request
    -> action (Referral (Const Void) down action product)
run :: forall (action :: * -> *) (down :: * -> *) product.
Monad action =>
Vendor (Const Void) down action
-> down product
-> action (Referral (Const Void) down action product)
run = forall (action :: * -> *) (down :: * -> *) product.
Monad action =>
Vendor (Const Void) down action
-> down product
-> action (Referral (Const Void) down action product)
Vendor.run

{-| Evaluate a vendor with no context

    The vendor must evokes neither request nor actions, so both
    its upstream and action contexts are @Const Void@. -}
eval :: Vendor (Const Void) down (Const Void) -- ^ Vendor
    -> down product -- ^ Request
    -> Referral (Const Void) down (Const Void) product
eval :: forall (down :: * -> *) product.
Vendor (Const Void) down (Const Void)
-> down product -> Referral (Const Void) down (Const Void) product
eval = forall (down :: * -> *) product.
Vendor (Const Void) down (Const Void)
-> down product -> Referral (Const Void) down (Const Void) product
Vendor.eval

{-| Evaluate a vendor with no context

    The vendor must evokes neither request nor actions, so both
    its upstream and action contexts are @Const Void@. -}
eval' :: Vendor (Const Void) down (Const Void) -- ^ Vendor
    -> down product -- ^ Request
    -> product
eval' :: forall (down :: * -> *) product.
Vendor (Const Void) down (Const Void) -> down product -> product
eval' Vendor (Const Void) down (Const Void)
v down product
r = forall (up :: * -> *) (down :: * -> *) (action :: * -> *) product.
Referral up down action product -> product
Referral.product (forall (down :: * -> *) product.
Vendor (Const Void) down (Const Void)
-> down product -> Referral (Const Void) down (Const Void) product
Vendor.eval Vendor (Const Void) down (Const Void)
v down product
r)

-- | Vendor that never responds to any requests
absurd :: Vendor up (Const Void) action
absurd :: forall (up :: * -> *) (action :: * -> *).
Vendor up (Const Void) action
absurd = forall (up :: * -> *) (down :: * -> *) (action :: * -> *).
(forall product.
 down product -> Job up action (Referral up down action product))
-> Vendor up down action
Vendor (\case{})

-- | The identity for '(>->)'; does nothing at all
id :: Vendor i i action
id :: forall (i :: * -> *) (action :: * -> *). Vendor i i action
id = forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> Job up action x) -> Vendor up down action
loop' forall (up :: * -> *) product (action :: * -> *).
up product -> Job up action product
Job.order

{-| A simple stateless vendor that responds to each
    request by applying a pure function -}
function :: (forall response. down response -> response)
    -> Vendor up down action
function :: forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall response. down response -> response)
-> Vendor up down action
function forall response. down response -> response
f = forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> Job up action x) -> Vendor up down action
loop' (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response. down response -> response
f)

{-| A simple stateless vendor that responds to each
    request by applying an effectful function -}
action :: (forall response. down response -> action response)
    -> Vendor up down action
action :: forall (down :: * -> *) (action :: * -> *) (up :: * -> *).
(forall response. down response -> action response)
-> Vendor up down action
action forall response. down response -> action response
f = forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> Job up action x) -> Vendor up down action
loop' (forall (action :: * -> *) product (up :: * -> *).
action product -> Job up action product
Job.perform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response. down response -> action response
f)

{-| A vendor that applies a transformation to each request
    and then simply forwards it upstream. -}
map :: (forall x. down x -> up x) -> Vendor up down action
map :: forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> up x) -> Vendor up down action
map forall x. down x -> up x
f = forall (down :: * -> *) (up :: * -> *) (action :: * -> *).
(forall x. down x -> Job up action x) -> Vendor up down action
loop' (forall (up :: * -> *) product (action :: * -> *).
up product -> Job up action product
Job.order forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. down x -> up x
f)

alter :: (forall x. Effect up action x -> Job up' action' x)
    -- ^ Transformation applied to each effect that the vendor evokes
    -> Vendor up down action -> Vendor up' down action'
alter :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Job up' action' x)
-> Vendor up down action -> Vendor up' down action'
alter = forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Job up' action' x)
-> Vendor up down action -> Vendor up' down action'
Vendor.alter

alter' :: (forall x. Effect up action x -> Effect up' action' x)
    -- ^ Transformation applied to each effect that the vendor evokes
    -> Vendor up down action -> Vendor up' down action'
alter' :: forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Effect up' action' x)
-> Vendor up down action -> Vendor up' down action'
alter' forall x. Effect up action x -> Effect up' action' x
f = forall (up :: * -> *) (action :: * -> *) (up' :: * -> *)
       (action' :: * -> *) (down :: * -> *).
(forall x. Effect up action x -> Job up' action' x)
-> Vendor up down action -> Vendor up' down action'
Vendor.alter (forall (up :: * -> *) (action :: * -> *) product.
Effect up action product -> Job up action product
effect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Effect up action x -> Effect up' action' x
f)