packages feed

supply-next (empty) → 0.0.0.0

raw patch · 21 files changed

+874/−0 lines, 21 filesdep +basedep +containersdep +gambler

Dependencies added: base, containers, gambler, hspec, integer-types, quaalude, supply-chain, supply-next, transformers

Files

+ changelog.md view
@@ -0,0 +1,3 @@+### 0.0.0.0 (2023-01-16)++Initial release
+ license.txt view
@@ -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.
+ readme.md view
@@ -0,0 +1,92 @@+## The interface++`Next` is a [supply-chain] interface for possibly-finite enumeration. It is+defined in `Next.Interface.Type` as follows:++```haskell+data Next item result =+    (result ~ Step item) => Next+```++```haskell+data Step item = Item item | End+```++It is envisioned some of the utilities in this package may usefully extend to+more complex supply-chain interfaces, in which "next" appears as one of many+operations in a larger interface. The utilities we provide are therefore+polymorphic where possible. The class that permits this polymorphism, defined+in `Next.Interface.Class`, is called `TerminableStream`.++```haskell+class TerminableStream item interface | interface -> item where+    next :: interface (Step item)+```+++## Type aliases++A *producer* is a vendor whose downward-facing interface is a stream; it+provides items. A *consumer* is a job whose upward-facing interface is a stream;+it consumes items. A *pipe* is a vendor whose up and down interfaces are both+streams, possibly of differing item types; it both consumes and provides items.++```haskell+type Producer action item         = Vendor (Const Void) (Next item)  action+type Pipe     action item1 item2  = Vendor (Next item1) (Next item2) action+type Consumer action item product = Job    (Next item) action product+```++The "plus" variants of these aliases are more general in their upstream+interfaces and have an additional parameter to describe exactly what the+upstream interface is.++```haskell+type ProducerPlus up action item         =                              Vendor up (Next item)  action+type PipePlus     up action item1 item2  = TerminableStream item1 up => Vendor up (Next item2) action+type ConsumerPlus up action item product = TerminableStream item  up => Job    up action product+```+++## The Stream type++`Stream` is a bonus feature, simply a newtype for `Producer`. This can help+abstract away from the `supply-chain` library to simplify compiler feedback,+and it may be easier to use if you do not need the full generality of the+`supply-chain` library.++```haskell+newtype Stream action item =+    Stream{ producer :: Producer action item }+```++`Stream` has some class instances, but otherwise this library offers no+utilities for working with `Stream`. Instead, work with the `Producer` type+and wrap/unwrap the `Stream` constructor as needed.+++## Other libraries++`supply-next` is one contribution to the [supply-chain] library ecosystem.++A consumer can be constructed from an `EffectfulFold`; this type is from the+[gambler] library, which contains a number of common ways to construct folds.++See also [foldl], whose `FoldM` type is the same as `EffectfulFold`, for more+ideas about what kinds of things you can express as folds.++The terms *producer*, *pipe*, and *consumer* are borrowed from [pipes]. The+`Stream` type is also inspired by the inclusion of the `ListT` bonus type in+pipes.++If you are only using `Stream` and do not need the general facilities of+[supply-chain] at all, the `ListT` type in [list-transformer] may be a more+appropriate choice. Consider also that a type as simple as `IO (Maybe item)`+can also suffice to represent an effectful stream.+++  [supply-chain]:     https://hackage.haskell.org/package/supply-chain+  [gambler]:          https://hackage.haskell.org/package/gambler+  [foldl]:            https://hackage.haskell.org/package/foldl+  [pipes]:            https://hackage.haskell.org/package/pipes+  [list-transformer]: https://hackage.haskell.org/package/list-transformer
+ supply-next.cabal view
@@ -0,0 +1,84 @@+cabal-version: 3.0++name: supply-next+version: 0.0.0.0+category: Streaming+synopsis: Supply-chain interface for basic streaming+description:+    @Next@ is a supply-chain interface for possibly-finite+    enumeration. The @TerminableStream@ generalizes @Next@+    so that more complex interfaces that incorporate+    enumeration can use some of these utilities. We offer+    type aliases @Producer@, @Pipe@, and @Consumer@ to+    conveniently describe vendors and jobs that involve a+    @Next@ interface.++license: Apache-2.0+license-file: license.txt++author: Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage: https://github.com/typeclasses/supply-next+bug-reports: https://github.com/typeclasses/supply-next/issues++extra-source-files: *.md++source-repository head+    type: git+    location: git://github.com/typeclasses/supply-next.git++common base+    default-language: GHC2021+    ghc-options: -Wall+    default-extensions:+        ApplicativeDo+        BlockArguments+        DerivingStrategies+        FunctionalDependencies+        LambdaCase+        NoImplicitPrelude+        TypeFamilies+    build-depends:+      , base ^>= 4.16 || ^>= 4.17+      , gambler ^>= 0.0+      , integer-types ^>= 0.0+      , quaalude ^>= 0.0+      , supply-chain ^>= 0.0+      , transformers ^>= 0.5.6++library+    import: base+    hs-source-dirs: supply-next+    exposed-modules:+        Next++        Next.Interface+        Next.Interface.Type+        Next.Interface.Class++        Next.Producer+        Next.Producer.Type+        Next.Producer.Examples+        Next.Producer.State++        Next.Pipe+        Next.Pipe.Examples+        Next.Pipe.Type++        Next.Consumer+        Next.Consumer.Type+        Next.Consumer.Examples++        Next.Stream+        Next.Stream.Type++test-suite test-supply-next+    import: base+    type: exitcode-stdio-1.0+    hs-source-dirs: test-supply-next+    main-is: Main.hs+    build-depends:+      , containers ^>= 0.6.5+      , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10+      , supply-next
+ supply-next/Next.hs view
@@ -0,0 +1,39 @@+module Next+  (+    {- * Next -} {- $next -} Next (..), Step (..),+            TerminableStream (..), next,+    {- * Producer -} {- $producer -} Producer, ProducerPlus,+            empty, singleton, effect, each, append,+            null, head, pop, push,+            unfoldPure, unfoldEffect, unfoldJob,+    {- * Pipe -} {- $pipe -} Pipe, PipePlus,+            cons, map, concat, takeWhile, dropWhile, group,+            intersperse, beforeEach, concatMapJob, concatMapProducer,+    {- * Consumer -} {- $consumer -} Consumer, ConsumerPlus,+          foldPure, foldEffect, foldJob, toList, run,+    {- * Stream -} {- $stream -} Stream (Stream),+  )+  where++import Next.Interface (Step(..), Next(..), TerminableStream (..), next)+import Next.Consumer (Consumer, ConsumerPlus, foldPure, foldEffect, foldJob, toList, run)+import Next.Producer (Producer, ProducerPlus, empty, singleton, effect, each, append, unfoldPure, unfoldEffect, unfoldJob, null, head, pop, push)+import Next.Pipe (Pipe, PipePlus,+    map, concatMapJob, concat, takeWhile, dropWhile,+    group, cons, intersperse, beforeEach, concatMapProducer)+import Next.Stream (Stream (Stream))++{- $next+See "Next.Interface" -}++{- $producer+See "Next.Producer" -}++{- $pipe+See "Next.Pipe" -}++{- $consumer+See "Next.Consumer" -}++{- $stream+See "Next.Stream" -}
+ supply-next/Next/Consumer.hs view
@@ -0,0 +1,15 @@+module Next.Consumer+  (+    {- * Types -} {- $types -} Consumer, ConsumerPlus,+    {- * Examples -} {- $examples -} foldPure, foldEffect, foldJob, toList, run,+  )+  where++import Next.Consumer.Type+import Next.Consumer.Examples++{- $types+See "Next.Consumer.Type" -}++{- $examples+See "Next.Consumer.Examples" -}
+ supply-next/Next/Consumer/Examples.hs view
@@ -0,0 +1,60 @@+module Next.Consumer.Examples+  (+     {- * Trivialities -} toList, run,+     {- * General folding -} foldPure, foldEffect, foldJob,+  )+  where++import Essentials+import Fold.Effectful.Type++import Fold (Fold)+import Next.Consumer.Type (ConsumerPlus)+import Next.Interface (Step (Item, End), next)+import SupplyChain (Job)++import qualified SupplyChain.Job as Job+import qualified Fold.Effectful+import qualified Fold.Pure++{-| Run the stream completely, collecting results using a+    fold that operates in the 'Job' context++See "Fold.Effectful" -}+foldJob :: forall item product action up.+    EffectfulFold (Job up action) item product+    -> ConsumerPlus up action item product+foldJob EffectfulFold{ initial, step, extract } =+    initial >>= go >>= extract+  where+    go b = Job.order next >>= \case+        End -> pure b+        Item a -> step b a >>= go++{-| Run the stream completely, collecting results using an+    effectful fold++See "Fold.Effectful" -}+foldEffect :: Monad action =>+    EffectfulFold action item product+    -> ConsumerPlus up action item product+foldEffect f = foldJob (Fold.Effectful.hoist Job.perform f)++{-| Run the stream completely, collecting results using a+    pure fold++See "Fold.Pure" -}+foldPure :: Monad action =>+    Fold item product+    -> ConsumerPlus up action item product+foldPure f = foldJob (Fold.Effectful.fold f)++{-| Consumes all items and returns them as a list -}+toList :: forall up action item. Monad action =>+    ConsumerPlus up action item [item]+toList = foldPure Fold.Pure.list++{-| Like 'toList', but discards the results -}+run :: forall up action item. Monad action =>+    ConsumerPlus up action item ()+run = foldPure (pure ())
+ supply-next/Next/Consumer/Type.hs view
@@ -0,0 +1,21 @@+module Next.Consumer.Type+  (+    {- * Type aliases -} Consumer, ConsumerPlus,+  )+  where++import Next.Interface (Next, TerminableStream)+import SupplyChain (Job)++{-| A 'Job' whose upstream interface is 'Next' -}+type Consumer action item product =+    Job (Next item) action product++{-| Like 'Consumer', but with a more general upstream interface+    which can be anything in the 'TerminableStream' class++This type is like 'Consumer' except that it has an extra type parameter+representing the upstream interface, hence its name is "consumer /plus/". -}+type ConsumerPlus up action item product =+    TerminableStream item up =>+        Job up action product
+ supply-next/Next/Interface.hs view
@@ -0,0 +1,15 @@+module Next.Interface+  (+    {- * Types -} {- $types -} Next (..), Step (..),+    {- * Class -} {- $class -} TerminableStream (..), next,+  )+  where++import Next.Interface.Type+import Next.Interface.Class++{- $types+See "Next.Interface.Type" -}++{- $class+See "Next.Interface.Class" -}
+ supply-next/Next/Interface/Class.hs view
@@ -0,0 +1,21 @@+module Next.Interface.Class+  (+    {- * Class -} TerminableStream (..),+    {- * Utilities -} next,+  )+  where++import Next.Interface.Type++{-| An interface for which 'Next' is one of possibly many supported requests -}+class TerminableStream item interface | interface -> item where++    {-| Lift a 'Next' request into a larger interface -}+    liftNext :: Next item result -> interface result++instance TerminableStream item (Next item) where+    liftNext x = x++{-| Like v'Next', but polymorphic -}+next :: TerminableStream item interface => interface (Step item)+next = liftNext Next
+ supply-next/Next/Interface/Type.hs view
@@ -0,0 +1,22 @@+module Next.Interface.Type+  (+    {- * Type aliases -} Next (..), Step (..),+  )+  where++import Essentials++{-| A basic dynamic interface for a possibly-finite stream++Once 'End' is returned from a v'Next' request, it is expected that the stream+will thenceforth return 'End' and perform no side effects in response to any+subsequent 'Next' requests. -}+data Next item result =+    (result ~ Step item) => Next+        -- ^ Request the next item from the stream++{-| The result obtained from a v'Next' request -}+data Step item =+    Item item -- ^ An item obtained from the stream+  | End -- ^ Indicates that the stream has ended and there are no more items+    deriving stock (Functor, Foldable, Traversable, Eq, Ord, Show)
+ supply-next/Next/Pipe.hs view
@@ -0,0 +1,18 @@+module Next.Pipe+  (+    {- * Types -} {- $types -} Pipe, PipePlus,+    {- * Examples -} {- $examples -} cons, map, concat,+        takeWhile, dropWhile, group,+        intersperse, beforeEach, id,+        concatMapJob, concatMapProducer,+  )+  where++import Next.Pipe.Type+import Next.Pipe.Examples++{- $types+See "Next.Pipe.Type" -}++{- $examples+See "Next.Pipe.Examples" -}
+ supply-next/Next/Pipe/Examples.hs view
@@ -0,0 +1,161 @@+module Next.Pipe.Examples+  (+    {- * Triviality -} id,+    {- * Predicates -} takeWhile, dropWhile,+    {- * Insertion -} cons, intersperse, beforeEach,+    {- * Mapping -} map,+    {- * Concatenation -} concat,+    {- * Concat + map -} concatMapJob, concatMapProducer,+    {- * Grouping -} group,+  )+  where++import Essentials hiding (id)++import Next.Interface (Next (..), Step (..), TerminableStream (..), next)+import Next.Pipe.Type (Pipe, PipePlus)+import Next.Producer.Examples (append, empty)+import Next.Producer.Type (Producer, ProducerPlus)+import Integer (Positive)+import Prelude ((+))+import SupplyChain (Job, Vendor (..), Referral (..))++import qualified SupplyChain.Alter as Alter+import qualified SupplyChain.Job as Job+import qualified SupplyChain.Vendor as Vendor++{-| Apply a function to each item in the stream -}+map :: forall item1 item2 action up.+    (item1 -> Job up action item2)+        -- ^ For each input item, this job produces an output item+    -> PipePlus up action item1 item2+map f = go+  where+    go = Vendor \Next -> Job.order next >>= \case+        End -> pure $ Referral End empty+        Item a -> f a <&> \b -> Referral (Item b) go++{-| Applies the function to each result obtained from upstream,+    and yields each result from the list to the downstream -}+concatMapJob :: forall item1 item2 action up.+    (item1 -> Job up action [item2])+        -- ^ For each input item, this job produces any number of output items+    -> PipePlus up action item1 item2+concatMapJob f = Vendor \Next -> go []+  where+    go :: TerminableStream item1 up => [item2] -> Job up action+        (Referral up (Next item2) action (Step item2))+    go = \case+        b : bs -> pure $ Referral (Item b) $ Vendor \Next -> go bs+        [] -> Job.order next >>= \case+            End -> pure $ Referral End empty+            Item a -> f a >>= go++{-| Flattens a stream of lists -}+concat :: forall item action up. PipePlus up action [item] item+concat = concatMapJob pure++{-| Yields the longest prefix matching the predicate and discards the rest -}+takeWhile :: forall item action up.+    (item -> Job up action Bool)+        -- ^ True if this is the sort of thing we'd like to keep+    -> PipePlus up action item item+takeWhile ok = go+  where+    go = Vendor \r@Next -> Job.order (liftNext r) >>= \case+        Item x -> ok x <&> \case+            True -> Referral (Item x) go+            False -> Referral End empty+        _ -> pure $ Referral End empty++{-| Discards the longest prefix matching the predicate and yields the rest -}+dropWhile :: forall item action up.+    (item -> Job up action Bool)+        -- ^ True if this is the sort of thing we'd like to get rid of+    -> PipePlus up action item item+dropWhile bad = Vendor \r@Next ->+    let+        go :: Job up action (Referral up (Next item) action (Step item))+        go = Job.order (liftNext r) >>= \case+          Item x -> bad x >>= \case+              True -> go+              False -> pure $ Referral (Item x) id+          _ -> pure $ Referral End empty+    in+        go++{- | Does nothing at all -}+id :: forall up item action. PipePlus up action item item+id = Vendor.map liftNext++{-| Removes consecutive duplicate items, and yields each item along+    with the size of the repetition++For example, @\"Hrmm..."@ groups into+@[(1, \'H'), (1, \'r'), (2, \'m'), (3, \'.')]@ -}+group :: forall up item action. Eq item => PipePlus up action item (Positive, item)+group =+    Vendor \Next -> Job.order next >>= \case+        End -> pure $ Referral End empty+        Item x -> start x++  where+    start :: TerminableStream item up => item+        -> Job up action (Referral up (Next (Positive, item)) action (Step (Positive, item)))+    start = go 1++    go :: TerminableStream item up => Positive -> item+        -> Job up action (Referral up (Next (Positive, item)) action (Step (Positive, item)))+    go n x = Job.order next >>= \case+        End -> pure $ Referral (Item (n, x)) empty+        Item y ->+          if y == x+          then go (n + 1) x+          else pure $ Referral (Item (n, x)) $ Vendor \Next -> start y++{-| Add one item to the beginning of a stream -}+cons :: forall item action up.+    Job up action item+        -- ^ This job produces an item to add to the front of the list+    -> PipePlus up action item item+cons head = Vendor \Next -> head <&> \x -> Referral (Item x) id++{-| Add an item between each pair of items of a stream++The length of the stream is modified as @\\case{ 0 -> 0; n -> (2 * n) - 1 }@. -}+intersperse :: forall item action up.+    Job up action item+        -- ^ This job generates items that will be inserted in between+        --   the items of the original list+    -> PipePlus up action item item+intersperse i = Vendor \r@Next -> Job.order (liftNext r) <&> \case+    End -> Referral End empty+    Item x -> Referral (Item x) (beforeEach i)++{-| Add an item before each item in a stream++The length of the stream is doubled. -}+beforeEach :: forall item action up.+    Job up action item+        -- ^ This job generates items that will be inserted before each+        --   of the items of the original list+    -> PipePlus up action item item+beforeEach i = Vendor \r@Next -> Job.order (liftNext r) >>= \case+    End -> pure $ Referral End empty+    Item x -> i <&> \i' -> Referral (Item i') $ Vendor \Next ->+        pure $ Referral (Item x) (beforeEach i)++-- | Like 'concatMapJob', but the function gives a 'Producer' instead of a 'Job'+concatMapProducer :: forall item1 item2 action.+    (item1 -> Producer action item2)+        -- ^ For each item from the input list, this vendor generates+        --   any number of actions to yield in the resulting list+    -> Pipe action item1 item2+concatMapProducer f = go+  where+    go = Vendor \Next -> Job.order next >>= \case+        End -> pure $ Referral End empty+        Item x -> handle (append v go) Next+          where+            v = (f x :: ProducerPlus (Const Void) action item2)+                & Alter.vendor' (Alter.request' $ \z -> case z of {})
+ supply-next/Next/Pipe/Type.hs view
@@ -0,0 +1,21 @@+module Next.Pipe.Type+  (+    {- * Type aliases -} Pipe, PipePlus,+  )+  where++import Next.Interface (Next, TerminableStream)+import SupplyChain (Vendor (..))++{-| A 'Vendor' whose upstream and downstream interfaces are both 'Next' -}+type Pipe action item1 item2 =+    Vendor (Next item1) (Next item2) action++{-| Like 'Pipe', but with a more general upstream interface+    which can be anything in the 'TerminableStream' class++This type is like 'Pipe' except that it has an extra type parameter+representing the upstream interface, hence its name is "pipe /plus/". -}+type PipePlus up action item1 item2 =+    TerminableStream item1 up =>+        Vendor up (Next item2) action
+ supply-next/Next/Producer.hs view
@@ -0,0 +1,23 @@+module Next.Producer+  (+    {- * Types -} {- $types -} Producer, ProducerPlus,+    {- * Examples -} {- $examples -}+            empty, singleton, effect, each, append,+            unfoldPure, unfoldEffect, unfoldJob,+    {- * State actions -} {- $state -}+            null, head, pop, push,+  )+  where++import Next.Producer.Type+import Next.Producer.Examples+import Next.Producer.State++{- $types+See "Next.Producer.Type" -}++{- $examples+See "Next.Producer.Examples" -}++{- $state+See "Next.Producer.State" -}
+ supply-next/Next/Producer/Examples.hs view
@@ -0,0 +1,65 @@+module Next.Producer.Examples+  (+    {- * Trivialities -} empty, singleton, effect, each,+    {- * Append -} append,+    {- * Unfold -} unfoldJob, unfoldEffect, unfoldPure,+  )+  where++import Essentials+import Next.Interface+import Next.Producer.Type++import SupplyChain (Job, Vendor (..), Referral (..))++import qualified Data.Foldable as Foldable+import qualified Data.List as List+import qualified SupplyChain.Job as Job++{-| The empty stream -}+empty :: forall up item action. ProducerPlus up action item+empty = go+  where+    go :: Vendor up (Next item) action+    go = Vendor \Next -> pure $ Referral End go++{-| Yields one item, then stops -}+singleton :: forall up item action.+    Job up action item -> ProducerPlus up action item+singleton x = Vendor \Next -> x <&> \y -> Referral (Item y) empty++{-| A single item obtained by performing an effect -}+effect :: forall up action item. action item -> ProducerPlus up action item+effect x = singleton $ Job.perform x++{-| Yields all the items from the given list -}+each :: forall up foldable item action. Foldable foldable =>+    foldable item -> ProducerPlus up action item+each = Foldable.toList >>> unfoldPure (List.uncons >>> maybe End Item)++{-| Yields all the items of the first stream, followed by all the items of the second -}+append :: forall up item action. ProducerPlus up action item+    -> ProducerPlus up action item -> ProducerPlus up action item+append a b = Vendor \r@Next -> handle a r >>= \case+    Referral End _ -> handle b r+    Referral (Item x) a' -> pure $ Referral (Item x) (append a' b)++unfoldJob :: forall state up item action.+    (state -> Job up action (Step (item, state)))+    -> state -> ProducerPlus up action item+unfoldJob f = go+  where+    go :: state -> Vendor up (Next item) action+    go s = Vendor \r@Next -> f s >>= \case+        End -> handle empty r+        Item (x, s') -> pure $ Referral (Item x) (go s')++unfoldEffect :: forall state up item action.+    (state -> action (Step (item, state)))+    -> state -> ProducerPlus up action item+unfoldEffect f = unfoldJob (Job.perform . f)++unfoldPure :: forall state up item action.+    (state -> Step (item, state))+    -> state -> ProducerPlus up action item+unfoldPure f = unfoldJob (pure . f)
+ supply-next/Next/Producer/State.hs view
@@ -0,0 +1,38 @@+module Next.Producer.State+  (+    {- * State actions -} null, head, push, pop,+  )+  where++import Essentials+import Next.Interface+import Next.Producer.Type++import Control.Monad.Trans.State.Strict (StateT (StateT))+import SupplyChain ((>->), Referral (Referral))++import qualified Control.Monad.Trans.State.Strict as State+import qualified Data.Foldable as Foldable+import qualified Next.Pipe as Pipe+import qualified SupplyChain.Vendor as Vendor++{-| Test whether the state is an empty stream -}+null :: forall action item. Monad action =>+    StateT (Producer action item) action Bool+null = head <&> Foldable.null++{-| Peek at the first item in the stream state -}+head :: forall action item. Monad action =>+    StateT (Producer action item) action (Step item)+head = pop >>= \x -> traverse_ push x $> x++{-| Add an item to the front of the stream state -}+push :: forall up action item. Monad action =>+    item -> StateT (ProducerPlus up action item) action ()+push x = State.modify' (>-> Pipe.cons (pure x))++{- | Take the first item from the stream -}+pop :: forall action item. Monad action =>+    StateT (Producer action item) action (Step item)+pop = StateT \xs ->+    Vendor.run xs next <&> \(Referral s v) -> (s, v)
+ supply-next/Next/Producer/Type.hs view
@@ -0,0 +1,21 @@+module Next.Producer.Type+  (+    {- * Type aliases -} Producer, ProducerPlus,+  )+  where++import Essentials+import Next.Interface.Type+import SupplyChain.Vendor++{-| A 'Vendor' whose upstream interface is nothing and whose+    downstream interface is 'Next' -}+type Producer action item =+    Vendor (Const Void) (Next item) action++{-| A 'Vendor' whose downstream interface is 'Next'++This type is like 'Producer' except that it has an extra type parameter+representing the upstream interface, hence its name is "producer /plus/". -}+type ProducerPlus up action item =+    Vendor up (Next item) action
+ supply-next/Next/Stream.hs view
@@ -0,0 +1,10 @@+module Next.Stream+  (+    {- * Type -} {- $type -} Stream (..),+  )+  where++import Next.Stream.Type++{- $type+See "Next.Stream.Type" -}
+ supply-next/Next/Stream/Type.hs view
@@ -0,0 +1,34 @@+module Next.Stream.Type+  (+    {- * Type -} Stream (..),+  )+  where++import Essentials+import Next.Producer.Type++import Control.Monad (ap)+import SupplyChain ((>->))++import qualified Next.Pipe as Pipe+import qualified Next.Producer as Producer++newtype Stream action item =+    Stream{ producer :: Producer action item }++instance Semigroup (Stream action item) where+    a <> b = Stream $ Producer.append (producer a) (producer b)++instance Monoid (Stream action item) where+    mempty = Stream Producer.empty++instance Functor (Stream action) where+    fmap f (Stream xs) = Stream $ xs >-> Pipe.map (\x -> pure (f x))++instance Applicative (Stream action) where+    pure x = Stream $ Producer.singleton (pure x)+    (<*>) = ap++instance Monad (Stream action) where+    (Stream xs) >>= f = Stream $+        xs >-> Pipe.concatMapProducer (\x -> producer (f x))
+ test-supply-next/Main.hs view
@@ -0,0 +1,98 @@+module Main (main) where++import Essentials++import Control.Monad (replicateM)+import Control.Monad.Trans.Writer.CPS (execWriter, tell, runWriter, Writer)+import Data.Function (on)+import Data.Monoid (Sum (..))+import Data.Sequence (Seq)+import Data.String (String)+import Next (each, ProducerPlus)+import Next.Stream (Stream (Stream))+import Prelude (Integer, Int, IO, (+), show)+import SupplyChain ((>->), (>-), Job)+import Test.Hspec (hspec, describe, it, shouldBe)++import qualified Data.Char as Char+import qualified Data.Sequence as Seq+import qualified Fold.Effectful as Fold+import qualified Next+import qualified Next.Stream as Stream+import qualified SupplyChain.Job as Job+import qualified Data.List as List++main :: IO ()+main = hspec $ describe "Next" do++    describe "Pipe" do++        let write :: Next.ConsumerPlus up (Writer (Seq item)) item ()+            write = Next.foldEffect (Fold.effect (Seq.singleton >>> tell))++        it "group" do+            let input = "Hrmm..."; grouped = [(1, 'H'), (1, 'r'), (2, 'm'), (3, '.')]+                job = each input >-> Next.group >- write+            execWriter (Job.run job) `shouldBe` Seq.fromList grouped++        it "takeWhile" do+            let input = "PORKchOp"; capitalPrefix = "PORK"+                job = each input >-> Next.takeWhile (pure . Char.isUpper) >- write+            execWriter (Job.run job) `shouldBe` Seq.fromList capitalPrefix++        describe "intersperse" do+            let xs, ys :: [Integer]; xs = [1, 2, 3]; ys = [1, 0, 2, 0, 3]++            it "intersperses items" do+                let job = each xs >-> Next.intersperse separator >- Next.toList+                    separator = pure 0+                runIdentity (Job.run job) `shouldBe` ys++            it "also intersperses effects" do+                let job = each xs >-> Next.intersperse separator >- Next.toList+                    separator = 0 <$ Job.perform (tell (Sum (1 :: Integer)))+                runWriter (Job.run job) `shouldBe` (ys, Sum 2)++    describe "Consumer" do++        let write :: Int -> Job up (Writer String) ()+            write x = Job.perform $ tell $ show x++            input = [2, 3, 4] :: [Int]++            producer :: ProducerPlus up (Writer String) Int+            producer = each input >-> Next.map \x -> write x $> x++        it "combines values and effects from the list" do+            let f = Fold.sum; job = producer >- Next.foldEffect f+            runWriter (Job.run job) `shouldBe` (List.sum input, "234")++        it "also incorporates effects from the fold" do+            let f = Fold.sum <* Fold.effect (\n -> replicateM n $ tell "-")+                job = producer >- Next.foldEffect f+            runWriter (Job.run job) `shouldBe` (List.sum input, "2--3---4----")++    describe "Stream" do++        let write :: forall a. a -> Stream (Writer (Seq a)) ()+            write = Stream . Next.effect . tell . Seq.singleton++        it "is a monad" do+            let a, b :: [Integer]; a = [10, 20, 30]; b = [1, 2, 3]+                stream = ((+) <$> Stream (each a) <*> Stream (each b)) >>= write+                job = Stream.producer stream >- Next.run+            execWriter (Job.run job) `shouldBe`+                Seq.fromList [11, 12, 13, 21, 22, 23, 31, 32, 33]++        describe "(<>)" do+            let a, b :: [Integer]; a = [10, 20, 30]; b = [1, 2, 3]+            it "pure" do+                let (===) = shouldBe `on` \s -> do+                        let job = Stream.producer s >- Next.toList+                        runIdentity $ Job.run job+                (Stream (each a) <> Stream (each b)) === Stream (each (a <> b))+            it "effectful" do+                let stream = (Stream (each a) <> Stream (each b)) >>= write+                    job = Stream.producer stream >- Next.run+                shouldBe @(Seq Integer) (execWriter $ Job.run job)+                    (Seq.fromList (a <> b))