supply-chain (empty) → 0.0.0.0

raw patch · 12 files changed

+660/−0 lines, 12 filesdep +basedep +supply-chain-core

Dependencies added: base, supply-chain-core

Files

• changelog.md +3/−0
• license.txt +13/−0
• readme.md +243/−0
• supply-chain.cabal +52/−0
• supply-chain/SupplyChain.hs +18/−0
• supply-chain/SupplyChain/Alter.hs +58/−0
• supply-chain/SupplyChain/Effect.hs +35/−0
• supply-chain/SupplyChain/Job.hs +59/−0
• supply-chain/SupplyChain/JobAndVendor.hs +46/−0
• supply-chain/SupplyChain/Referral.hs +26/−0
• supply-chain/SupplyChain/Unit.hs +10/−0
• supply-chain/SupplyChain/Vendor.hs +97/−0

@@ -0,0 +1,3 @@+# 0.0.0.0 (2022-11-08)++* Initial release

@@ -0,0 +1,13 @@+Copyright 2022 Mission Valley Software LLC++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,243 @@+A *supply chain* represents a flow of information from one `Vendor` to the next,+and so on, ultimately reaching a `Job` that returns a product.++```haskell+run (vendor1 >-> vendor2 >-> vendor3 >- job)+```++A job or vendor can place an `order`, which is fulfilled by the vendor+*upstream* of it. In the above example:++* `vendor2` is downstream of `vendor1`; the orders made by `vendor2` are served+  by `vendor1`.+* The orders made by the `job` are served by `vendor3`.+* The orders made by `vendor3` are served by `vendor2`.+* `vendor1` does not make any requests (its upstream interface is `Const Void`).+++## Interfaces++An *interface* is a type constructor (kind `Type -> Type`) that describes the+requests and responses exchanged between a vendor and a job.++If a job's upstream interface is `i`, then when the job makes a request of type+`i x`, it receives a response of type `x`.++Values of a type of this kind represent requests. Each constructor will+typically have a constraint that specifies what type of response is expected in+return. Types of this kind are therefore often GADTs. Types of this kind are+also often not functors.++The lack of any interface at all can be expressed as `Const Void`.+++## Actions++An *action* is a monadic context such as `IO`.++The lack of any actions at all can be expressed as `Const Void`. (If you are+used to dealing with monad transformers, you might be familiar with using+`Identity` as a trivial context, but such a layer is not needed here.)+++## Jobs++`Job up action product` is a monadic context that supports:++  - Making requests on the `up` interface+  - Performing side effects in the `action` context+  - Returning a single `product` value++```+            ▲   │+      up a  │   │  a+            │   ▼+┌─────────────────────────┐+│  Job up action product  │+└─────────────────────────┘+              │+              │  product+              ▼+```+++## Writing jobs++`Job` belongs to the `Monad` class, and there are two functions for making+requests and performing actions respectively:++```haskell+order :: up product -> Job up action product+```++```haskell+perform :: action product -> Job up action product+```++A job may also be altered by connecting it to a vendor; see *Vendor-to-job+connection* below.+++## Vendors++`Vendor up down action` can:++  - Respond to requests received via the `down` interface+  - Make requests on the `up` interface+  - Perform side effects in the `action` context++```+              ▲   │+        up a  │   │  a+              │   ▼+┌───────────────────────────┐+│   Vendor up down action   │+└───────────────────────────┘+              ▲   │+      down b  │   │  b+              │   ▼+```++The most common way to use vendors is to connect them to jobs using `(>->)` and+`(>-)`.+++## Vendor-to-vendor connection++If `i` is the downstream interface of vendor `v1` and the upstream interface of+vendor `v2`, then we can form the composition `v1 >-> v2`.++```haskell+(>->) :: Vendor up i action+      -> Vendor i down action+      -> Vendor up down action+```++```+             ▲   │+       up a  │   │  a+             │   ▼              ─┐+┌────────────────────────┐       │+│   Vendor up i action   │  v1   │+└────────────────────────┘       │+             ▲   │               │+        i b  │   │  b            │  v1 >-> v2+             │   ▼               │+┌────────────────────────┐       │+│  Vendor i down action  │  v2   │+└────────────────────────┘       │+             ▲   │              ─┘+     down c  │   │  c+             │   ▼+```++When the downstream vendor makes a request of type `i b`, the upstream vendor+replies with a response of type `b`.++`(>->)` and `id` form a category.++```haskell+id :: Vendor i i action  -- from "SupplyChain.Vendor"+```++The `(>->)` operator is associative, and `id` is its identity.++- `(a >-> b) >-> c` = `a >-> (b >-> c)`+- `a >-> id` = `a`+- `a` = `id >-> a`+++## Vendor-to-job connection++If `i` is the downstream interface of vendor `v` and the upstream interface of+job `j`, then we can form the composition `v >- j`.++```haskell+(>-) :: Vendor up i action+     -> Job i action product+     -> Job up action product+```++```+             ▲   │+       up a  │   │  a+             │   ▼              ─┐+┌────────────────────────┐       │+│   Vendor up i action   │  v    │+└────────────────────────┘       │+             ▲   │               │+        i b  │   │  b            │  v >- j+             │   ▼               │+┌────────────────────────┐       │+│  Job i action product  │  j    │+└────────────────────────┘       │+              │                 ─┘+              │  product+              ▼+```++When the job makes a request of type `i b`, the vendor replies with a response+of type `b`.++`(>->)` and `(>-)` together are associative.++- `(a >-> b) >- c` = `a >-> (b >- c)`+++## Writing vendors++We define vendors using the `Vendor` constructor. Please inspect its type+carefully:++```haskell+forall product. down product -> Job up action (Referral up down action product)+```++A vendor is a function that accepts a request. The request type is polymorphic+but constrained by the vendor's downstream interface.++```haskell+forall product. down product -> Job up action (Referral up down action product)+                ^^^^^^^^^^^^+```++A vendor has an upstream interface and can do everything a job can, therefore+the request handler operates in a `Job` context.++```haskell+forall product. down product -> Job up action (Referral up down action product)+                                ^^^^^^^^^^^^^+```++This allows the vendor to undertake a monadic sequence involving `order` and+`perform` while fulfilling the request.++The final step in fulfilling a request is to return a `Referral`.++```haskell+forall product. down product -> Job up action (Referral up down action product)+                                               ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+```++A `Referral` is written using its `Referral` constructor, which has two parameters:++```haskell+Referral :: product -> Vendor up down action -> Referral up down action product+```++The first is the vendor's response to the client's request.++```haskell+Referral :: product -> Vendor up down action -> Referral up down action product+            ^^^^^^^+```++The second is a new `Vendor`.++```haskell+Referral :: product -> Vendor up down action -> Referral up down action product+                       ^^^^^^^^^^^^^^^^^^^^^+```++This latter component is what allows vendors to be stateful, and it is usually+defined recursively.

@@ -0,0 +1,52 @@+cabal-version: 3.0++name: supply-chain+version: 0.0.0.0++category: Monads, Streaming+synopsis: Composable request-response pipelines++description:+    @Job@ is a free monad, plus a little extra. It is parameterized on+    two type constructors: one for dynamic effects, and one for static+    effects. The @Vendor@ type is similar to job, but a vendor can also+    /respond to/ requests, and thus it has two dynamic interfaces: one+    upstream and one downstream. We can connect vendors to jobs or to+    other vendors, creating a pipeline (or "supply chain", if you like)+    along the dynamic interfaces.++author: Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage: https://github.com/typeclasses/supply-chain+bug-reports: https://github.com/typeclasses/supply-chain/issues++license: Apache-2.0+license-file: license.txt++extra-doc-files: readme.md changelog.md++common base+    default-language: GHC2021+    ghc-options: -Wall++    default-extensions:+        LambdaCase+        NoImplicitPrelude++    build-depends:+        base ^>= 4.16 || ^>= 4.17+      , supply-chain-core ^>= 0.0++library+    import: base+    hs-source-dirs: supply-chain+    exposed-modules:+        SupplyChain+        SupplyChain.Alter+        SupplyChain.Effect+        SupplyChain.Job+        SupplyChain.JobAndVendor+        SupplyChain.Referral+        SupplyChain.Unit+        SupplyChain.Vendor

@@ -0,0 +1,18 @@+module SupplyChain+  (++    {- * Job type -} Job,+    {- * Making jobs -} order, perform,+    {- * Running jobs -} run, eval,+    {- * Vendor type -} Vendor (Vendor, handle), Referral (Referral),+    {- * Vendor connection -} (>->),+    {- * Vendor-job connection -} (>-), (>+),+    {- * Vendor/job conversion -} once, loop, loop', Unit (Unit),+  )+  where++import SupplyChain.Job (Job, order, perform, run, eval)+import SupplyChain.JobAndVendor (loop, loop', once, (>-), (>+))+import SupplyChain.Referral (Referral (Referral))+import SupplyChain.Unit (Unit (Unit))+import SupplyChain.Vendor (Vendor (Vendor, handle), (>->))

@@ -0,0 +1,58 @@+-- | Description: functions for modifying requests and actions++module SupplyChain.Alter+  (+    {- * General -} job, vendor, request, perform,+    {- * Simplified -} job', vendor', request', perform',+  )+  where++import SupplyChain.Core.Effect (Effect)+import SupplyChain.Core.Job (Job)+import SupplyChain.Core.Vendor (Vendor (..))++import qualified SupplyChain.Core.Effect as Effect+import qualified SupplyChain.Core.Job as Job+import qualified SupplyChain.Core.Vendor as Vendor++import Data.Function ((.))++job :: (forall x. Effect up action x -> Job up' action' x)+    -- ^ Transformation applied to each effect that the job evokes+    -> Job up action product -> Job up' action' product+job = Job.alter++job' :: (forall x. Effect up action x -> Effect up' action' x)+    -- ^ Transformation applied to each effect that the job evokes+    -> Job up action product -> Job up' action' product+job' f = Job.alter (Job.effect . f)++vendor :: (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'+vendor = Vendor.alter++vendor' :: (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'+vendor' f = Vendor.alter (Job.effect . f)++request :: (up product -> Effect up' action product)+    -- ^ Transformation applied if the effect is a request+    -> Effect up action product -> Effect up' action product+request = Effect.alterRequest++request' :: (up product -> up' product)+    -- ^ Transformation applied if the effect is a request+    -> Effect up action product -> Effect up' action product+request' f = Effect.alterRequest (Effect.Request . f)++perform :: (action product -> Effect up action' product)+    -- ^ Transformation applied if the effect is an action+    -> Effect up action product -> Effect up action' product+perform = Effect.alterPerform++perform' :: (action product -> action' product)+    -- ^ Transformation applied if the effect is an action+    -> Effect up action product -> Effect up action' product+perform' f = Effect.alterPerform (Effect.Perform . f)

@@ -0,0 +1,35 @@+-- | Description: an /effect/ is either /request/ or /perform/++module SupplyChain.Effect+  (+    {- * Type -} Effect (Request, Perform),+    {- * General alteration -} alterRequest, alterPerform,+    {- * Simplified alteration -} alterRequest', alterPerform',+  )+  where++import SupplyChain.Core.Effect (Effect (Request, Perform))++import qualified SupplyChain.Core.Effect as Effect++import Data.Function ((.))++alterRequest :: (up product -> Effect up' action product)+    -- ^ Transformation applied if the effect is a request+    -> Effect up action product -> Effect up' action product+alterRequest = Effect.alterRequest++alterRequest' :: (up product -> up' product)+    -- ^ Transformation applied if the effect is a request+    -> Effect up action product -> Effect up' action product+alterRequest' f = Effect.alterRequest (Effect.Request . f)++alterPerform :: (action product -> Effect up action' product)+    -- ^ Transformation applied if the effect is an action+    -> Effect up action product -> Effect up action' product+alterPerform = Effect.alterPerform++alterPerform' :: (action product -> action' product)+    -- ^ Transformation applied if the effect is an action+    -> Effect up action product -> Effect up action' product+alterPerform' f = Effect.alterPerform (Effect.Perform . f)

@@ -0,0 +1,59 @@+-- | Description: a /job/ makes requests, performs actions, and returns++module SupplyChain.Job+  (+    {- * Type -} Job,+    {- * Construction -} perform, order, effect,+    {- * Running -} run, eval,+    {- * Alteration -} alter, alter',+  )+  where++import SupplyChain.Core.Effect (Effect)+import SupplyChain.Core.Job (Job)++import qualified SupplyChain.Core.Job as Job++import Control.Monad (Monad)+import Data.Function ((.))+import Data.Functor.Const (Const)+import Data.Void (Void)++alter :: (forall x. Effect up action x -> Job up' action' x)+    -- ^ Transformation applied to each effect that the job evokes+    -> Job up action product -> Job up' action' product+alter f = Job.alter f++alter' :: (forall x. Effect up action x -> Effect up' action' x)+    -- ^ Transformation applied to each effect that the job evokes+    -> Job up action product -> Job up' action' product+alter' f = Job.alter (effect . f)++perform :: action product -- ^ Action+    -> Job up action product -- ^ Job+perform = Job.perform++order :: up product -- ^ Request+    -> Job up action product -- ^ Job+order = Job.order++effect :: Effect up action product -- ^ Effect+    -> Job up action product -- ^ Job+effect = Job.effect++{-| Run a job in its action context++   The job must not make requests, so its upstream interface+   is @Const Void@. -}+run :: Monad action =>+    Job (Const Void) action product -- ^ Job+    -> action product -- ^ Action+run = Job.run++{-| Evaluate a job with no context++    The job must evokes neither request nor actions, so both+    its upstream and action contexts are @Const Void@. -}+eval :: Job (Const Void) (Const Void) product -- ^ Job+    -> product -- ^ Result+eval = Job.eval

@@ -0,0 +1,46 @@+-- | Description: /job/ + /vendor/++module SupplyChain.JobAndVendor+  (+    {- * Connection -} (>-), (>+),+    {- * Conversion -} 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 ((<&>))++{-| Modify a job with a vendor that interprets its requests -}+(>-) :: Vendor up down action -- ^ Upstream+     -> Job down action product -- ^ Downstream+     -> Job up action product+(>-) = (Core.>-)++{-| Connect a vendor to a job, producing a job which returns both the product+    and a new version of the vendor.++    Use this function instead of '(>-)' if you need to attach a succession+    of jobs to one stateful vendor. -}+(>+) :: Vendor up down action -- ^ Upstream+     -> Job down action product -- ^ Downstream+     -> Job up action (Referral up down action product)+(>+) = (Core.>+)++loop :: Job up action product -- ^ Job+    -> Vendor up (Unit product) action -- ^ Vendor+loop = Core.loop++once :: Vendor up (Unit product) action -- ^ Vendor+    -> Job up action product -- ^ Job+once = Core.once++loop' :: (forall x. down x -> Job up action x) -- ^ Stateless handler+    -> Vendor up down action -- ^ Vendor+loop' f = go where go = Vendor{ handle = \x -> f x <&> (`Referral` go) }

@@ -0,0 +1,26 @@+-- | Description: a /referral/ consists of a product and a new vendor++module SupplyChain.Referral+  (+    {- * Type -} Referral (Referral, product, next),+    {- * Alteration -} alter, alter',+  )+  where++import SupplyChain.Core.Effect (Effect)+import SupplyChain.Core.Job (Job, effect)+import SupplyChain.Core.Referral (Referral (Referral, product, next))++import qualified SupplyChain.Core.Referral as Referral++import Data.Function ((.))++alter :: (forall x. Effect up action x -> Job up' action' x)+    -- ^ Transformation applied to each effect that the 'next' vendor evokes+    -> Referral up down action product -> Referral up' down action' product+alter = Referral.alter++alter' :: (forall x. Effect up action x -> Effect up' action' x)+    -- ^ Transformation applied to each effect that the 'next' vendor evokes+    -> Referral up down action product -> Referral up' down action' product+alter' f = Referral.alter (effect . f)

@@ -0,0 +1,10 @@+-- | Description: /unit/ is a simple interface with one request and a fixed+--                response type++module SupplyChain.Unit+  (+    {- * Type -} Unit (Unit),+  )+  where++import SupplyChain.Core.Unit (Unit (Unit))

@@ -0,0 +1,97 @@+-- | Description: 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+(>->) = (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 = 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 = 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' v r = Referral.product (Vendor.eval v r)++-- | Vendor that never responds to any requests+absurd :: Vendor up (Const Void) action+absurd = Vendor (\case{})++-- | The identity for '(>->)'; does nothing at all+id :: Vendor i i action+id = loop' 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 f = loop' (pure . 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 f = loop' (Job.perform . 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 f = loop' (Job.order . 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 = 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' f = Vendor.alter (effect . f)