yield (empty) → 0.0.0.0

raw patch · 13 files changed

+618/−0 lines, 13 filesdep +basedep +containersdep +hspec

Dependencies added: base, containers, hspec, markdown-unlit, mtl, transformers, yield

Files

CHANGELOG.md +5/−0
LICENSE +21/−0
README.lhs +42/−0
README.md +42/−0
library/Control/Monad/Trans/Codensity.hs +43/−0
library/Control/Monad/Trans/Yield.hs +122/−0
library/Control/Monad/Yield.hs +19/−0
library/Control/Monad/Yield/Aggregation.hs +36/−0
library/Control/Monad/Yield/Class.hs +9/−0
package.yaml +88/−0
tests/Spec.hs +1/−0
tests/YieldSpec.hs +66/−0
yield.cabal +124/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/yield/compare/v0.0.0.0...main)++## [v0.0.0.0](https://github.com/freckle/yield/tree/v0.0.0.0)++First tagged release.

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2024 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.lhs view

@@ -0,0 +1,42 @@+# Yield++<!--+```haskell+module Main (main) where++import Prelude+import Text.Markdown.Unlit ()+import Test.Hspec+```+-->++```haskell+import Control.Monad.Yield+```++```haskell+action1 :: MonadYield Char m => m Char+action1 = do+  yield 'a'+  yield 'b'+  pure 'c'+```++```haskell+action2 :: forall m. Monad m => m (String, Char)+action2 = runYieldT listAggregation action1+-- returns ("ab", 'c')+```++<!--+```haskell+main :: IO ()+main = hspec do+  it "" do+    action2 `shouldReturn` ("ab", 'c')+```+-->++---++[LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md)

+ README.md view

@@ -0,0 +1,42 @@+# Yield++<!--+```haskell+module Main (main) where++import Prelude+import Text.Markdown.Unlit ()+import Test.Hspec+```+-->++```haskell+import Control.Monad.Yield+```++```haskell+action1 :: MonadYield Char m => m Char+action1 = do+  yield 'a'+  yield 'b'+  pure 'c'+```++```haskell+action2 :: forall m. Monad m => m (String, Char)+action2 = runYieldT listAggregation action1+-- returns ("ab", 'c')+```++<!--+```haskell+main :: IO ()+main = hspec do+  it "" do+    action2 `shouldReturn` ("ab", 'c')+```+-->++---++[LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md)

+ library/Control/Monad/Trans/Codensity.hs view

@@ -0,0 +1,43 @@+{-# LANGUAGE UndecidableInstances #-}++module Control.Monad.Trans.Codensity+  ( CodensityT (..)+  ) where++import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (MonadReader (ask, local))+import Control.Monad.State (MonadState (state))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Yield.Class (MonadYield (..))+import Data.Kind (Type)+import Prelude (Applicative (..), Functor (..), Monad (..), const, ($), (.))++-- | The "codensity transform", taken as an excerpt from the @kan-extensions@+--   package, following the model of @conduit@ to permit efficient monadic bind+newtype CodensityT (m :: Type -> Type) (a :: Type) = CodensityT {runCodensity :: forall b. (a -> m b) -> m b}++instance Functor (CodensityT m) where+  fmap f (CodensityT m) = CodensityT (\k -> m (k . f))++instance Applicative (CodensityT m) where+  pure x = CodensityT (\k -> k x)+  CodensityT f <*> CodensityT g = CodensityT (\bfr -> f (\ab -> g (bfr . ab)))++instance Monad (CodensityT m) where+  m >>= k = CodensityT (\c -> runCodensity m (\a -> runCodensity (k a) c))++instance MonadTrans CodensityT where+  lift m = CodensityT (m >>=)++instance MonadIO m => MonadIO (CodensityT m) where+  liftIO = lift . liftIO++instance MonadYield a m => MonadYield a (CodensityT m) where+  yield = lift . yield++instance MonadReader r m => MonadReader r (CodensityT m) where+  ask = CodensityT (ask >>=)+  local f m = CodensityT $ \c -> ask >>= \r -> local f . runCodensity m $ local (const r) . c++instance MonadState s m => MonadState s (CodensityT m) where+  state = lift . state

+ library/Control/Monad/Trans/Yield.hs view

@@ -0,0 +1,122 @@+{-# LANGUAGE UndecidableInstances #-}++module Control.Monad.Trans.Yield+  ( YieldT+  , runYieldT+  , hoistYieldT+  ) where++import Prelude++import Control.Monad (ap, liftM)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (MonadReader (..))+import Control.Monad.State (MonadState (..))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Trans.Codensity (CodensityT (..))+import Control.Monad.Yield.Aggregation (Aggregation (..))+import Control.Monad.Yield.Class (MonadYield (..))++-- | Monad transformer that adds dynamically interpretable 'MonadYield' support+newtype YieldT a m r = YieldT (CodensityT (Yielder a m) r)+  deriving newtype (Functor, Applicative, Monad)++instance MonadTrans (YieldT a) where+  lift = YieldT . lift . lift++deriving newtype instance MonadIO m => MonadIO (YieldT a m)++deriving newtype instance Functor m => MonadYield a (YieldT a m)++deriving newtype instance MonadReader r m => MonadReader r (YieldT a m)++deriving newtype instance MonadState s m => MonadState s (YieldT a m)++-- | Transforms a 'YieldT''s base monad actions+hoistYieldT+  :: forall m n a r+   . Monad m+  => (forall x. m x -> n x)+  -> YieldT a m r+  -> YieldT a n r+hoistYieldT f (YieldT (CodensityT y0)) = YieldT $ CodensityT \continue ->+  let go = \case+        Pure r -> continue r+        Yield a y -> Yield a (go y)+        Act m -> Act (f $ liftM go $ collapse m)+         where+          collapse mpipe = do+            pipe' <- mpipe+            case pipe' of+              Act mpipe' -> collapse mpipe'+              _ -> pure pipe'+  in  go $ y0 Pure++-- | Runs a 'YieldT' computation in the base monad+runYieldT+  :: forall a b m r+   . Monad m+  => Aggregation m a b+  -- ^ What to do with the values emitted from the stream+  -> YieldT a m r+  -> m (b, r)+  -- ^ The result of aggregating of stream values, and the result of the 'YieldT'+runYieldT agg (YieldT (CodensityT y)) = runYielder agg (y Pure)++data Yielder a m r+  = Yield a (Yielder a m r)+  | Act (m (Yielder a m r))+  | Pure r+  deriving stock (Functor)++instance Functor m => Applicative (Yielder a m) where+  pure = Pure+  (<*>) = ap++instance Functor m => Monad (Yielder a m) where+  p0 >>= f = go p0+   where+    go p = case p of+      Yield a continue -> Yield a $ go continue+      Act m -> Act (go <$> m)+      Pure r -> f r++instance Functor m => MonadYield a (Yielder a m) where+  yield x = Yield x (Pure ())++instance MonadTrans (Yielder a) where+  lift = Act . fmap Pure++instance MonadIO m => MonadIO (Yielder a m) where+  liftIO = lift . liftIO++instance MonadReader r m => MonadReader r (Yielder a m) where+  ask = lift ask+  local f = hoistYielder $ local f++instance MonadState s m => MonadState s (Yielder a m) where+  state = lift . state++hoistYielder+  :: Functor n => (forall x. m x -> n x) -> Yielder a m r -> Yielder a n r+hoistYielder f p0 = go p0+ where+  go = \case+    Yield a p -> Yield a $ go p+    Act m -> Act $ go <$> f m+    Pure r -> Pure r++-- | Runs a 'Yielder' computation in the base monad+runYielder+  :: Monad m+  => Aggregation m a b+  -- ^ What to do with the values emitted from the stream+  -> Yielder a m r+  -> m (b, r)+  -- ^ The result of aggregating of stream values, and the result of the 'Yielder'+runYielder Aggregation {begin, step, done} p0 = begin >>= go p0+ where+  go p x = case p of+    Yield a continue -> (go continue $!) =<< step x a+    Act m -> m >>= \p' -> go p' x+    Pure r -> (,r) <$> done x

+ library/Control/Monad/Yield.hs view

@@ -0,0 +1,19 @@+module Control.Monad.Yield+  ( -- * Class+    MonadYield (..)++    -- * Monad transformer+  , YieldT+  , runYieldT+  , hoistYieldT++    -- * Aggregation+  , Aggregation (..)+  , noAggregation+  , seqAggregation+  , listAggregation+  ) where++import Control.Monad.Trans.Yield+import Control.Monad.Yield.Aggregation+import Control.Monad.Yield.Class

+ library/Control/Monad/Yield/Aggregation.hs view

@@ -0,0 +1,36 @@+module Control.Monad.Yield.Aggregation+  ( Aggregation (..)+  , noAggregation+  , seqAggregation+  , listAggregation+  ) where++import Data.Foldable (toList)+import Data.Sequence (Seq (..))+import Prelude (Applicative (..), Functor (..), (.), (<$>))++-- | An effectful stream consumer+--+-- The type parameter @x@ represents the consumer's internal state.+data Aggregation m a b = forall x.+  Aggregation+  { begin :: m x+  -- ^ Produce the initial state+  , step :: x -> a -> m x+  -- ^ Consume one item from the stream+  , done :: x -> m b+  -- ^ Produce the final result+  }++instance Functor m => Functor (Aggregation m a) where+  fmap f Aggregation {begin, step, done} =+    Aggregation {begin, step, done = fmap f . done}++noAggregation :: Applicative m => Aggregation m a ()+noAggregation = Aggregation {begin = pure (), step = \() _ -> pure (), done = pure}++seqAggregation :: Applicative m => Aggregation m a (Seq a)+seqAggregation = Aggregation {begin = pure Empty, step = \xs -> pure . (xs :|>), done = pure}++listAggregation :: Applicative m => Aggregation m a [a]+listAggregation = toList <$> seqAggregation

+ library/Control/Monad/Yield/Class.hs view

@@ -0,0 +1,9 @@+module Control.Monad.Yield.Class+  ( MonadYield (..)+  ) where++import Control.Monad (Monad)+import Data.Kind (Type)++class Monad m => MonadYield (a :: Type) (m :: Type -> Type) | m -> a where+  yield :: a -> m ()

+ package.yaml view

@@ -0,0 +1,88 @@+name: yield+version: 0.0.0.0+maintainer: Freckle Education+category: Streaming+github: freckle/yield+synopsis: YieldT monad transformer+description: |+  This package defines a class @MonadYield a@ for monads that can emit values+  values of type @a@ while they run, and a monad transformer @YieldT a@ which+  implements this class such that the emitted values can be captured in a+  streaming manner.++  This is an amalgamation of concepts from @pipes@, @conduit@, @foldl@, and+  @kan-extensions@, combined into a small self-contained package.++extra-doc-files:+  - README.md+  - CHANGELOG.md++extra-source-files:+  - package.yaml++language: GHC2021++ghc-options:+  - -Weverything+    -Wno-missing-kind-signatures+  - -Wno-all-missed-specialisations+  - -Wno-missed-specialisations+  - -Wno-missing-exported-signatures # re-enables missing-signatures+  - -Wno-missing-import-lists+  - -Wno-missing-local-signatures+  - -Wno-missing-safe-haskell-mode+  - -Wno-monomorphism-restriction+  - -Wno-prepositive-qualified-module+  - -Wno-safe+  - -Wno-unsafe++when:+  - condition: "impl(ghc >= 9.8)"+    ghc-options:+      - -Wno-missing-role-annotations+      - -Wno-missing-poly-kind-signatures++dependencies:+  - base < 5++default-extensions:+  - BlockArguments+  - DataKinds+  - DeriveAnyClass+  - DerivingVia+  - DerivingStrategies+  - FunctionalDependencies+  - GADTs+  - LambdaCase+  - NoImplicitPrelude+  - NoMonomorphismRestriction+  - OverloadedStrings+  - RecordWildCards+  - TypeFamilies++library:+  source-dirs: library+  other-modules:+    - Control.Monad.Trans.Codensity+  dependencies:+    - containers+    - mtl+    - transformers++tests:+  spec:+    main: Spec.hs+    source-dirs: tests+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+    dependencies:+      - hspec+      - yield+      - mtl++  readme:+    main: README.lhs+    ghc-options: -pgmL markdown-unlit+    dependencies:+      - hspec+      - markdown-unlit+      - yield

+ tests/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}

+ tests/YieldSpec.hs view

@@ -0,0 +1,66 @@+module YieldSpec (spec) where++import Prelude++import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Yield+import Data.Foldable+import Test.Hspec++spec :: Spec+spec = describe "YieldT" do+  describe "Trivial examples" do+    it "" $ runYieldT noAggregation (pure 'x') `shouldReturn` ((), 'x')+    it "" $ runYieldT listAggregation (pure 'x') `shouldReturn` ("", 'x')+    it "" $+      runYieldT listAggregation (yield 'a' >> pure 'x') `shouldReturn` ("a", 'x')+    it "" $+      runYieldT noAggregation (yield 'a' >> pure 'x') `shouldReturn` ((), 'x')+    it "" $+      runYieldT listAggregation (yield 'a' >> yield 'b' >> pure 'c')+        `shouldReturn` ("ab", 'c')++  describe "Monad instance" do+    it "" $+      runYieldT+        listAggregation+        (traverse_ @[] yield "ab" >> traverse @[] yield "cd" >> pure 'x')+        `shouldReturn` ("abcd", 'x')++  describe "MonadReader instance" do+    it "" $ runReaderT (runYieldT noAggregation ask) 'a' `shouldReturn` ((), 'a')+    it "" $+      runReaderT (runYieldT noAggregation (local succ ask)) 'a'+        `shouldReturn` ((), 'b')+    it "" $+      runReaderT+        ( runYieldT listAggregation do+            ask >>= yield+            local succ do+              ask >>= yield+              local succ do+                ask >>= yield+            ask >>= yield+        )+        'g'+        `shouldReturn` ("ghig", ())++  describe "MonadState instance" do+    it "" $ evalStateT (runYieldT noAggregation get) 'a' `shouldReturn` ((), 'a')+    it "" $+      evalStateT (runYieldT noAggregation (modify' succ >> get)) 'a'+        `shouldReturn` ((), 'b')+    it "" $+      evalStateT+        ( do+            (a, _) <- runYieldT listAggregation do+              get >>= yield+              modify' succ+              get >>= yield+              put 'x'+              get >>= yield+            gets (a,)+        )+        'g'+        `shouldReturn` ("ghx", 'x')

+ yield.cabal view

@@ -0,0 +1,124 @@+cabal-version:      1.18+name:               yield+version:            0.0.0.0+license:            MIT+license-file:       LICENSE+maintainer:         Freckle Education+homepage:           https://github.com/freckle/yield#readme+bug-reports:        https://github.com/freckle/yield/issues+synopsis:           YieldT monad transformer+description:+    This package defines a class @MonadYield a@ for monads that can emit values+    values of type @a@ while they run, and a monad transformer @YieldT a@ which+    implements this class such that the emitted values can be captured in a+    streaming manner.+    .+    This is an amalgamation of concepts from @pipes@, @conduit@, @foldl@, and+    @kan-extensions@, combined into a small self-contained package.++category:           Streaming+build-type:         Simple+extra-source-files: package.yaml+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/freckle/yield++library+    exposed-modules:+        Control.Monad.Trans.Yield+        Control.Monad.Yield+        Control.Monad.Yield.Aggregation+        Control.Monad.Yield.Class++    hs-source-dirs:     library+    other-modules:      Control.Monad.Trans.Codensity+    default-language:   GHC2021+    default-extensions:+        BlockArguments DataKinds DeriveAnyClass DerivingVia+        DerivingStrategies FunctionalDependencies GADTs LambdaCase+        NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings+        RecordWildCards TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-kind-signatures+        -Wno-all-missed-specialisations -Wno-missed-specialisations+        -Wno-missing-exported-signatures -Wno-missing-import-lists+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+        -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+        -Wno-safe -Wno-unsafe++    build-depends:+        base >=4.16.4.0 && <5,+        containers >=0.6.5.1,+        mtl >=2.2.2,+        transformers >=0.5.6.2++    if impl(ghc >=9.8)+        ghc-options:+            -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures++test-suite readme+    type:               exitcode-stdio-1.0+    main-is:            README.lhs+    other-modules:      Paths_yield+    default-language:   GHC2021+    default-extensions:+        BlockArguments DataKinds DeriveAnyClass DerivingVia+        DerivingStrategies FunctionalDependencies GADTs LambdaCase+        NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings+        RecordWildCards TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-kind-signatures+        -Wno-all-missed-specialisations -Wno-missed-specialisations+        -Wno-missing-exported-signatures -Wno-missing-import-lists+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+        -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+        -Wno-safe -Wno-unsafe -pgmL markdown-unlit++    build-depends:+        base >=4.16.4.0 && <5,+        hspec >=2.9.7,+        markdown-unlit >=0.5.1,+        yield++    if impl(ghc >=9.8)+        ghc-options:+            -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures++test-suite spec+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     tests+    other-modules:+        YieldSpec+        Paths_yield++    default-language:   GHC2021+    default-extensions:+        BlockArguments DataKinds DeriveAnyClass DerivingVia+        DerivingStrategies FunctionalDependencies GADTs LambdaCase+        NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings+        RecordWildCards TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-kind-signatures+        -Wno-all-missed-specialisations -Wno-missed-specialisations+        -Wno-missing-exported-signatures -Wno-missing-import-lists+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+        -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+        -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N++    build-depends:+        base >=4.16.4.0 && <5,+        hspec >=2.9.7,+        mtl >=2.2.2,+        yield++    if impl(ghc >=9.8)+        ghc-options:+            -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures