capability 0.2.0.0 → 0.3.0.0

raw patch · 33 files changed

+1205/−518 lines, 33 filesdep +constraintsdep ~generic-lensdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: constraints

Dependency ranges changed: generic-lens, primitive

API changes (from Hackage documentation)

Files

• ChangeLog.md +21/−0
• LICENSE +0/−30
• LICENSE.md +30/−0
• README.md +2/−11
• capability.cabal +35/−7
• examples/Error.hs +5/−4
• examples/Reader.hs +40/−16
• examples/Sink.hs +93/−0
• examples/State.hs +23/−10
• examples/Stream.hs +0/−92
• examples/Test.hs +2/−2
• examples/WordCount.hs +11/−11
• examples/Writer.hs +12/−11
• src/Capability.hs +46/−1
• src/Capability/Constraints.hs +38/−0
• src/Capability/Derive.hs +54/−0
• src/Capability/Error.hs +25/−9
• src/Capability/Reader.hs +13/−1
• src/Capability/Reader/Internal/Class.hs +18/−17
• src/Capability/Reader/Internal/Strategies.hs +2/−52
• src/Capability/Sink.hs +43/−0
• src/Capability/Sink/Internal/Class.hs +43/−0
• src/Capability/Sink/Internal/Strategies.hs +174/−0
• src/Capability/Source.hs +53/−0
• src/Capability/Source/Internal/Class.hs +66/−0
• src/Capability/Source/Internal/Strategies.hs +163/−0
• src/Capability/State.hs +13/−1
• src/Capability/State/Internal/Class.hs +32/−26
• src/Capability/State/Internal/Strategies.hs +3/−82
• src/Capability/State/Internal/Strategies/Common.hs +70/−0
• src/Capability/Stream.hs +19/−126
• src/Capability/TypeOf.hs +36/−0
• src/Capability/Writer.hs +20/−9

@@ -1,5 +1,26 @@ # Revision history for capability +## 0.3.0.0 -- 2020-03-19++* Rename HasStream to HasSink, for symmetry.+  See [#75](https://github.com/tweag/capability/pull/75)++* Introduce HasSource, a superclass of HasReader.+  See [#75](https://github.com/tweag/capability/pull/75)++* Make HasSource and HasSink superclasses of HasState.+  See [#75](https://github.com/tweag/capability/pull/75)++* Introduce `derive` to run an action that requires additional capabilities.+  See [#74](https://github.com/tweag/capability/pull/74)+  and [#83](https://github.com/tweag/capability/pull/83)++* Handlers `zoom` and `magnify` can now carry capabilities over from the context.+  See [#73](https://github.com/tweag/capability/pull/73)++* Introduce functional capabilities and the `TypeOf` type family.+  See [#72](https://github.com/tweag/capability/pull/72)+ ## 0.2.0.0 -- 2019-03-22  * Make HasStream a superclass of HasWriter.

@@ -1,30 +0,0 @@-Copyright (c) 2018 EURL Tweag--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Andreas Herrmann nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,30 @@+Copyright (c) 2018 EURL Tweag++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andreas Herrmann nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,5 +1,7 @@ # capability: effects, extensionally +[![Build status](https://badge.buildkite.com/a44574059e13fc443caa437226af5ae5e67b6a5ae012534712.svg?branch=master)](https://buildkite.com/tweag-1/capability)+ A capability is a type class that says explicitly which effects a function is allowed to use. The [`mtl`][mtl] works like this too. But unlike the `mtl`, this library decouples effects from their@@ -135,17 +137,6 @@ [`nix/haskell/default.nix`](nix/haskell/default.nix). A development environment with all patched dependencies in scope is defined in [`shell.nix`](shell.nix).--### Cachix Nix Cache--A Nix cache for this package's dependencies is provided via [cachix][cachix].-If you have [cachix][cachix] installed, then you can activate it by executing--```-$ cachix use tweag-```--[cachix]: https://cachix.org/  ### Build 

@@ -1,8 +1,8 @@ name: capability-version: 0.2.0.0+version: 0.3.0.0 homepage: https://github.com/tweag/capability license: BSD3-license-file: LICENSE+license-file: LICENSE.md maintainer: andreas.herrmann@tweag.io copyright: 2018 EURL Tweag category: Control@@ -29,37 +29,59 @@     This package allows JUnit formatted test reporting for CI.   default: False +flag dev+  description: Turn on development settings.+  manual: True+  default: False+ library   exposed-modules:     Capability     Capability.Accessors+    Capability.Constraints+    Capability.Derive     Capability.Error     Capability.Reader     Capability.Reader.Internal.Class     Capability.Reader.Internal.Strategies+    Capability.Sink+    Capability.Sink.Internal.Class+    Capability.Sink.Internal.Strategies+    Capability.Source+    Capability.Source.Internal.Class+    Capability.Source.Internal.Strategies     Capability.State     Capability.State.Internal.Class     Capability.State.Internal.Strategies+    Capability.State.Internal.Strategies.Common     Capability.Stream+    Capability.TypeOf     Capability.Writer     Capability.Writer.Discouraged   build-depends:       base >= 4.12 && < 5.0+    , constraints >= 0.1 && < 0.12     , dlist >= 0.8 && < 0.9     , exceptions >= 0.6 && < 0.11-    , generic-lens >= 1.0 && < 1.2+    , generic-lens >= 1.0 && < 1.3     , lens >= 4.16 && < 5.0     , monad-control >= 1.0 && < 1.1     , monad-unlift >= 0.2 && < 0.3     , mtl >= 2.0 && < 3.0     , mutable-containers >= 0.3 && < 0.4-    , primitive >= 0.6 && < 0.7+    , primitive >= 0.6 && < 0.8     , safe-exceptions >= 0.1 && < 0.2     , streaming >= 0.2 && < 0.3     , transformers >= 0.5.5 && < 0.6     , unliftio >= 0.2 && < 0.3     , unliftio-core >= 0.1 && < 0.2-  ghc-options: -Wall+  if flag(dev)+    ghc-options: -Wall -Werror -Wcompat+                 -Wincomplete-record-updates+                 -Wincomplete-uni-patterns+                 -Wnoncanonical-monad-instances+  else+    ghc-options: -Wall   hs-source-dirs: src   default-language: Haskell2010 @@ -70,8 +92,8 @@     CountLog     Error     Reader+    Sink     State-    Stream     Test.Common     Writer   main-is: Test.hs@@ -89,6 +111,12 @@     , unliftio >= 0.2 && < 0.3   if flag(hspec-jenkins)     build-depends: hspec-jenkins-  ghc-options: -Wall+  if flag(dev)+    ghc-options: -Wall -Werror -Wcompat+                 -Wincomplete-record-updates+                 -Wincomplete-uni-patterns+                 -Wnoncanonical-monad-instances+  else+    ghc-options: -Wall   hs-source-dirs: examples   default-language: Haskell2010

@@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}@@ -80,10 +81,10 @@         do           -- Errors in the parser or math component are converted to a           -- @CalcError@ by wrapping with the corresponding constructor.-          let wrapParserError = wrapError @"calc" @"parser"-                @(Rename "ParserError" :.: Ctor "ParserError" "calc")-              wrapMathError = wrapError @"calc" @"math"-                @(Rename "MathError" :.: Ctor "MathError" "calc")+          let wrapParserError = wrapError @"parser"+                @(Rename "ParserError" :.: Ctor "ParserError" "calc") @'[]+              wrapMathError = wrapError @"math"+                @(Rename "MathError" :.: Ctor "MathError" "calc") @'[]           num <- wrapParserError $ parseNumber input           root <- wrapMathError $ sqrtNumber num           liftIO $ putStrLn $ "sqrt = " ++ show root

@@ -1,48 +1,65 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-}  -- | Example uses and instances of the @HasReader@ capability. module Reader where  import Capability.Reader+import Capability.Source import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (ReaderT (..)) import GHC.Generics (Generic) import Test.Common import Test.Hspec +data Foo+data Bar +type instance TypeOf * Foo = Int+type instance TypeOf * Bar = Int+ ---------------------------------------------------------------------- -- Example Programs  -- | Returns the triple of the number in context "foo".-tripleFoo :: HasReader "foo" Int m => m Int+tripleFoo :: HasReader' Foo m => m Int tripleFoo = do-  single <- ask @"foo"-  double <- asks @"foo" (*2)+  single <- ask @Foo+  double <- asks @Foo (*2)   pure $ single + double  -- | Prints the triple and sixfold of the number in context "foo".-fooExample :: (HasReader "foo" Int m, MonadIO m) => m ()+fooExample :: (HasReader' Foo m, MonadIO m) => m () fooExample = do   liftIO . print =<< tripleFoo-  liftIO . print =<< local @"foo" (*2) tripleFoo+  liftIO . print =<< local @Foo (*2) tripleFoo   -- | Prints the double of "bar" and the triple of "foo". fooBarExample-  :: (HasReader "foo" Int m, HasReader "bar" Int m, MonadIO m) => m ()+  :: (HasReader' Foo m, HasReader' Bar m, MonadIO m) => m () fooBarExample = do-  local @"bar" (*2) $ do-    liftIO . print =<< ask @"bar"+  local @Bar (*2) $ do+    liftIO . print =<< ask @Bar     liftIO . print =<< tripleFoo +-- | Shows the interaction between 'local' and 'magnify'.+fooBarMagnify+  :: (HasReader "foobar" FooBar m, MonadIO m) => m ()+fooBarMagnify = do+  magnify+    @"foo"+    @(Field "foo" "foobar")+    @('[HasReader "foobar" FooBar, MonadIO]) $ do+      FooBar a b <- local @"foo" (const 5) (ask @"foobar")+      c <- local @"foobar" (const $ FooBar 3 4) (ask @"foo")+      liftIO $ print ((a, b), c)  ---------------------------------------------------------------------- -- Instances@@ -50,7 +67,8 @@ -- | @HasReader@ instance derived via @MonadReader@. newtype FooReaderT m (a :: *) = FooReaderT (ReaderT Int m a)   deriving (Functor, Applicative, Monad, MonadIO)-  deriving (HasReader "foo" Int) via MonadReader (ReaderT Int m)+  deriving (HasSource Foo Int) via MonadReader (ReaderT Int m)+  deriving (HasReader Foo Int) via MonadReader (ReaderT Int m)  runFooReaderT :: FooReaderT m a -> m a runFooReaderT (FooReaderT m) = runReaderT m 1@@ -64,10 +82,12 @@ -- | Multiple @HasReader@ instances derived via record fields in @MonadReader@. newtype FooBarReader a = FooBarReader (ReaderT FooBar IO a)   deriving (Functor, Applicative, Monad, MonadIO)-  deriving (HasReader "foo" Int) via-    Field "foo" () (MonadReader (ReaderT FooBar IO))-  deriving (HasReader "bar" Int) via-    Field "bar" () (MonadReader (ReaderT FooBar IO))+  deriving (HasSource "foobar" FooBar, HasReader "foobar" FooBar) via+    (MonadReader (ReaderT FooBar IO))+  deriving (HasSource Foo Int, HasReader Foo Int) via+    Rename "foo" (Field "foo" () (MonadReader (ReaderT FooBar IO)))+  deriving (HasSource Bar Int, HasReader Bar Int) via+    Rename "bar" (Field "bar" () (MonadReader (ReaderT FooBar IO)))  runFooBarReader :: FooBarReader a -> IO a runFooBarReader (FooBarReader m) = runReaderT m FooBar { foo = 1, bar = 2 }@@ -80,8 +100,10 @@ -- in unexpected ways. newtype BadFooBarReader a = BadFooBarReader (ReaderT Int IO a)   deriving (Functor, Applicative, Monad, MonadIO)-  deriving (HasReader "foo" Int) via MonadReader (ReaderT Int IO)-  deriving (HasReader "bar" Int) via MonadReader (ReaderT Int IO)+  deriving (HasSource Foo Int, HasReader Foo Int)+    via MonadReader (ReaderT Int IO)+  deriving (HasSource Bar Int, HasReader Bar Int)+    via MonadReader (ReaderT Int IO)  runBadFooBarReader :: BadFooBarReader a -> IO a runBadFooBarReader (BadFooBarReader m) = runReaderT m 1@@ -100,6 +122,8 @@       runFooBarReader fooExample `shouldPrint` "3\n6\n"     it "evaluates fooBarExample" $       runFooBarReader fooBarExample `shouldPrint` "4\n3\n"+    it "evaluates fooBarMagnify" $+      runFooBarReader fooBarMagnify `shouldPrint` "((5,2),3)\n"   describe "BadFooBarReader" $ do     it "evaluates fooExample" $       runBadFooBarReader fooExample `shouldPrint` "3\n6\n"

@@ -0,0 +1,93 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++-- | Example uses and instances of the @HasSink@ capability.+module Sink where++import Capability.State+import Capability.Source+import Capability.Sink+import Control.Monad.State.Strict (State, StateT (..), evalStateT, runState)+import qualified Data.Set as Set+import Streaming (Stream, Of)+import qualified Streaming.Prelude as S+import Test.Common+import Test.Hspec++----------------------------------------------------------------------+-- Example Programs++iota :: HasSink "nums" Int m => Int -> m ()+iota n+  | n < 0 = error "negative number passed to iota."+  | otherwise = go 0+  where+    go i+      | i == n = pure ()+      | otherwise = yield @"nums" i >> go (succ i)++labelledNodes+  :: (HasState "counter" Int m, HasSink "out" (Int, a) m, Foldable t)+  => t a -> m ()+labelledNodes = mapM_ $ \a -> do+  n <- state @"counter" $ \n -> (n, succ n)+  yield @"out" (n, a)+++----------------------------------------------------------------------+-- Instances++-- | @HasSink a@ derived from @HasState [a]@. Will produce reversed list.+newtype StreamAccM a = StreamAccM (State [Int] a)+  deriving (Functor, Applicative, Monad)+  deriving (HasSink "nums" Int) via+    SinkStack (MonadState (State [Int]))++runStreamAccM :: StreamAccM a -> (a, [Int])+runStreamAccM (StreamAccM m) = runState m []+++-- | @'Streaming.Stream' ('Streaming.Of' a)@ has a @HasSink a@ instance.+printStreamOfInt :: Stream (Of Int) IO () -> IO ()+printStreamOfInt = S.stdoutLn . S.map show+++-- | Composed @StateT@ and @Stream@ to provide @HasState@ and @HasSink@.+newtype StateOverStream a =+  StateOverStream (StateT Int (Stream (Of (Int, Char)) IO) a)+  deriving (Functor, Applicative, Monad)+  deriving (HasSource "counter" Int, HasSink "counter" Int, HasState "counter" Int) via+    MonadState (StateT Int (Stream (Of (Int, Char)) IO))+  deriving (HasSink "out" (Int, Char)) via+    Lift (StateT Int (Stream (Of (Int, Char)) IO))++printStateOverStream :: StateOverStream () -> IO ()+printStateOverStream (StateOverStream m) = do+  S.stdoutLn . S.map show $ evalStateT m 0++printLabelledNodes :: IO ()+printLabelledNodes =+  printStateOverStream $ labelledNodes $+    Set.fromList "Hello world!"+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "StreamAccM" $+    it "evaluates iota" $+      runStreamAccM (iota 10) `shouldBe` ((), [9, 8 .. 0])+  describe "Stream (Of Int)" $+    it "evaluates iota" $+      printStreamOfInt (iota 3) `shouldPrint` "0\n1\n2\n"+  describe "StateOverStream" $ do+    it "evaluates labelledNodes" $+      printLabelledNodes `shouldPrint`+        "(0,' ')\n(1,'!')\n(2,'H')\n(3,'d')\n(4,'e')\+        \\n(5,'l')\n(6,'o')\n(7,'r')\n(8,'w')\n"

@@ -1,7 +1,9 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}@@ -12,6 +14,8 @@ module State where  import Capability.Reader+import Capability.Sink+import Capability.Source import Capability.State import Control.Monad.Reader (ReaderT (..)) import Control.Monad.State.Strict (State, StateT (..), runState)@@ -25,6 +29,9 @@ incFoo :: HasState "foo" Int m => m () incFoo = modify @"foo" (+1) +incFoobar :: HasState "foobar" (Int,Int) m => m ()+incFoobar = modify @"foobar" $ \(x,y) -> (x+1, y+1)+ twoStates :: (HasState "foo" Int m, HasState "bar" Int m) => m () twoStates = do   incFoo@@ -34,9 +41,13 @@ useZoom :: HasState "foobar" (Int, Int) m => m Int useZoom = do   put @"foobar" (2, 2)-  -- Zoom in on the first element in the current state, rename tag 1 to "foo".-  zoom @"foobar" @"foo" @(Rename 1 :.: Pos 1 "foobar") $-    incFoo+  -- Zoom in on the first element in the current state, renaming tag 1 to "foo",+  -- while retaining the original 'HasState "foobar" (Int, Int)' capability.+  zoom+    @"foo" @(Rename 1 :.: Pos 1 "foobar")+    @('[HasState "foobar" (Int,Int)]) $ do+      incFoo+      incFoobar   gets @"foobar" (\(foo, bar) -> foo + bar)  @@ -54,10 +65,10 @@ -- fields of the @HasReader@ context. newtype TwoStatesM a = TwoStatesM (ReaderT TwoStates IO a)   deriving (Functor, Applicative, Monad)-  deriving (HasState "foo" Int) via+  deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via     ReaderIORef (Rename "tsFoo" (Field "tsFoo" ()     (MonadReader (ReaderT TwoStates IO))))-  deriving (HasState "bar" Int) via+  deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via     ReaderIORef (Rename "tsBar" (Field "tsBar" ()     (MonadReader (ReaderT TwoStates IO)))) @@ -78,9 +89,9 @@ -- @MonadState@. newtype PairStateM a = PairStateM (State (Int, Int) a)   deriving (Functor, Applicative, Monad)-  deriving (HasState "foo" Int) via+  deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via     Rename 1 (Pos 1 () (MonadState (State (Int, Int))))-  deriving (HasState "bar" Int) via+  deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via     Rename 2 (Pos 2 () (MonadState (State (Int, Int))))  runPairStateM :: PairStateM a -> (a, (Int, Int))@@ -94,8 +105,10 @@ -- this pattern can be useful to transation existing code to this library. newtype NestedStatesM a = NestedStatesM (StateT Int (State Int) a)   deriving (Functor, Applicative, Monad)-  deriving (HasState "foo" Int) via MonadState (StateT Int (State Int))-  deriving (HasState "bar" Int) via Lift (StateT Int (MonadState (State Int)))+  deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via+    MonadState (StateT Int (State Int))+  deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via+    Lift (StateT Int (MonadState (State Int)))  runNestedStatesM :: NestedStatesM a -> ((a, Int), Int) runNestedStatesM (NestedStatesM m) = runState (runStateT m 0) 0@@ -123,4 +136,4 @@       runNestedStatesM twoStates `shouldBe` (((), 1), -1)   describe "runFooBarState" $     it "evaluates useZoom" $-      runFooBarState useZoom (0, 0) `shouldBe` (5, (3, 2))+      runFooBarState useZoom (0, 0) `shouldBe` (7, (4, 3))

@@ -1,92 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeInType #-}---- | Example uses and instances of the @HasStream@ capability.-module Stream where--import Capability.State-import Capability.Stream-import Control.Monad.State.Strict (State, StateT (..), evalStateT, runState)-import qualified Data.Set as Set-import Streaming (Stream, Of)-import qualified Streaming.Prelude as S-import Test.Common-import Test.Hspec--------------------------------------------------------------------------- Example Programs--iota :: HasStream "nums" Int m => Int -> m ()-iota n-  | n < 0 = error "negative number passed to iota."-  | otherwise = go 0-  where-    go i-      | i == n = pure ()-      | otherwise = yield @"nums" i >> go (succ i)--labelledNodes-  :: (HasState "counter" Int m, HasStream "out" (Int, a) m, Foldable t)-  => t a -> m ()-labelledNodes = mapM_ $ \a -> do-  n <- state @"counter" $ \n -> (n, succ n)-  yield @"out" (n, a)---------------------------------------------------------------------------- Instances---- | @HasStream a@ derived from @HasState [a]@. Will produce reversed list.-newtype StreamAccM a = StreamAccM (State [Int] a)-  deriving (Functor, Applicative, Monad)-  deriving (HasStream "nums" Int) via-    StreamStack (MonadState (State [Int]))--runStreamAccM :: StreamAccM a -> (a, [Int])-runStreamAccM (StreamAccM m) = runState m []----- | @'Streaming.Stream' ('Streaming.Of' a)@ has a @HasStream a@ instance.-printStreamOfInt :: Stream (Of Int) IO () -> IO ()-printStreamOfInt = S.stdoutLn . S.map show----- | Composed @StateT@ and @Stream@ to provide @HasState@ and @HasStream@.-newtype StateOverStream a =-  StateOverStream (StateT Int (Stream (Of (Int, Char)) IO) a)-  deriving (Functor, Applicative, Monad)-  deriving (HasState "counter" Int) via-    MonadState (StateT Int (Stream (Of (Int, Char)) IO))-  deriving (HasStream "out" (Int, Char)) via-    Lift (StateT Int (Stream (Of (Int, Char)) IO))--printStateOverStream :: StateOverStream () -> IO ()-printStateOverStream (StateOverStream m) = do-  S.stdoutLn . S.map show $ evalStateT m 0--printLabelledNodes :: IO ()-printLabelledNodes =-  printStateOverStream $ labelledNodes $-    Set.fromList "Hello world!"---------------------------------------------------------------------------- Test Cases--spec :: Spec-spec = do-  describe "StreamAccM" $-    it "evaluates iota" $-      runStreamAccM (iota 10) `shouldBe` ((), [9, 8 .. 0])-  describe "Stream (Of Int)" $-    it "evaluates iota" $-      printStreamOfInt (iota 3) `shouldPrint` "0\n1\n2\n"-  describe "StateOverStream" $ do-    it "evaluates labelledNodes" $-      printLabelledNodes `shouldPrint`-        "(0,' ')\n(1,'!')\n(2,'H')\n(3,'d')\n(4,'e')\-        \\n(5,'l')\n(6,'o')\n(7,'r')\n(8,'w')\n"

@@ -15,7 +15,7 @@ import qualified Error import qualified Reader import qualified State-import qualified Stream+import qualified Sink import qualified Writer import qualified WordCount @@ -26,7 +26,7 @@   describe "Error" Error.spec   describe "Reader" Reader.spec   describe "State" State.spec-  describe "Stream" Stream.spec+  describe "Sink" Sink.spec   describe "Writer" Writer.spec   describe "WordCount" WordCount.spec 

@@ -14,7 +14,7 @@  import Capability.Reader import Capability.State-import Capability.Stream+import Capability.Sink import Control.Lens (ifor_) import Data.Coerce (coerce) import Data.Map.Strict (Map)@@ -56,21 +56,21 @@  -- | Count the occurrence of a single letter. countLetter ::-  HasStream "letterCount" (Occurrences Char) m+  HasSink "letterCount" (Occurrences Char) m   => Char -> m () countLetter letter = yield @"letterCount" (oneOccurrence letter)  -- | Count the occurrence of a single word. countWord ::-  HasStream "wordCount" (Occurrences Text) m+  HasSink "wordCount" (Occurrences Text) m   => Text -> m () countWord word = yield @"wordCount" (oneOccurrence word)   -- | Count the occurrence of a single word and all the letters in it. countWordAndLetters ::-  ( HasStream "letterCount" (Occurrences Char) m-  , HasStream "wordCount" (Occurrences Text) m )+  ( HasSink "letterCount" (Occurrences Char) m+  , HasSink "wordCount" (Occurrences Text) m )   => Text -> m () countWordAndLetters word = do   countWord word@@ -80,8 +80,8 @@ -- | Count the occurrences of words and letters in a text, -- excluding white space. countWordsAndLettersInText ::-  ( HasStream "letterCount" (Occurrences Char) m-  , HasStream "wordCount" (Occurrences Text) m )+  ( HasSink "letterCount" (Occurrences Char) m+  , HasSink "wordCount" (Occurrences Text) m )   => Text -> m () countWordsAndLettersInText text =   mapM_ countWordAndLetters (Text.words text)@@ -98,14 +98,14 @@ -- | Counter application monad. newtype Counter a = Counter { runCounter :: CounterCtx -> IO a }   deriving (Functor, Applicative, Monad) via (ReaderT CounterCtx IO)-  deriving (HasStream "letterCount" (Occurrences Char)) via-    (StreamLog  -- Generate HasStream using HasState of Monoid+  deriving (HasSink "letterCount" (Occurrences Char)) via+    (SinkLog  -- Generate HasSink using HasState of Monoid     (ReaderIORef  -- Generate HasState from HasReader of IORef     (Field "letterCount" "ctx"  -- Focus on the field letterCount     (MonadReader  -- Generate HasReader using mtl MonadReader     (ReaderT CounterCtx IO)))))  -- Use mtl ReaderT newtype-  deriving (HasStream "wordCount" (Occurrences Text)) via-    StreamLog (ReaderIORef+  deriving (HasSink "wordCount" (Occurrences Text)) via+    SinkLog (ReaderIORef     (Field "wordCount" "ctx" (MonadReader (ReaderT CounterCtx IO))))  

@@ -9,7 +9,8 @@ module Writer where  import Capability.State-import Capability.Stream+import Capability.Sink+import Capability.Source import Capability.Writer import Control.Monad.State.Strict (State, StateT (..), runState) import Data.Monoid (Sum (..))@@ -19,12 +20,12 @@ -- Example Programs  -- | Increase a counter using a writer monad.-useWriter :: HasWriter "count" (Sum Int) m => m ()+useWriter :: HasWriter "count-writer" (Sum Int) m => m () useWriter = do   -- Add 3 and retrieve result-  ((), count) <- listen @"count" (tell @"count" 3)+  ((), count) <- listen @"count-writer" (tell @"count-writer" 3)   -- Duplicate-  tell @"count" count+  tell @"count-writer" count   -- | Mix writer and state monad operations on the same tag.@@ -33,12 +34,12 @@ -- real applications.  The @HasState@ capability could be used to clear the -- accumulated outcome of the @HasWriter@ capability. mixWriterState-  :: (HasState "count" Int m, HasWriter "count" (Sum Int) m)+  :: (HasState "count-state" Int m, HasWriter "count-writer" (Sum Int) m)   => m Int mixWriterState = do-  tell @"count" 1-  one <- get @"count"-  tell @"count" $ Sum one+  tell @"count-writer" 1+  one <- get @"count-state"+  tell @"count-writer" $ Sum one   pure one  @@ -51,7 +52,7 @@ -- via clause. newtype WriterM a = WriterM (State Int a)   deriving (Functor, Applicative, Monad)-  deriving (HasStream "count" (Sum Int), HasWriter "count" (Sum Int))+  deriving (HasSink "count-writer" (Sum Int), HasWriter "count-writer" (Sum Int))     via WriterLog (Coerce (Sum Int) (MonadState (State Int)))  runWriterM :: WriterM a -> (a, Int)@@ -65,9 +66,9 @@ -- See caveat on 'mixWriterState'. newtype BadWriterM a = BadWriterM (State Int a)   deriving (Functor, Applicative, Monad)-  deriving (HasStream "count" (Sum Int), HasWriter "count" (Sum Int))+  deriving (HasSink "count-writer" (Sum Int), HasWriter "count-writer" (Sum Int))     via WriterLog (Coerce (Sum Int) (MonadState (State Int)))-  deriving (HasState "count" Int)+  deriving (HasSource "count-state" Int, HasSink "count-state" Int, HasState "count-state" Int)     via MonadState (State Int)  runBadWriterM :: BadWriterM a -> (a, Int)

@@ -51,6 +51,29 @@ -- Then you can use @foo@ at type @MyM@. Or any other type which can provide -- these capabilites. --+-- === Functional capabilities+--+-- When writing applications, as opposed to libraries, a capability /name/ often+-- determines its type parameters. It can be tiresome to write+--+-- @+-- f :: HasReader "config" Config m => …+-- @+--+-- over and over again.+--+-- To avoid this, each capability comes with a /functional/—here+-- @HasReader\'@—variant (in this terminology @HasReader@ is+-- /relational/). Where the type is deduced from the capability's name. The+-- mapping from name to type is done with the @'Capability.TypeOf.TypeOf'@+-- family, which is re-exported by every capability module.+--+-- @+-- type instance TypeOf Symbol "config" = Config+--+-- f :: HasReader' "config" m => …+-- @+-- -- == Module structure -- -- Each module introduces a capability type class (or several related type@@ -65,12 +88,34 @@ -- * "Capability.State" state effects -- * "Capability.Writer" writer effects -- * "Capability.Error" throw and catch errors--- * "Capability.Stream" streaming effect (aka generators)+-- * "Capability.Source" streaming in effect+-- * "Capability.Sink" streaming out effect (aka generators) --+-- The effects are not all independent:+--+-- >     Source   Sink+-- >     /   \    /   \+-- >    /     \  /     \+-- > Reader   State    Writer+--+-- "Capability.Source" and "Capability.Sink" have just a method each, and no laws.+-- The bottom three, familiar from mtl, add methods and laws relating them.+-- The use of tags allows one to have independent effects that share a superclass.+-- E.g. @HasState "foo" Int@ and @HasWriter "bar" String@.+-- -- Some of the capability modules have a “discouraged” companion (such as -- "Capability.Writer.Discouraged"). These modules contain deriving-via -- combinators which you can use if you absolutely must: they are correct, but -- inefficient, so we recommend that you do not.+--+-- Finally there is+--+-- * "Capability.Derive"+--+-- Which exports a (still experimental) 'Capability.Derive.derive' function,+-- which lets you run a computation which requires capabilities which are not+-- directly provided by the ambient monad, but can be derived from the+-- capabilities provided by the ambient monad. -- -- == Further considerations --

@@ -0,0 +1,38 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}++-- | This module defines helper types and type families for working with sets of+-- capabilities.++module Capability.Constraints+  ( All+  , Capability+  , Constraint+  , Dict(..)+  ) where++import Data.Constraint (Dict(..))+import Data.Kind (Constraint)++-- | A 'Capability' takes a type constructor @* -> *@ (e.g., a monad) and+-- returns a 'Constraint'. Examples of capabilities includ: @HasReader "foo"+-- Int@, @MonadIO@, …+type Capability = (* -> *) -> Constraint++-- | Type family used used to express a conjunction of constraints over a single+-- type.+--+-- Examples:+--+-- > All '[Num, Eq] Int+-- >   -- Equivalent to: (Num Int, Eq Int)+-- >+-- > All '[HasReader "foo" Int, HasSink "bar" Float] m+-- >   -- Equivalent to: (HasReader "foo" Int m, HasSink "bar" Float m)+type family All (xs :: [k -> Constraint]) a :: Constraint where+  All '[] a = ()+  All (x ':xs) a = (x a, All xs a)

@@ -0,0 +1,54 @@+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Capability.Derive where++import Capability.Constraints+import Data.Coerce (Coercible)+import Unsafe.Coerce (unsafeCoerce)++-- | Runs an action that requires additional capabilities.+--+-- @'derive' \@t \@derived \@ambient act@ runs @act@ by providing both the+-- capabilities in @derived@ and @ambient@. The difference is that @ambient@+-- capabilities are assumed to be available, whereas @derived@ instances are+-- provided by @t@.+--+-- 'derive' assumes that @t@ is a newtype defined in the form:+--+-- @+-- newtype T m a = T (m a)+-- @+--+-- Then 'derive' uses type-class instances for `T` to provide for each of the+-- capabilities in @derived@.+--+-- A common instance of this is 'Capability.Error.wrapError', whereby exceptions+-- raised by @act@ can be repackaged in a larger exception type.+--+-- The @derive@ function is experimental and is subject to change.+derive ::+  forall t (derived :: [Capability]) (ambient :: [Capability]) m a.+  ( forall x. Coercible (t m x) (m x)+  , All derived (t m)+  , All ambient m)+  => (forall m'. (All derived m', All ambient m') => m' a) -> m a+derive action =+  let tmDict = Dict @(All derived (t m))+      mDict =+        -- Note: this use of 'unsafeCoerce' should be safe thanks the Coercible+        -- constraint between 'm x' and 't m x'. However, dictionaries+        -- themselves aren't coercible since the type role of 'c' in 'Dict c' is+        -- nominal.+        unsafeCoerce @_ @(Dict (All derived m)) tmDict in+  case mDict of+    Dict -> action+{-# INLINE derive #-}

@@ -24,6 +24,7 @@ -- thrown under @"foo"@.  {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}@@ -45,13 +46,17 @@ {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}  module Capability.Error-  ( -- * Interface+  ( -- * Relational capabilities     HasThrow(..)   , throw   , HasCatch(..)   , catch   , catchJust   , wrapError+    -- * Functional capabilities+  , HasThrow'+  , HasCatch'+  , TypeOf     -- * Strategies   , MonadError(..)   , MonadThrow(..)@@ -66,6 +71,9 @@   ) where  import Capability.Accessors+import Capability.Constraints+import Capability.Derive (derive)+import Capability.TypeOf import Control.Exception (Exception(..)) import qualified Control.Exception.Safe as Safe import Control.Lens (preview, review)@@ -143,12 +151,12 @@ {-# INLINE catchJust #-}  -- | Wrap exceptions @inner@ originating from the given action according to--- the accessor @t@.+-- the accessor @t@. Retain arbitrary capabilities listed in @cs@. -- -- Example: -- -- > wrapError--- >   @"AppError" @"ComponentError" @(Ctor "ComponentError" "AppError")+-- >   @"ComponentError" @(Ctor "ComponentError" "AppError") @'[] -- >   component -- > -- > component :: HasError "ComponentError" ComponentError m => m ()@@ -156,13 +164,13 @@ -- -- This function is experimental and subject to change. -- See <https://github.com/tweag/capability/issues/46>.-wrapError :: forall outertag innertag t outer inner m a.+wrapError :: forall innertag t (cs :: [Capability]) inner m a.   ( forall x. Coercible (t m x) (m x)-  , forall m'. HasCatch outertag outer m'-    => HasCatch innertag inner (t m')-  , HasCatch outertag outer m )-  => (forall m'. HasCatch innertag inner m' => m' a) -> m a-wrapError action = coerce @(t m a) action+  , HasCatch innertag inner (t m)+  , All cs m)+  => (forall m'. All (HasCatch innertag inner ': cs) m' => m' a) -> m a+wrapError =+  derive @t @'[HasCatch innertag inner] @cs {-# INLINE wrapError #-}  -- XXX: Does it make sense to add a HasMask capability similar to @MonadMask@?@@ -421,3 +429,11 @@   ( forall x. Coercible (m x) (t2 (t1 m) x)   , Monad m, HasCatch tag e (t2 (t1 m)) )   => HasCatch tag e ((t2 :.: t1) m)++-- | Type synonym using the 'TypeOf' type family to specify 'HasThrow'+-- constraints without having to specify the type associated to a tag.+type HasThrow' (tag :: k) = HasThrow tag (TypeOf k tag)++-- | Type synonym using the 'TypeOf' type family to specify 'HasCatch'+-- constraints without having to specify the type associated to a tag.+type HasCatch' (tag :: k) = HasCatch tag (TypeOf k tag)

@@ -1,3 +1,7 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeInType #-}+ -- | Defines a capability type class for a reader effect. A reader provides an -- environment, say an initialization context or a configuration. The -- environment held in the reader effect can be changed (with 'local') within@@ -5,8 +9,11 @@ -- a change is local, and does not persist when the 'local' call ends.  module Capability.Reader-  ( -- * Interface+  ( -- * Relational capability     module Capability.Reader.Internal.Class+    -- * Functional capability+  , HasReader'+  , TypeOf     -- * Strategies   , module Capability.Reader.Internal.Strategies     -- ** Modifiers@@ -16,3 +23,8 @@ import Capability.Accessors import Capability.Reader.Internal.Class import Capability.Reader.Internal.Strategies+import Capability.TypeOf++-- | Type synonym using the 'TypeOf' type family to specify 'HasReader'+-- constraints without having to specify the type associated to a tag.+type HasReader' (tag :: k) = HasReader tag (TypeOf k tag)

@@ -7,6 +7,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeInType #-}  {-# OPTIONS_HADDOCK hide #-}@@ -20,7 +21,10 @@   , magnify   ) where -import Data.Coerce (Coercible, coerce)+import Capability.Constraints+import Capability.Source.Internal.Class+import Capability.Derive (derive)+import Data.Coerce (Coercible) import GHC.Exts (Proxy#, proxy#)  -- | Reader capability@@ -36,16 +40,11 @@ -- prop> local @t f (pure x) = pure x -- prop> local @t f (m >>= \x -> k x) = local @t f m >>= \x -> local @t f (k x) -- prop> reader @t f = f <$> ask @t-class Monad m+class (Monad m, HasSource tag r m)   => HasReader (tag :: k) (r :: *) (m :: * -> *) | tag m -> r   where     -- | For technical reasons, this method needs an extra proxy argument.     -- You only need it if you are defining new instances of 'HasReader'.-    -- Otherwise, you will want to use 'ask'.-    -- See 'ask' for more documentation.-    ask_ :: Proxy# tag -> m r-    -- | For technical reasons, this method needs an extra proxy argument.-    -- You only need it if you are defining new instances of 'HasReader'.     -- Otherwise, you will want to use 'local'.     -- See 'local' for more documentation.     local_ :: Proxy# tag -> (r -> r) -> m a -> m a@@ -58,7 +57,7 @@ -- | @ask \@tag@ -- retrieves the environment of the reader capability @tag@. ask :: forall tag r m. HasReader tag r m => m r-ask = ask_ (proxy# @_ @tag)+ask = await @tag {-# INLINE ask #-}  -- | @asks \@tag@@@ -67,7 +66,7 @@ -- -- prop> asks @tag f = f <$> ask @tag asks :: forall tag r m a. HasReader tag r m => (r -> a) -> m a-asks f = f <$> ask @tag+asks = awaits @tag {-# INLINE asks #-}  -- | @local \@tag f m@@@ -88,17 +87,19 @@ {-# INLINE reader #-}  -- | Execute the given reader action on a sub-component of the current context--- as defined by the given transformer @t@.+-- as defined by the given transformer @t@, retaining arbitrary capabilities+-- listed in @cs@. ----- See 'Capability.State.zoom'.+-- See the similar 'Capability.State.zoom' function for more details and+-- examples. -- -- This function is experimental and subject to change. -- See <https://github.com/tweag/capability/issues/46>.-magnify :: forall outertag innertag t outer inner m a.+magnify :: forall innertag t (cs :: [Capability]) inner m a.   ( forall x. Coercible (t m x) (m x)-  , forall m'. HasReader outertag outer m'-    => HasReader innertag inner (t m')-  , HasReader outertag outer m )-  => (forall m'. HasReader innertag inner m' => m' a) -> m a-magnify m = coerce @(t m a) m+  , HasReader innertag inner (t m)+  , All cs m)+  => (forall m'. All (HasReader innertag inner ': cs) m' => m' a) -> m a+magnify =+  derive @t @'[HasReader innertag inner] @cs {-# INLINE magnify #-}

@@ -15,6 +15,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PatternSynonyms #-}  {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}@@ -30,10 +31,9 @@ import Capability.Accessors import Capability.Reader.Internal.Class import Capability.State.Internal.Class+import Capability.Source.Internal.Strategies import Control.Lens (over, view) import Control.Monad.Catch (MonadMask, bracket)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Primitive (PrimMonad) import qualified Control.Monad.Reader.Class as Reader import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Control (MonadTransControl(..))@@ -42,14 +42,7 @@ import qualified Data.Generics.Product.Positions as Generic import GHC.Exts (Proxy#) --- | Derive 'HasReader' from @m@'s 'Control.Monad.Reader.Class.MonadReader'--- instance.-newtype MonadReader (m :: * -> *) (a :: *) = MonadReader (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)- instance Reader.MonadReader r m => HasReader tag r (MonadReader m) where-  ask_ _ = coerce @(m r) Reader.ask-  {-# INLINE ask_ #-}   local_     :: forall a. Proxy# tag -> (r -> r) -> MonadReader m a -> MonadReader m a   local_ _ = coerce @((r -> r) -> m a -> m a) Reader.local@@ -58,27 +51,7 @@   reader_ _ = coerce @((r -> a) -> m a) Reader.reader   {-# INLINE reader_ #-} --- | Convert a /pure/ state monad into a reader monad.------ /Pure/ meaning that the monad stack does not allow catching exceptions.--- Otherwise, an exception occurring in the action passed to 'local' could cause--- the context to remain modified outside of the call to 'local'. E.g.------ > local @tag (const r') (throw MyException)--- > `catch` \MyException -> ask @tag------ returns @r'@ instead of the previous value.------ Note, that no @MonadIO@ instance is provided, as this would allow catching--- exceptions.------ See 'ReadState'.-newtype ReadStatePure (m :: * -> *) (a :: *) = ReadStatePure (m a)-  deriving (Functor, Applicative, Monad)- instance HasState tag r m => HasReader tag r (ReadStatePure m) where-  ask_ _ = coerce @(m r) $ get @tag-  {-# INLINE ask_ #-}   local_ :: forall a.     Proxy# tag -> (r -> r) -> ReadStatePure m a -> ReadStatePure m a   local_ _ f = coerce @(m a -> m a) $ \m -> do@@ -89,20 +62,10 @@   reader_ _ = coerce @((r -> a) -> m a) $ gets @tag   {-# INLINE reader_ #-} --- | Convert a state monad into a reader monad.------ Use this if the monad stack allows catching exceptions.------ See 'ReadStatePure'.-newtype ReadState (m :: * -> *) (a :: *) = ReadState (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)- instance   (HasState tag r m, MonadMask m)   => HasReader tag r (ReadState m)   where-    ask_ _ = coerce @(m r) $ get @tag-    {-# INLINE ask_ #-}     local_ :: forall a.       Proxy# tag -> (r -> r) -> ReadState m a -> ReadState m a     local_ _ f = coerce @(m a -> m a) $ \action ->@@ -122,8 +85,6 @@   , forall x y. Coercible x y => Coercible (m x) (m y) )   => HasReader tag to (Coerce to m)   where-    ask_ tag = coerce @(m from) $ ask_ tag-    {-# INLINE ask_ #-}     local_       :: forall a. Proxy# tag -> (to -> to) -> Coerce to m a -> Coerce to m a     local_ tag = coerce @((from -> from) -> m a -> m a) $ local_ tag@@ -134,8 +95,6 @@  -- | Rename the tag. instance HasReader oldtag r m => HasReader newtag r (Rename oldtag m) where-  ask_ _ = coerce @(m r) $ ask @oldtag-  {-# INLINE ask_ #-}   local_ :: forall a.     Proxy# newtag -> (r -> r) -> Rename oldtag m a -> Rename oldtag m a   local_ _ = coerce @((r -> r) -> m a -> m a) $ local @oldtag@@ -144,7 +103,6 @@   reader_ _ = coerce @((r -> a) -> m a) $ reader @oldtag   {-# INLINE reader_ #-} - -- | Zoom in on the record field @field@ of type @v@ -- in the environment @record@. instance@@ -154,9 +112,6 @@   ( tag ~ field, Generic.HasField' field record v, HasReader oldtag record m )   => HasReader tag v (Field field oldtag m)   where-    ask_ _ = coerce @(m v) $-      asks @oldtag $ view (Generic.field' @field)-    {-# INLINE ask_ #-}     local_ :: forall a.       Proxy# tag       -> (v -> v)@@ -182,9 +137,6 @@   ( tag ~ pos, Generic.HasPosition' pos struct v, HasReader oldtag struct m )   => HasReader tag v (Pos pos oldtag m)   where-    ask_ _ = coerce @(m v) $-      asks @oldtag $ view (Generic.position' @pos)-    {-# INLINE ask_ #-}     local_ :: forall a.       Proxy# tag       -> (v -> v)@@ -205,8 +157,6 @@ instance (HasReader tag r m, MonadTransControl t, Monad (t m))   => HasReader tag r (Lift (t m))   where-    ask_ _ = coerce $ lift @t @m $ ask @tag @r-    {-# INLINE ask_ #-}     local_       :: forall a. Proxy# tag -> (r -> r) -> Lift (t m) a -> Lift (t m) a     local_ _ f = coerce @(t m a -> t m a) $

@@ -0,0 +1,43 @@+-- | Defines a capability for computations that produce a stream of values+-- as part of their execution.+--+-- Programs producing streams of data are common. Examples: emitting events on+-- input, or emitting events whenever certain conditions are observed. streams+-- are similar to Python generators.+--+-- The 'HasSink' capability enables separating the logic responsible for+-- emitting events from that responsible for collecting or handling them.+-- The name is because a sink is needed to consume the locally produced stream.+--+-- This can be thought of as a writer capability of a list of values @HasWriter+-- tag [v]@ with @\\x -> tell \@tag [x]@ as a primitive operation. However, that+-- implementation would be inefficient.+--+-- For example using the 'Streaming.Prelude.Stream' instance, a producer defined+-- using this capability can be consumed efficiently in a streaming fashion.++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}++module Capability.Sink+  ( -- * Relational capability+    module Capability.Sink.Internal.Class+    -- * Functional capability+  , HasSink'+  , TypeOf+    -- * Strategies+  , module Capability.Sink.Internal.Strategies+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Sink.Internal.Class+import Capability.Sink.Internal.Strategies+import Capability.Accessors+import Capability.TypeOf++-- | Type synonym using the 'TypeOf' type family to specify 'HasSink'+-- constraints without having to specify the type associated to a tag.+type HasSink' (tag :: k) = HasSink tag (TypeOf k tag)

@@ -0,0 +1,43 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Sink.Internal.Class where++import GHC.Exts (Proxy#, proxy#)++-- | Sinking capability.+--+-- An instance does not need to fulfill any additional laws+-- besides the monad laws.+class Monad m+  => HasSink (tag :: k) (a :: *) (m :: * -> *) | tag m -> a+  where+    -- | For technical reasons, this method needs an extra proxy argument.+    -- You only need it if you are defining new instances of 'HasSink'.+    -- Otherwise, you will want to use 'yield'.+    -- See 'yield' for more documentation.+    yield_ :: Proxy# tag -> a -> m ()++-- | @yield \@tag a@+-- emits @a@ in the sink capability @tag@.+yield :: forall tag a m. HasSink tag a m => a -> m ()+yield = yield_ (proxy# @_ @tag)+{-# INLINE yield #-}

@@ -0,0 +1,174 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Sink.Internal.Strategies+  ( SinkStack(..)+  , SinkDList(..)+  , SinkLog(..)+  ) where++import Capability.Accessors+import Capability.Source.Internal.Class+import Capability.Sink.Internal.Class+import Capability.State.Internal.Class+import Capability.State.Internal.Strategies.Common+import Control.Lens (set)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Primitive (PrimMonad)+import qualified Control.Monad.State.Class as State+import Control.Monad.Trans.Class (MonadTrans, lift)+import Data.Coerce (Coercible, coerce)+import Data.DList (DList)+import qualified Data.DList as DList+import qualified Data.Generics.Product.Fields as Generic+import qualified Data.Generics.Product.Positions as Generic+import Data.IORef+import Data.Mutable+import Streaming+import qualified Streaming.Prelude as S++-- | Accumulate sunk values in a reverse order list.+newtype SinkStack m (a :: *) = SinkStack (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+instance HasState tag [a] m => HasSink tag a (SinkStack m) where+  yield_ _ a = coerce @(m ()) $ modify' @tag (a:)+  {-# INLINE yield_ #-}++-- | Accumulate sunk values in forward order in a difference list.+newtype SinkDList m (a :: *) = SinkDList (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+-- | This instance may seem a bit odd at first. All it does is wrap each+-- 'yield'ed value in a single element difference list. How does re-yielding+-- something else constitute a strategy for implementing 'HasSink' in the+-- first place? The answer is that difference lists form a monoid, which allows+-- a second stragegy to be used which accumulates all 'yield's in a single+-- value, actually eliminating the 'HasSink' constraint this time.+--+-- 'SinkLog' below in fact does this, so the easiest way to fully eliminate+-- the 'HasSink' constraint as described above is:+--+-- > deriving (HasSink tag w) via+-- >   SinkDList (SinkLog (MonadState SomeStateMonad))+instance HasSink tag (DList a) m => HasSink tag a (SinkDList m) where+  yield_ _ = coerce @(a -> m ()) $ yield @tag . DList.singleton+  {-# INLINE yield_ #-}++-- | Accumulate sunk values with their own monoid.+newtype SinkLog m (a :: *) = SinkLog (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+instance (Monoid w, HasState tag w m) => HasSink tag w (SinkLog m) where+    yield_ _ w = coerce @(m ()) $ modify' @tag (<> w)+    {-# INLINE yield_ #-}++instance Monad m => HasSink tag a (S.Stream (Of a) m) where+  yield_ _ = S.yield+  {-# INLINE yield_ #-}++-- | Lift one layer in a monad transformer stack.+--+-- Note, that if the 'HasSink' instance is based on 'HasState', then it is+-- more efficient to apply 'Lift' to the underlying state capability. E.g.+-- you should favour+--+-- > deriving (HasSink tag w) via+-- >   SinkLog (Lift (SomeTrans (MonadState SomeStateMonad)))+--+-- over+--+-- > deriving (HasSink tag w) via+-- >   Lift (SomeTrans (SinkLog (MonadState SomeStateMonad)))+instance (HasSink tag a m, MonadTrans t, Monad (t m))+  => HasSink tag a (Lift (t m))+  where+    yield_ _ = coerce @(a -> t m ()) $ lift . yield @tag+    {-# INLINE yield_ #-}++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasSink tag a (t2 (t1 m)) )+  => HasSink tag a ((t2 :.: t1) m)++-- | Convert the state using safe coercion.+instance+  ( Coercible from to, HasSink tag from m )+  => HasSink tag to (Coerce to m)+  where+    yield_ tag = coerce @(from -> m ()) $ yield_ tag+    {-# INLINE yield_ #-}++-- | Rename the tag.+instance HasSink oldtag s m => HasSink newtag s (Rename oldtag m) where+  yield_ _ = coerce @(s -> m ()) $ yield @oldtag+  {-# INLINE yield_ #-}++-- | Zoom in on the record field @field@ of type @v@ in the state @record@.+instance+  -- The constraint raises @-Wsimplifiable-class-constraints@.+  -- This could be avoided by instead placing @HasField'@s constraints here.+  -- Unfortunately, it uses non-exported symbols from @generic-lens@.+  ( tag ~ field, Generic.HasField' field record v, HasState oldtag record m )+  => HasSink tag v (Field field oldtag m)+  where+    yield_ _ = coerce @(v -> m ()) $+      modify @oldtag . set (Generic.field' @field @record)+    {-# INLINE yield_ #-}++-- | Zoom in on the field at position @pos@ of type @v@ in the state @struct@.+instance+  -- The constraint raises @-Wsimplifiable-class-constraints@.+  -- This could be avoided by instead placing @HasPosition'@s constraints here.+  -- Unfortunately, it uses non-exported symbols from @generic-lens@.+  ( tag ~ pos, Generic.HasPosition' pos struct v, HasState oldtag struct m )+  => HasSink tag v (Pos pos oldtag m)+  where+    yield_ _ = coerce @(v -> m ()) $+      modify @oldtag . set (Generic.position' @pos @struct)+    {-# INLINE yield_ #-}++--------------------------------------------------------------------------------++instance State.MonadState s m => HasSink tag s (MonadState m) where+  yield_ _ = coerce @(s -> m ()) State.put+  {-# INLINE yield_ #-}++instance+  (HasSource tag (IORef s) m, MonadIO m)+  => HasSink tag s (ReaderIORef m)+  where+    yield_ _ v = ReaderIORef $ do+      ref <- await @tag+      liftIO $ writeIORef ref v+    {-# INLINE yield_ #-}++instance+  ( MutableRef ref, RefElement ref ~ s+  , HasSource tag ref m, PrimMonad m, PrimState m ~ MCState ref )+  => HasSink tag s (ReaderRef m)+  where+    yield_ _ v = ReaderRef $ do+      ref <- await @tag+      writeRef ref v+    {-# INLINE yield_ #-}

@@ -0,0 +1,53 @@+-- | Defines a capability for computations that consume a stream of values+-- as part of their execution.+--+-- Programs comsuming streams of data are common. Examples: rolling up input+-- events. Sources are similar to Python generators.+--+-- This can be thought of as a reader capability where there's no guarantee that+-- one reads the same value each time.+--+-- The 'HasSource' capability enables separating the logic responsible for+-- emitting events from that responsible for collecting or handling them.+-- The name is because a source is needed to produce the locally consumed stream.+--++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++module Capability.Source+  ( -- * Relational capability+    module Capability.Source.Internal.Class+    -- * Functional capability+  , HasSource'+  , TypeOf+    -- * Strategies+  , module Capability.Source.Internal.Strategies+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Accessors+import Capability.Source.Internal.Class+import Capability.Source.Internal.Strategies+import Capability.TypeOf++-- | Type synonym using the 'TypeOf' type family to specify 'HasSource'+-- constraints without having to specify the type associated to a tag.+type HasSource' (tag :: k) = HasSource tag (TypeOf k tag)

@@ -0,0 +1,66 @@+-- | Defines a capability for computations that consume a stream of values+-- as part of their execution.+--+-- Programs comsuming streams of data are common. Examples: rolling up input+-- events. Sources are similar to Python generators.+--+-- This can be thought of as a reader capability where there's no guarantee that+-- one reads the same value each time.+--+-- The 'HasSource' capability enables separating the logic responsible for+-- emitting events from that responsible for collecting or handling them.+-- The name is because a source is needed to produce the locally consumed stream.+--++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Source.Internal.Class where++import GHC.Exts (Proxy#, proxy#)++-- | Sourcing capability.+--+-- An instance does not need to fulfill any additional laws+-- besides the monad laws.+class Monad m+  => HasSource (tag :: k) (a :: *) (m :: * -> *) | tag m -> a+  where+    -- | For technical reasons, this method needs an extra proxy argument.+    -- You only need it if you are defining new instances of 'HasSource'.+    -- Otherwise, you will want to use 'await'.+    -- See 'await' for more documentation.+    await_ :: Proxy# tag -> m a++-- | @await \@tag a@+-- takes @a@ from the source capability @tag@.+await :: forall tag a m. HasSource tag a m => m a+await = await_ (proxy# @_ @tag)+{-# INLINE await #-}++-- | @awaits \@tag@+-- retrieves the image by @f@ of the environment+-- of the reader capability @tag@.+--+-- prop> awaits @tag f = f <$> await @tag+awaits :: forall tag r m a. HasSource tag r m => (r -> a) -> m a+awaits f = f <$> await @tag+{-# INLINE awaits #-}

@@ -0,0 +1,163 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Source.Internal.Strategies+  ( MonadReader(..)+  , ReadStatePure(..)+  , ReadState(..)+  , MonadState(..)+  , ReaderIORef(..)+  , ReaderRef(..)+  ) where++import Capability.Source.Internal.Class+import Capability.State.Internal.Class+import Capability.State.Internal.Strategies.Common+import Capability.Accessors+import Control.Lens (view)+import Control.Monad.Catch (MonadMask)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Primitive (PrimMonad)+import qualified Control.Monad.Reader.Class as Reader+import qualified Control.Monad.State.Class as State+import Control.Monad.Trans.Class (MonadTrans, lift)+import Data.Coerce (Coercible, coerce)+import Data.IORef+import Data.Mutable+import qualified Data.Generics.Product.Fields as Generic+import qualified Data.Generics.Product.Positions as Generic++--------------------------------------------------------------------------------++-- | Derive 'HasSource' from @m@'s 'Control.Monad.Reader.Class.MonadReader'+-- instance.+newtype MonadReader (m :: * -> *) (a :: *) = MonadReader (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance Reader.MonadReader r m => HasSource tag r (MonadReader m) where+  await_ _ = coerce @(m r) Reader.ask+  {-# INLINE await_ #-}++-- | Convert a /pure/ state monad into a reader monad.+--+-- /Pure/ meaning that the monad stack does not allow catching exceptions.+-- Otherwise, an exception occurring in the action passed to 'local' could cause+-- the context to remain modified outside of the call to 'local'. E.g.+--+-- > local @tag (const r') (throw MyException)+-- > `catch` \MyException -> ask @tag+--+-- returns @r'@ instead of the previous value.+--+-- Note, that no @MonadIO@ instance is provided, as this would allow catching+-- exceptions.+--+-- See 'ReadState'.+newtype ReadStatePure (m :: * -> *) (a :: *) = ReadStatePure (m a)+  deriving (Functor, Applicative, Monad)++instance HasState tag r m => HasSource tag r (ReadStatePure m) where+  await_ _ = coerce @(m r) $ get @tag+  {-# INLINE await_ #-}++-- | Convert a state monad into a reader monad.+--+-- Use this if the monad stack allows catching exceptions.+--+-- See 'ReadStatePure'.+newtype ReadState (m :: * -> *) (a :: *) = ReadState (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance+  (HasState tag r m, MonadMask m)+  => HasSource tag r (ReadState m)+  where+    await_ _ = coerce @(m r) $ get @tag+    {-# INLINE await_ #-}++instance+  ( tag ~ pos, Generic.HasPosition' pos struct v, HasSource oldtag struct m )+  => HasSource tag v (Pos pos oldtag m)+  where+    await_ _ = coerce @(m v) $+      awaits @oldtag $ view (Generic.position' @pos)+    {-# INLINE await_ #-}++deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasSource tag r (t2 (t1 m)) )+  => HasSource tag r ((t2 :.: t1) m)++instance+  ( Coercible from to, HasSource tag from m+  , forall x y. Coercible x y => Coercible (m x) (m y) )+  => HasSource tag to (Coerce to m)+  where+    await_ tag = coerce @(m from) $ await_ tag+    {-# INLINE await_ #-}++-- | Rename the tag.+instance HasSource oldtag r m => HasSource newtag r (Rename oldtag m) where+  await_ _ = coerce @(m r) $ await @oldtag+  {-# INLINE await_ #-}++instance+  ( tag ~ field, Generic.HasField' field record v, HasSource oldtag record m )+  => HasSource tag v (Field field oldtag m)+  where+    await_ _ = coerce @(m v) $+      awaits @oldtag $ view (Generic.field' @field)+    {-# INLINE await_ #-}++instance (HasSource tag r m, MonadTrans t, Monad (t m))+  => HasSource tag r (Lift (t m))+  where+    await_ _ = coerce $ lift @t @m $ await @tag @r+    {-# INLINE await_ #-}++--------------------------------------------------------------------------------++instance State.MonadState s m => HasSource tag s (MonadState m) where+  await_ _ = coerce @(m s) State.get+  {-# INLINE await_ #-}++instance+  (HasSource tag (IORef s) m, MonadIO m)+  => HasSource tag s (ReaderIORef m)+  where+    await_ _ = ReaderIORef $ do+      ref <- await @tag+      liftIO $ readIORef ref+    {-# INLINE await_ #-}++instance+  ( MutableRef ref, RefElement ref ~ s+  , HasSource tag ref m, PrimMonad m, PrimState m ~ MCState ref )+  => HasSource tag s (ReaderRef m)+  where+    await_ _ = ReaderRef $ do+      ref <- await @tag+      readRef ref+    {-# INLINE await_ #-}

@@ -1,3 +1,7 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeInType #-}+ -- | Defines a capability type class for a state effect. A state capability -- provides a state which can be retrieved with 'get' and set with 'put'. As an -- analogy, each state capability is equivalent to making one @IORef@ available@@ -9,8 +13,11 @@ -- or "Capability.Stream".  module Capability.State-  ( -- * Interface+  ( -- * Relational capability     module Capability.State.Internal.Class+    -- * Functional capability+  , HasState'+  , TypeOf     -- * Strategies   , module Capability.State.Internal.Strategies     -- ** Modifiers@@ -20,3 +27,8 @@ import Capability.Accessors import Capability.State.Internal.Class import Capability.State.Internal.Strategies+import Capability.TypeOf++-- | Type synonym using the 'TypeOf' type family to specify 'HasState'+-- constraints without having to specify the type associated to a tag.+type HasState' (tag :: k) = HasState tag (TypeOf k tag)

@@ -7,7 +7,9 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}  {-# OPTIONS_HADDOCK hide #-} @@ -22,7 +24,11 @@   , zoom   ) where -import Data.Coerce (Coercible, coerce)+import Capability.Constraints+import Capability.Derive (derive)+import Capability.Source.Internal.Class+import Capability.Sink.Internal.Class+import Data.Coerce (Coercible) import GHC.Exts (Proxy#, proxy#)  -- | State capability@@ -36,21 +42,11 @@ -- prop> put @t s1 >> put @t s2 = put @t s2 -- prop> put @t s >> get @t = put @t s >> pure s -- prop> state @t f = get @t >>= \s -> let (a, s') = f s in put @t s' >> pure a-class Monad m+class (Monad m, HasSource tag s m, HasSink tag s m)   => HasState (tag :: k) (s :: *) (m :: * -> *) | tag m -> s   where     -- | For technical reasons, this method needs an extra proxy argument.     -- You only need it if you are defining new instances of 'HasState.-    -- Otherwise, you will want to use 'get'.-    -- See 'get' for more documentation.-    get_ :: Proxy# tag -> m s-    -- | For technical reasons, this method needs an extra proxy argument.-    -- You only need it if you are defining new instances of 'HasState.-    -- Otherwise, you will want to use 'put'.-    -- See 'put' for more documentation.-    put_ :: Proxy# tag -> s -> m ()-    -- | For technical reasons, this method needs an extra proxy argument.-    -- You only need it if you are defining new instances of 'HasState.     -- Otherwise, you will want to use 'state'.     -- See 'state' for more documentation.     state_ :: Proxy# tag -> (s -> (a, s)) -> m a@@ -58,13 +54,13 @@ -- | @get \@tag@ -- retrieve the current state of the state capability @tag@. get :: forall tag s m. HasState tag s m => m s-get = get_ (proxy# @_ @tag)+get = await @tag {-# INLINE get #-}  -- | @put \@tag s@ -- replace the current state of the state capability @tag@ with @s@. put :: forall tag s m. HasState tag s m => s -> m ()-put = put_ (proxy# @_ @tag)+put = yield @tag {-# INLINE put #-}  -- | @state \@tag f@@@ -102,24 +98,34 @@   pure (f s) {-# INLINE gets #-} --- | Execute the given state action on a sub-component of the current state--- as defined by the given transformer @t@.+-- | Execute the given state action on a sub-component of the current state as+-- defined by the given transformer @t@. The set of retained capabilities must+-- be passed as @cs. If no capabilities are required,+-- 'Capabilities.Constraints.None' can be used. ----- Example:+-- Examples: ----- > zoom @"foobar" @"foo" @(Field "foo" "foobar") foo--- >   :: HasState "foobar" FooBar m => m ()+-- > foo :: HasState "foo" Int m => m ()+-- > zoom @"foo" @(Field "foo" "foobar") @None foo+-- >   :: (HasField' "foobar" record Int, HasState "foobar" record m) => m () -- >+-- > zoom @"foo" @(Field "foo" "foobar") @('[MonadIO]) bar+-- >   :: ( HasField' "foobar" record Int, HasState "foobar" record m+-- >      , MonadIO m) => m ()+-- > -- > foo :: HasState "foo" Int m => m ()--- > data FooBar = FooBar { foo :: Int, bar :: String }+-- > bar :: (MonadIO m, HasState "foo" Int m) => m () --+-- Note: the 'Data.Generics.Product.Fields.HasField'' constraint comes from the+-- @generic-lens@ package.+-- -- This function is experimental and subject to change. -- See <https://github.com/tweag/capability/issues/46>.-zoom :: forall outertag innertag t outer inner m a.+zoom :: forall innertag t (cs :: [Capability]) inner m a.   ( forall x. Coercible (t m x) (m x)-  , forall m'. HasState outertag outer m'-    => HasState innertag inner (t m')-  , HasState outertag outer m )-  => (forall m'. HasState innertag inner m' => m' a) -> m a-zoom m = coerce @(t m a) m+  , HasState innertag inner (t m)+  , All cs m )+  => (forall m'. All (HasState innertag inner ': cs) m' => m' a) -> m a+zoom =+  derive @t @'[HasState innertag inner] @cs {-# INLINE zoom #-}

@@ -30,7 +30,9 @@ import Capability.Accessors import Capability.Reader.Internal.Class import Capability.State.Internal.Class-import Control.Lens (set, view)+import Capability.State.Internal.Strategies.Common+import Capability.Source.Internal.Strategies ()+import Capability.Sink.Internal.Strategies () import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Primitive (PrimMonad) import qualified Control.Monad.State.Class as State@@ -42,16 +44,7 @@ import Data.Mutable import GHC.Exts (Proxy#) --- | Derive 'HasState' from @m@'s--- 'Control.Monad.State.Class.MonadState' instance.-newtype MonadState (m :: * -> *) (a :: *) = MonadState (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)- instance State.MonadState s m => HasState tag s (MonadState m) where-  get_ _ = coerce @(m s) State.get-  {-# INLINE get_ #-}-  put_ _ = coerce @(s -> m ()) State.put-  {-# INLINE put_ #-}   state_ :: forall a. Proxy# tag -> (s -> (a, s)) -> MonadState m a   state_ _ = coerce @((s -> (a, s)) -> m a) State.state   {-# INLINE state_ #-}@@ -62,20 +55,12 @@   , forall x y. Coercible x y => Coercible (m x) (m y) )   => HasState tag to (Coerce to m)   where-    get_ tag = coerce @(m from) $ get_ tag-    {-# INLINE get_ #-}-    put_ tag = coerce @(from -> m ()) $ put_ tag-    {-# INLINE put_ #-}     state_ :: forall a. Proxy# tag -> (to -> (a, to)) -> Coerce to m a     state_ tag = coerce @((from -> (a, from)) -> m a) $ state_ tag     {-# INLINE state_ #-}  -- | Rename the tag. instance HasState oldtag s m => HasState newtag s (Rename oldtag m) where-  get_ _ = coerce @(m s) $ get @oldtag-  {-# INLINE get_ #-}-  put_ _ = coerce @(s -> m ()) $ put @oldtag-  {-# INLINE put_ #-}   state_ :: forall a. Proxy# newtag -> (s -> (a, s)) -> Rename oldtag m a   state_ _ = coerce @((s -> (a, s)) -> m a) $ state @oldtag   {-# INLINE state_ #-}@@ -88,12 +73,6 @@   ( tag ~ field, Generic.HasField' field record v, HasState oldtag record m )   => HasState tag v (Field field oldtag m)   where-    get_ _ = coerce @(m v) $-      gets @oldtag $ view (Generic.field' @field)-    {-# INLINE get_ #-}-    put_ _ = coerce @(v -> m ()) $-      modify @oldtag . set (Generic.field' @field @record)-    {-# INLINE put_ #-}     state_ :: forall a.       Proxy# tag       -> (v -> (a, v))@@ -110,12 +89,6 @@   ( tag ~ pos, Generic.HasPosition' pos struct v, HasState oldtag struct m )   => HasState tag v (Pos pos oldtag m)   where-    get_ _ = coerce @(m v) $-      gets @oldtag $ view (Generic.position' @pos)-    {-# INLINE get_ #-}-    put_ _ = coerce @(v -> m ()) $-      modify @oldtag . set (Generic.position' @pos @struct)-    {-# INLINE put_ #-}     state_ :: forall a.       Proxy# tag       -> (v -> (a, v))@@ -128,10 +101,6 @@ instance (HasState tag s m, MonadTrans t, Monad (t m))   => HasState tag s (Lift (t m))   where-    get_ _ = coerce $ lift @t @m $ get @tag @s-    {-# INLINE get_ #-}-    put_ _ = coerce $ lift @t @m . put @tag @s-    {-# INLINE put_ #-}     state_ :: forall a. Proxy# tag -> (s -> (a, s)) -> Lift (t m) a     state_ _ = coerce $ lift @t @m . state @tag @s @m @a     {-# INLINE state_ #-}@@ -143,31 +112,10 @@   , Monad m, HasState tag s (t2 (t1 m)) )   => HasState tag s ((t2 :.: t1) m) --- | Derive a state monad from a reader over an 'Data.IORef.IORef'.------ Example:------ > newtype MyState m a = MyState (ReaderT (IORef Int) m a)--- >   deriving (Functor, Applicative, Monad)--- >   deriving HasState "foo" Int via--- >     ReaderIORef (MonadReader (ReaderT (IORef Int) m))------ See 'ReaderRef' for a more generic strategy.-newtype ReaderIORef m a = ReaderIORef (m a)-  deriving (Functor, Applicative, Monad)- instance   (HasReader tag (IORef s) m, MonadIO m)   => HasState tag s (ReaderIORef m)   where-    get_ _ = ReaderIORef $ do-      ref <- ask @tag-      liftIO $ readIORef ref-    {-# INLINE get_ #-}-    put_ _ v = ReaderIORef $ do-      ref <- ask @tag-      liftIO $ writeIORef ref v-    {-# INLINE put_ #-}     state_ _ f = ReaderIORef $ do       ref <- ask @tag       liftIO $ atomicModifyIORef' ref (swap . f)@@ -175,38 +123,11 @@         swap (a, b) = (b, a)     {-# INLINE state_ #-} --- | Derive a state monad from a reader over a mutable reference.------ Mutable references are available in a 'Control.Monad.Primitive.PrimMonad'.--- The corresponding 'Control.Monad.Primitive.PrimState' has to match the--- 'Data.Mutable.MCState' of the reference. This constraint makes a stand-alone--- deriving clause necessary.------ Example:------ > newtype MyState m a = MyState (ReaderT (IORef Int) m a)--- >   deriving (Functor, Applicative, Monad)--- > deriving via ReaderRef (MonadReader (ReaderT (IORef Int) m))--- >   instance (PrimMonad m, PrimState m ~ PrimState IO)--- >   => HasState "foo" Int (MyState m)------ See 'ReaderIORef' for a specialized version over 'Data.IORef.IORef'.-newtype ReaderRef m (a :: *) = ReaderRef (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)- instance   ( MutableRef ref, RefElement ref ~ s   , HasReader tag ref m, PrimMonad m, PrimState m ~ MCState ref )   => HasState tag s (ReaderRef m)   where-    get_ _ = ReaderRef $ do-      ref <- ask @tag-      readRef ref-    {-# INLINE get_ #-}-    put_ _ v = ReaderRef $ do-      ref <- ask @tag-      writeRef ref v-    {-# INLINE put_ #-}     state_ _ f = ReaderRef $ do       ref <- ask @tag       s <- readRef ref

@@ -0,0 +1,70 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.State.Internal.Strategies.Common+  ( MonadState(..)+  , ReaderIORef(..)+  , ReaderRef(..)+  ) where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Primitive (PrimMonad)++-- | Derive 'HasState' from @m@'s+-- 'Control.Monad.State.Class.MonadState' instance.+newtype MonadState (m :: * -> *) (a :: *) = MonadState (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Derive a state monad from a reader over an 'Data.IORef.IORef'.+--+-- Example:+--+-- > newtype MyState m a = MyState (ReaderT (IORef Int) m a)+-- >   deriving (Functor, Applicative, Monad)+-- >   deriving HasState "foo" Int via+-- >     ReaderIORef (MonadReader (ReaderT (IORef Int) m))+--+-- See 'ReaderRef' for a more generic strategy.+newtype ReaderIORef m a = ReaderIORef (m a)+  deriving (Functor, Applicative, Monad)++-- | Derive a state monad from a reader over a mutable reference.+--+-- Mutable references are available in a 'Control.Monad.Primitive.PrimMonad'.+-- The corresponding 'Control.Monad.Primitive.PrimState' has to match the+-- 'Data.Mutable.MCState' of the reference. This constraint makes a stand-alone+-- deriving clause necessary.+--+-- Example:+--+-- > newtype MyState m a = MyState (ReaderT (IORef Int) m a)+-- >   deriving (Functor, Applicative, Monad)+-- > deriving via ReaderRef (MonadReader (ReaderT (IORef Int) m))+-- >   instance (PrimMonad m, PrimState m ~ PrimState IO)+-- >   => HasState "foo" Int (MyState m)+--+-- See 'ReaderIORef' for a specialized version over 'Data.IORef.IORef'.+newtype ReaderRef m (a :: *) = ReaderRef (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)

@@ -1,140 +1,33 @@--- | Defines a capability for computations that produce a stream of values--- as part of their execution.------ Programs producing streams of data are common. Examples: emitting events on--- input, or emitting events whenever certain conditions are observed. Streams--- are similar to Python generators.------ The 'HasStream' capability enables separating the logic responsible for--- emitting events from that responsible for collecting or handling them.------ This can be thought of as a writer capability of a list of values @HasWriter--- tag [v]@ with @\\x -> tell \@tag [x]@ as a primitive operation. However, that--- implementation would be inefficient.------ For example using the 'Streaming.Prelude.Stream' instance, a producer defined--- using this capability can be consumed efficiently in a streaming fashion.--{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE QuantifiedConstraints #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}--module Capability.Stream+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PolyKinds #-}+module Capability.Stream {-# DEPRECATED "Use 'Capability.Sink' "#-}   ( -- * Interface-    HasStream(..)+    HasStream+  , HasStream'   , yield     -- * Strategies-  , StreamStack(..)-  , StreamDList(..)-  , StreamLog(..)+  , StreamStack+  , StreamDList+  , StreamLog     -- ** Modifiers   , module Capability.Accessors   ) where  import Capability.Accessors-import Capability.State-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Primitive (PrimMonad)-import Control.Monad.Trans.Class (MonadTrans, lift)-import Data.Coerce (Coercible, coerce)-import Data.DList (DList)-import qualified Data.DList as DList-import GHC.Exts (Proxy#, proxy#)-import Streaming-import qualified Streaming.Prelude as S --- | Streaming capability.------ An instance does not need to fulfill any additional laws--- besides the monad laws.-class Monad m-  => HasStream (tag :: k) (a :: *) (m :: * -> *) | tag m -> a-  where-    -- | For technical reasons, this method needs an extra proxy argument.-    -- You only need it if you are defining new instances of 'HasReader'.-    -- Otherwise, you will want to use 'yield'.-    -- See 'yield' for more documentation.-    yield_ :: Proxy# tag -> a -> m ()---- | @yield \@tag a@--- emits @a@ in the stream capability @tag@.-yield :: forall tag a m. HasStream tag a m => a -> m ()-yield = yield_ (proxy# @_ @tag)-{-# INLINE yield #-}---- | Accumulate streamed values in a reverse order list.-newtype StreamStack m (a :: *) = StreamStack (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)-instance HasState tag [a] m => HasStream tag a (StreamStack m) where-  yield_ _ a = coerce @(m ()) $ modify' @tag (a:)-  {-# INLINE yield_ #-}+import Capability.Sink --- | Accumulate streamed values in forward order in a difference list.-newtype StreamDList m (a :: *) = StreamDList (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)--- | This instance may seem a bit odd at first. All it does is wrap each--- 'yield'ed value in a single element difference list. How does re-yielding--- something else constitute a strategy for implementing 'HasStream' in the--- first place? The answer is that difference lists form a monoid, which allows--- a second stragegy to be used which accumulates all 'yield's in a single--- value, actually eliminating the 'HasStream' constraint this time.------ 'StreamLog' below in fact does this, so the easiest way to fully eliminate--- the 'HasStream' constraint as described above is:------ > deriving (HasStream tag w) via--- >   StreamDList (StreamLog (MonadState SomeStateMonad))-instance HasStream tag (DList a) m => HasStream tag a (StreamDList m) where-  yield_ _ = coerce @(a -> m ()) $ yield @tag . DList.singleton-  {-# INLINE yield_ #-}+{-# DEPRECATED HasStream "Use 'HasSink'" #-}+type HasStream = HasSink --- | Accumulate streamed values with their own monoid.-newtype StreamLog m (a :: *) = StreamLog (m a)-  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)-instance (Monoid w, HasState tag w m) => HasStream tag w (StreamLog m) where-    yield_ _ w = coerce @(m ()) $ modify' @tag (<> w)-    {-# INLINE yield_ #-}+{-# DEPRECATED StreamStack "Use 'SinkStack'" #-}+type StreamStack = SinkStack -instance Monad m => HasStream tag a (S.Stream (Of a) m) where-  yield_ _ = S.yield-  {-# INLINE yield_ #-}+{-# DEPRECATED StreamDList "Use 'SinkDList'" #-}+type StreamDList = SinkDList --- | Lift one layer in a monad transformer stack.------ Note, that if the 'HasStream' instance is based on 'HasState', then it is--- more efficient to apply 'Lift' to the underlying state capability. E.g.--- you should favour------ > deriving (HasStream tag w) via--- >   StreamLog (Lift (SomeTrans (MonadState SomeStateMonad)))------ over------ > deriving (HasStream tag w) via--- >   Lift (SomeTrans (StreamLog (MonadState SomeStateMonad)))-instance (HasStream tag a m, MonadTrans t, Monad (t m))-  => HasStream tag a (Lift (t m))-  where-    yield_ _ = coerce @(a -> t m ()) $ lift . yield @tag-    {-# INLINE yield_ #-}+{-# DEPRECATED StreamLog "Use 'SinkLog'" #-}+type StreamLog = SinkLog --- | Compose two accessors.-deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))-  instance-  ( forall x. Coercible (m x) (t2 (t1 m) x)-  , Monad m, HasStream tag a (t2 (t1 m)) )-  => HasStream tag a ((t2 :.: t1) m)+{-# DEPRECATED HasStream' "Use 'HasSink''" #-}+type HasStream' tag = HasSink' tag

@@ -0,0 +1,36 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}++module Capability.TypeOf where++-- | Type family associating a tag to the corresponding type. It is intended to+-- simplify constraint declarations, by removing the need to redundantly specify+-- the type associated to a tag.+--+-- It is poly-kinded, which allows users to define their own kind of tags.+-- Standard haskell types can also be used as tags by specifying the '*' kind+-- when defining the type family instance.+--+-- Defining 'TypeOf' instances for 'GHC.TypeLits.Symbol's (typelevel string+-- literals) is discouraged. Since symbols all belong to the same global+-- namespace, such instances could conflict with others defined in external+-- libraries. More generally, as for typeclasses, 'TypeOf' instances should+-- always be defined in the same module as the tag type to prevent issues due to+-- orphan instances.+--+-- Example:+--+-- @+--     import Capability.Reader+--+--     data Foo+--     data Bar+--     type instance TypeOf * Foo = Int+--     type instance TypeOf * Bar = String+--+--     -- Same as: foo :: HasReader Foo Int M => …+--     foo :: HasReader' Foo m => …+--     foo = …+-- @+type family TypeOf k (s :: k) :: *

@@ -17,6 +17,7 @@ -- and does not misuse the underlying state monad.  {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-}@@ -36,24 +37,30 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints -Wno-deprecations #-}  module Capability.Writer-  ( -- * Interface+  ( -- * Relational capability     HasWriter(..)   , writer   , tell   , listen   , pass+  -- * Functional capability+  , HasWriter'+  , TypeOf     -- * Strategies   , WriterLog-  , StreamLog (..)+  , StreamLog+  , SinkLog (..)     -- ** Modifiers   , module Capability.Accessors   ) where  import Capability.Accessors+import Capability.Sink import Capability.State+-- import deprecated module to reexport deprecated item for back-compat. import Capability.Stream import Data.Coerce (Coercible, coerce) import GHC.Exts (Proxy#, proxy#)@@ -70,21 +77,21 @@ -- prop> pass @t (tell @t w >> pure (a, f)) = tell @t (f w) >> pure a -- prop> writer @t (a, w) = tell @t w >> pure a ----- = A note on the 'HasStream' super class.+-- = A note on the 'HasSink' super class. ----- 'HasStream' offers one 'yield' method with the same signature as 'tell'.+-- 'HasSink' offers one 'yield' method with the same signature as 'tell'. -- Many people's intuition, however, wouldn't connect the two: 'yield'ing -- tosses the value down some black-box chute, while 'tell'ing grows and -- accumulation via the monoid. The connection is since the 'chute' is opaque, -- the tosser cannot rule out there being such an accumulation at the chutes -- other end. ----- Formally, we reach the same conclusion. 'HasStream' has no laws,+-- Formally, we reach the same conclusion. 'HasSink' has no laws, -- indicating the user can make no assumptions beyond the signature of 'yield'. -- 'HasWriter', with 'tell' defined as 'yield', is thus always compatable -- regardless of whatever additional methods it provides and laws by which it -- abides.-class (Monoid w, Monad m, HasStream tag w m)+class (Monoid w, Monad m, HasSink tag w m)   => HasWriter (tag :: k) (w :: *) (m :: * -> *) | tag m -> w   where     -- | For technical reasons, this method needs an extra proxy argument.@@ -110,7 +117,7 @@ -- Appends @w@ to the output of the writer capability @tag@ -- and returns the value @a@. writer :: forall tag w m a. HasWriter tag w m => (a, w) -> m a-writer = writer_ (proxy# @_ @tag)+writer = writer @tag {-# INLINE writer #-}  -- | @tell \@tag w@@@ -142,7 +149,7 @@   , Monad m, HasWriter tag w (t2 (t1 m)) )   => HasWriter tag w ((t2 :.: t1) m) -type WriterLog = StreamLog+type WriterLog = SinkLog  instance (Monoid w, HasState tag w m)   => HasWriter tag w (WriterLog m)@@ -167,3 +174,7 @@       put @tag $! w0 <> f w       pure a     {-# INLINE pass_ #-}++-- | Type synonym using the 'TypeOf' type family to specify 'HasWriter'+-- constraints without having to specify the type associated to a tag.+type HasWriter' (tag :: k) = HasWriter tag (TypeOf k tag)