capability (empty) → 0.1.0.0

raw patch · 27 files changed

+3038/−0 lines, 27 filesdep +basedep +capabilitydep +containerssetup-changed

Dependencies added: base, capability, containers, dlist, exceptions, generic-lens, hspec, hspec-jenkins, lens, monad-control, monad-unlift, mtl, mutable-containers, primitive, safe-exceptions, silently, streaming, temporary, text, transformers, unliftio, unliftio-core

Files

• CONTRIBUTING.md +44/−0
• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +163/−0
• Setup.hs +2/−0
• capability.cabal +94/−0
• examples/CountLog.hs +184/−0
• examples/Error.hs +153/−0
• examples/Reader.hs +107/−0
• examples/State.hs +126/−0
• examples/Stream.hs +92/−0
• examples/Test.hs +40/−0
• examples/Test/Common.hs +45/−0
• examples/WordCount.hs +155/−0
• examples/Writer.hs +87/−0
• src/Capability.hs +90/−0
• src/Capability/Accessors.hs +161/−0
• src/Capability/Error.hs +423/−0
• src/Capability/Reader.hs +18/−0
• src/Capability/Reader/Internal/Class.hs +104/−0
• src/Capability/Reader/Internal/Strategies.hs +224/−0
• src/Capability/State.hs +22/−0
• src/Capability/State/Internal/Class.hs +125/−0
• src/Capability/State/Internal/Strategies.hs +216/−0
• src/Capability/Stream.hs +109/−0
• src/Capability/Writer.hs +162/−0
• src/Capability/Writer/Discouraged.hs +57/−0

@@ -0,0 +1,44 @@+# Contributor's guide++## Bug Reports++Please [open an issue][new-issue].++The more detailed your report, the faster it can be resolved. Once the+bug has been resolved, the person responsible will tag the issue as+_needs confirmation_ and assign the issue back to you. Once you have+tested and confirmed that the issue is resolved, close the issue. If+you are not a member of the project, you will be asked for+confirmation and we will close it.++[new-issue]: https://github.com/tweag/capability/issues/new++## Code++1. Explain your idea and discuss your plan with members of the team.+   The best way to do this is to create an [issue][issue-tracker] or+   comment on an existing issue.+1. Prepare a git commit with your change. Don't forget to+   add [tests][tests]. Update [README.md](./README.md) if appropriate.+1. [Create a pull request][create-pull-request]. This will start the+   code review process. Enable "Allow edits from maintainers" if the+   branch is on a fork, so that reviewers can fix trivial problems+   (typos) directly. **All submissions, including submissions by+   project members, require review.**+1. You may be asked to make some changes. Continuous integration bots+   will test your change automatically on supported platforms. Once+   everything looks good, your change will be merged. The minimum+   criteria for acceptance are:++   * a patch should be a minimal and accurate answer to exactly one+     identified and agreed problem,+   * a patch that modifies a stable public API should not break existing+     applications unless there is overriding consensus on the value of+     doing this.+   * A patch must adhere to the [code style guidelines][style-guide]+     of the project.++[issue-tracker]: https://github.com/tweag/capability/issues+[tests]: ./examples+[create-pull-request]: https://help.github.com/articles/creating-a-pull-request/+[style-guide]: https://github.com/tweag/guides/blob/master/style/

@@ -0,0 +1,5 @@+# Revision history for capability++## 0.1.0.0 -- 2018-10-04++* Initial release.

@@ -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.

@@ -0,0 +1,163 @@+# capability: effects, extensionally++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+implementation. What this means in practice:++- You can implement large sets of capabilities using the+  efficient [`ReaderT` pattern][readert], rather than a slow monad+  transformer stack.+- Capabilities compose well: e.g. it's easy to have multiple reader+  effects.+- You can use a writer effect without implementing it as a writer+  monad (which is known to [leak space][writer-space-leak]).+- You can reason about effects. For instance, if a monad provides a+ reader effect at type `IORef A`, it also provides a state effect at type `A`++For more on these, you may want to read the announcement [blog+ post][blog].++This library is an alternative to the [`mtl`][mtl]. It defines a set+of standard, reusable capability type classes, such as the `HasReader`+and `HasState` type classes, which provide the standard reader and+state effects, respectively.++Where `mtl` instances only need to be defined once and for all,+capability-style programming has traditionally suffered from verbose+boilerplate: rote instance definitions for every new implementation of+the capability. Fortunately GHC 8.6 introduced+the [`DerivingVia`][deriving-via] language extension. We use it to+remove the boilerplate, turning capability-style programming into an+appealing alternative to `mtl`-style programming. The+[`generic-lens`][generic-lens] library is used to access fields of+structure in the style of the [`ReaderT` pattern][readert].++An additional benefit of separating capabilities from their+implementation is that they avoid a pitfall of the `mtl`. In the+`mtl`, two different `MonadState` are disambiguated by their types,+which means that it is difficult to have two `MonadState Int` in the+same monad stack. Capability type classes are parameterized by a name+(also known as a *tag*). This makes it possible to combine multiple+versions of the same capability. For example,++```haskell+twoStates :: (HasState "a" Int m, HasState "b" Int m) => m ()+```++Here, the tags `"a"` and `"b"` refer to different state spaces.++In summary, compared to the `mtl`:++- capabilities represent what effects a function can use, rather than+  how the monad is constructed;+- capabilities are named, rather than disambiguated by type;+- capabilites are discharged with deriving-via combinators+  and [`generic-lens`][generic-lens], rather than with instance+  resolution.++An example usage looks like this:++``` haskell+testParity :: (HasReader "foo" Int m, HasState "bar" Bool m) => m ()+testParity = do+  num <- ask @"foo"+  put @"bar" (even num)++data Ctx = Ctx { foo :: Int, bar :: IORef Bool }+  deriving Generic++newtype M a = M { runM :: Ctx -> IO a }+  deriving (Functor, Applicative, Monad) via ReaderT Ctx IO+  -- Use DerivingVia to derive a HasReader instance.+  deriving (HasReader "foo" Int) via+    -- Pick the field foo from the Ctx record in the ReaderT environment.+    Field "foo" "ctx" (MonadReader (ReaderT Ctx IO))+  -- Use DerivingVia to derive a HasState instance.+  deriving (HasState "bar" Bool) via+    -- Convert a reader of IORef to a state capability.+    ReaderIORef (Field "bar" "ctx" (MonadReader (ReaderT Ctx IO)))++example :: IO ()+example = do+    rEven <- newIORef False+    runM testParity (Ctx 2 rEven)+    readIORef rEven >>= print+    runM testParity (Ctx 3 rEven)+    readIORef rEven >>= print+```++For more complex examples, see the [Examples section](#examples) and+the [`examples` subtree](./examples).++This package is not available on Hackage yet, as some of its+dependencies have not been updated to GHC 8.6, yet.++API documentation can be found in the artifacts tab of any successful+build in the [CircleCI project][circleci].++[circleci]: https://circleci.com/gh/tweag/capabilities-via/tree/master+[mtl]: http://hackage.haskell.org/package/mtl+[blog]: https://www.tweag.io/posts/2018-10-04-capability.html+[deriving-via]: https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/glasgow_exts.html#deriving-via+[generic-lens]: https://hackage.haskell.org/package/generic-lens+[readert]: https://www.fpcomplete.com/blog/2017/06/readert-design-pattern+[writer-space-leak]: https://blog.infinitenegativeutility.com/2016/7/writer-monads-and-space-leaks++## Examples++An example is provided in [`WordCount`](examples/WordCount.hs).+Execute the following commands to try it out:++```+$ nix-shell --pure --run "cabal configure --enable-tests"+$ nix-shell --pure --run "cabal repl examples"++ghci> :set -XOverloadedStrings+ghci> wordAndLetterCount "ab ba"+Letters+'a': 2+'b': 2+Words+"ab": 1+"ba": 1+```++To execute all examples and see if they produce the expected results run++```+$ nix-shell --pure --run "cabal test examples --show-details=streaming --test-option=--color"+```++## Build instructions++### Nix Shell++Some of this package's dependencies require patches to build with GHC 8.6.+These patches are defined in+[`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++The build instructions assume that you have [Nix][nix] installed.+Execute the following command to build the library.++```+$ nix-shell --pure --run "cabal configure"+$ nix-shell --pure --run "cabal build"+```++[nix]: https://nixos.org/nix/

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,94 @@+name: capability+version: 0.1.0.0+homepage: https://github.com/tweag/capability+license: BSD3+license-file: LICENSE+maintainer: andreas.herrmann@tweag.io+copyright: 2018 EURL Tweag+category: Control+build-type: Simple+extra-source-files:+  ChangeLog.md+  CONTRIBUTING.md+  README.md+cabal-version: 1.18+tested-with: GHC==8.6.1+synopsis: Extensional capabilities and deriving combinators+description:+  Standard capability type classes for extensional effects and combinators+  to derive capability instances with little boilerplate.++source-repository head+  type: git+  location: https://github.com/tweag/capability++flag hspec-jenkins+  description:+    You can enable the use of the `hspec-jenkins` package using `-fhspec-jenkins`.+    .+    This package allows JUnit formatted test reporting for CI.+  default: False++library+  exposed-modules:+    Capability+    Capability.Accessors+    Capability.Error+    Capability.Reader+    Capability.Reader.Internal.Class+    Capability.Reader.Internal.Strategies+    Capability.State+    Capability.State.Internal.Class+    Capability.State.Internal.Strategies+    Capability.Stream+    Capability.Writer+    Capability.Writer.Discouraged+  build-depends:+      base >= 4.12 && < 5.0+    , dlist >= 0.8 && < 0.9+    , exceptions >= 0.6 && < 0.11+    , generic-lens >= 1.0 && < 1.1+    , 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+    , 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+  hs-source-dirs: src+  default-language: Haskell2010++test-suite examples+  type: exitcode-stdio-1.0+  other-modules:+    WordCount+    CountLog+    Error+    Reader+    State+    Stream+    Test.Common+    Writer+  main-is: Test.hs+  build-depends:+      base >= 4.12 && < 5.0+    , capability+    , containers >= 0.6 && < 0.7+    , hspec >= 2.0 && < 3.0+    , lens >= 4.16 && < 5.0+    , mtl >= 2.0 && < 3.0+    , silently >= 1.2 && < 1.3+    , streaming >= 0.2 && < 0.3+    , temporary >= 1.0 && < 1.4+    , text >= 0.2 && < 1.3+    , unliftio >= 0.2 && < 0.3+  if flag(hspec-jenkins)+    build-depends: hspec-jenkins+  ghc-options: -Wall+  hs-source-dirs: examples+  default-language: Haskell2010

@@ -0,0 +1,184 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Demonstrates how to derive user-defined capabilities using this library.+module CountLog where++import Capability.Reader+import Capability.State+import Control.Monad.IO.Class+import Control.Monad.Reader (ReaderT (..), runReaderT)+-- The @StateT@ constructor has to be imported even though it is not used+-- explicitly. Otherwise, the deriving via of @Counter CounterM@ would fail.+import Control.Monad.State.Strict (State, StateT (..), runState)+import qualified Data.Char+import Data.Coerce (coerce)+import Data.IORef+import GHC.Generics (Generic)+import Test.Common+import Test.Hspec+++----------------------------------------------------------------------+-- Logger Capability+++class Monad m => Logger m where+  logStr :: String -> m ()++-- | Any @HasReader "logger" (String -> IO ())@ can be a @Logger@.+newtype TheLoggerReader m a = TheLoggerReader (m a)+  deriving (Functor, Applicative, Monad)+instance+  (HasReader "logger" (String -> IO ()) m, MonadIO m)+  => Logger (TheLoggerReader m)+  where+    logStr msg =+      coerce (ask @"logger" >>= liftIO . ($ msg) :: m ())++-- Example program ---------------------------------------------------++-- | Log the given number.+logNum :: Logger m => Int -> m ()+logNum = logStr . ("num: " ++) . show++-- ReaderT instance --------------------------------------------------++data LogCtx = LogCtx { logger :: String -> IO () }+  deriving Generic++regularLogger :: LogCtx+regularLogger = LogCtx { logger = putStrLn }++loudLogger :: LogCtx+loudLogger = LogCtx { logger = putStrLn . map Data.Char.toUpper }+++-- | Deriving @HasReader@ from @MonadReader@.+newtype LogM m (a :: *) = LogM (ReaderT LogCtx m a)+  deriving (Functor, Applicative, Monad)+  deriving Logger via+    (TheLoggerReader (Field "logger" ()+    (MonadReader (ReaderT LogCtx m))))++runLogM :: LogCtx -> LogM m a -> m a+runLogM ctx (LogM m) = runReaderT m ctx+++----------------------------------------------------------------------+-- Counter Capability+++class Monad m => Counter m where+  count :: m Int++-- | Any @HasState "counter" Int m@ can be a @Counter@.+newtype TheCounterState m a = TheCounterState (m a)+  deriving (Functor, Applicative, Monad)+instance+  (HasState "counter" Int m, Monad m)+  => Counter (TheCounterState m)+  where+    count = coerce @(m Int) $+      state @"counter" $ \n -> let !n' = n + 1 in (n', n')++-- Example program ---------------------------------------------------++-- | Use a counter to count up twice.+doubleCount :: Counter m => m Int+doubleCount = count >> count++-- StateT instance ---------------------------------------------------++-- | Deriving @HasState@ from @MonadState@.+newtype CounterM a = CounterM (State Int a)+  deriving (Functor, Applicative, Monad)+  deriving Counter via+    TheCounterState (MonadState (State Int))++runCounterM :: CounterM a -> (a, Int)+runCounterM (CounterM m) = runState m 0++-- ReaderT IORef instance --------------------------------------------++-- | Deriving @HasState@ from @HasReader@ of an @IORef@.+newtype Counter'M m (a :: *) = Counter'M (ReaderT (IORef Int) m a)+  deriving (Functor, Applicative, Monad)+  deriving Counter via+    TheCounterState (ReaderIORef (MonadReader (ReaderT (IORef Int) m)))++runCounter'M :: MonadIO m => Counter'M m a -> m a+runCounter'M (Counter'M m) = runReaderT m =<< liftIO (newIORef 0)+++----------------------------------------------------------------------+-- Mixed Capabilities++-- Example program ---------------------------------------------------++-- | Double count and log the result, repeat once.+mixed :: (Counter m, Logger m) => m ()+mixed = do+  doubleCount >>= logNum+  doubleCount >>= logNum++-- ReaderT instance --------------------------------------------------++data CountLogCtx = CountLogCtx+  { countCtx :: IORef Int+  , logCtx :: LogCtx+  } deriving Generic+++-- | Deriving two capabilities from the record fields of @MonadReader@.+newtype CountLogM m (a :: *) = CountLogM (ReaderT CountLogCtx m a)+  deriving (Functor, Applicative, Monad)+  deriving Counter via+    TheCounterState (ReaderIORef (Rename "countCtx" (Field "countCtx" ()+    (MonadReader (ReaderT CountLogCtx m)))))+  deriving Logger via+    (TheLoggerReader (Field "logger" "logCtx" (Field "logCtx" ()+    (MonadReader (ReaderT CountLogCtx m)))))++runCountLogM :: MonadIO m => CountLogM m b -> m b+runCountLogM (CountLogM m) = do+  ref <- liftIO $ newIORef 0+  runReaderT m CountLogCtx+    { countCtx = ref+    , logCtx = regularLogger+    }+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "LogM" $ do+    context "regularLogger" $+      it "evaluates logNum" $+        runLogM regularLogger (logNum 8) `shouldPrint` "num: 8\n"+    context "loudLogger" $+      it "evaluates logNum" $+        runLogM loudLogger (logNum 8) `shouldPrint` "NUM: 8\n"+  describe "CounterM" $+    it "evaluates doubleCount" $+      runCounterM doubleCount `shouldBe` (2, 2)+  describe "Counter'M" $+    it "evaluates doubleCount" $+      runCounter'M doubleCount `shouldReturn` 2+  describe "CountLogM" $ do+    it "evaluates logNum" $+      runCountLogM (logNum 8) `shouldPrint` "num: 8\n"+    it "evaluates doubleCount" $+      runCountLogM doubleCount `shouldReturn` 2+    it "evaluates mixed" $+      runCountLogM mixed `shouldPrint` "num: 2\nnum: 4\n"

@@ -0,0 +1,153 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Example uses and instances of the @HasError@ capability.+module Error where++import Capability.Error+import Control.Monad (when)+import Control.Monad.Except (ExceptT (..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import GHC.Generics (Generic)+import Test.Common+import Test.Hspec+import Text.Read (readEither)++----------------------------------------------------------------------+-- Example Programs++-- Calculator Example ------------------------------------------------++data ParserError+  = InvalidInput String+  deriving (Show, Typeable)+  deriving anyclass Exception++parseNumber :: HasThrow "parser" ParserError m+  => String -> m Int+parseNumber input = case readEither input of+  Left err -> throw @"parser" $ InvalidInput err+  Right num -> pure num+++data MathError+  = NegativeInput+  deriving (Show, Typeable)+  deriving anyclass Exception++sqrtNumber :: HasThrow "math" MathError m+  => Int -> m Int+sqrtNumber num+  | num < 0 = throw @"math" NegativeInput+  | otherwise = pure $ round $ sqrt @Double $ fromIntegral num+++-- | Errors that can occur in the calculator application.+data CalcError+    -- | The parser component failed.+  = ParserError ParserError+    -- | The math component failed.+  | MathError MathError+  deriving (Generic, Show, Typeable)+  deriving anyclass Exception++-- | Calculator application+--+-- Prompts for positive numbers and prints their square roots.+calculator ::+  ( HasCatch "calc" CalcError m, MonadIO m )+  => m ()+calculator = do+  liftIO $ putStr "Enter positive number or 'Q' to quit\n> "+  line <- liftIO getLine+  case line of+    "Q" -> pure ()+    input -> do+      catch @"calc"+        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")+          num <- wrapParserError $ parseNumber input+          root <- wrapMathError $ sqrtNumber num+          liftIO $ putStrLn $ "sqrt = " ++ show root+        \e -> liftIO $ putStrLn $ "Error: " ++ show e+      calculator+++-- Nested Example ----------------------------------------------------++nested :: (HasThrow "foo" String m, HasThrow "bar" () m) => Int -> m Int+nested n = do+  when (n < 0) $+    throw @"foo" "negative number"+  when (odd n) $+    throw @"bar" ()+  pure n+++----------------------------------------------------------------------+-- Instances++-- | Deriving @HasThrow/HasCatch@ from @unliftio@.+newtype Calculator a = Calculator { runCalculator :: IO a }+  deriving newtype (Functor, Applicative, Monad, MonadIO)+  deriving+    ( HasThrow "calc" CalcError+    , HasCatch "calc" CalcError+    ) via MonadUnliftIO CalcError IO+++-- | Deriving separate @HasThrow@ capabilities from different transformer+-- layers.+newtype MaybeEither a =+  MaybeEither { runMaybeEither :: Maybe (Either String a) }+  deriving (Functor, Applicative, Monad) via+    ExceptT String Maybe+  deriving (HasThrow "foo" String) via+    MonadError (ExceptT String Maybe)+  deriving (HasThrow "bar" ()) via+    Lift (ExceptT String (MonadError Maybe))+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "Calculator" $+    it "evaluates calculator" $ do+      let input = "4\n-1\nxyz\nQ\n"+          output =+            "Enter positive number or 'Q' to quit\n\+            \> sqrt = 2\n\+            \Enter positive number or 'Q' to quit\n\+            \> Error: MathError NegativeInput\n\+            \Enter positive number or 'Q' to quit\n\+            \> Error: ParserError (InvalidInput \"Prelude.read: no parse\")\n\+            \Enter positive number or 'Q' to quit\n\+            \> "+      runCalculator calculator+        `withInput` input+        `shouldPrint` output+  describe "MaybeEither" $+    it "evaluates nested" $ do+      runMaybeEither (nested 2) `shouldBe` Just (Right 2)+      runMaybeEither (nested (-1)) `shouldBe` Just (Left "negative number")+      runMaybeEither (nested 1) `shouldBe` Nothing

@@ -0,0 +1,107 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++-- | Example uses and instances of the @HasReader@ capability.+module Reader where++import Capability.Reader+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (ReaderT (..))+import GHC.Generics (Generic)+import Test.Common+import Test.Hspec+++----------------------------------------------------------------------+-- Example Programs++-- | Returns the triple of the number in context "foo".+tripleFoo :: HasReader "foo" Int m => m Int+tripleFoo = do+  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 = do+  liftIO . print =<< 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 ()+fooBarExample = do+  local @"bar" (*2) $ do+    liftIO . print =<< ask @"bar"+    liftIO . print =<< tripleFoo+++----------------------------------------------------------------------+-- Instances++-- | @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)++runFooReaderT :: FooReaderT m a -> m a+runFooReaderT (FooReaderT m) = runReaderT m 1+++data FooBar = FooBar+  { foo :: Int+  , bar :: Int+  } deriving Generic++-- | 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))++runFooBarReader :: FooBarReader a -> IO a+runFooBarReader (FooBarReader m) = runReaderT m FooBar { foo = 1, bar = 2 }+++-- | Multiple @HasReader@ instances on the same underlying @MonadReader@.+--+-- Demonstrates colliding instances.+-- Note, do not do this in practice. The derived @HasReader@ instances interact+-- 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)++runBadFooBarReader :: BadFooBarReader a -> IO a+runBadFooBarReader (BadFooBarReader m) = runReaderT m 1+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "FooReaderT" $+    it "evaluates fooExample" $+      runFooReaderT fooExample `shouldPrint` "3\n6\n"+  describe "FooBarReader" $ do+    it "evaluates fooExample" $+      runFooBarReader fooExample `shouldPrint` "3\n6\n"+    it "evaluates fooBarExample" $+      runFooBarReader fooBarExample `shouldPrint` "4\n3\n"+  describe "BadFooBarReader" $ do+    it "evaluates fooExample" $+      runBadFooBarReader fooExample `shouldPrint` "3\n6\n"+    it "evaluates fooBarExample" $+      runBadFooBarReader fooBarExample `shouldNotPrint` "4\n3\n"

@@ -0,0 +1,126 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}++-- | Example uses and instances of the @HasState@ capability.+module State where++import Capability.Reader+import Capability.State+import Control.Monad.Reader (ReaderT (..))+import Control.Monad.State.Strict (State, StateT (..), runState)+import Data.IORef+import GHC.Generics (Generic)+import Test.Hspec++----------------------------------------------------------------------+-- Example Programs++incFoo :: HasState "foo" Int m => m ()+incFoo = modify @"foo" (+1)++twoStates :: (HasState "foo" Int m, HasState "bar" Int m) => m ()+twoStates = do+  incFoo+  modify @"bar" (subtract 1)+++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+  gets @"foobar" (\(foo, bar) -> foo + bar)+++----------------------------------------------------------------------+-- Instances++data TwoStates = TwoStates+  { tsFoo :: IORef Int+  , tsBar :: IORef Int+  } deriving Generic++-- | Deriving @HasState@ from @HasReader@ of an @IORef@.+--+-- In this case two separate state capabilities are derived from the record+-- fields of the @HasReader@ context.+newtype TwoStatesM a = TwoStatesM (ReaderT TwoStates IO a)+  deriving (Functor, Applicative, Monad)+  deriving (HasState "foo" Int) via+    ReaderIORef (Rename "tsFoo" (Field "tsFoo" ()+    (MonadReader (ReaderT TwoStates IO))))+  deriving (HasState "bar" Int) via+    ReaderIORef (Rename "tsBar" (Field "tsBar" ()+    (MonadReader (ReaderT TwoStates IO))))++runTwoStatesM :: TwoStatesM a -> IO (a, (Int, Int))+runTwoStatesM (TwoStatesM m) = do+  fooRef <- newIORef 0+  barRef <- newIORef 0+  result <- runReaderT m TwoStates+    { tsFoo = fooRef+    , tsBar = barRef+    }+  fooVal <- readIORef fooRef+  barVal <- readIORef barRef+  pure (result, (fooVal, barVal))+++-- | Deriving two @HasState@ instances from the components of a tuple in+-- @MonadState@.+newtype PairStateM a = PairStateM (State (Int, Int) a)+  deriving (Functor, Applicative, Monad)+  deriving (HasState "foo" Int) via+    Rename 1 (Pos 1 () (MonadState (State (Int, Int))))+  deriving (HasState "bar" Int) via+    Rename 2 (Pos 2 () (MonadState (State (Int, Int))))++runPairStateM :: PairStateM a -> (a, (Int, Int))+runPairStateM (PairStateM m) = runState m (0, 0)+++-- | Combining the @HasState@ instances from two nested @StateT@ transformers.+--+-- Note, that this is not the recommended way to provide multiple `HasState`+-- capabilities. Use the approach shown above in 'TwoStatesM' instead. However,+-- 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)))++runNestedStatesM :: NestedStatesM a -> ((a, Int), Int)+runNestedStatesM (NestedStatesM m) = runState (runStateT m 0) 0+++runFooBarState+  :: (forall m. HasState "foobar" (Int, Int) m => m a)+  -> (Int, Int) -> (a, (Int, Int))+runFooBarState (MonadState m) = runState m+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "TwoStatesM" $+    it "evaluates twoStates" $+      runTwoStatesM twoStates `shouldReturn` ((), (1, -1))+  describe "PairStateM" $+    it "evaluates twoStates" $+      runPairStateM twoStates `shouldBe` ((), (1, -1))+  describe "NestedStatesM" $+    it "evaluates twoStates" $+      runNestedStatesM twoStates `shouldBe` (((), 1), -1)+  describe "runFooBarState" $+    it "evaluates useZoom" $+      runFooBarState useZoom (0, 0) `shouldBe` (5, (3, 2))

@@ -0,0 +1,92 @@+{-# 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"

@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++module Main+  ( main+  ) where++import Test.Hspec+import Test.Hspec.Runner++#ifdef MIN_VERSION_hspec_jenkins+import Test.Hspec.Formatters.Jenkins (xmlFormatter)+#endif++import qualified CountLog+import qualified Error+import qualified Reader+import qualified State+import qualified Stream+import qualified Writer+import qualified WordCount+++spec :: Spec+spec = do+  describe "CountLog" CountLog.spec+  describe "Error" Error.spec+  describe "Reader" Reader.spec+  describe "State" State.spec+  describe "Stream" Stream.spec+  describe "Writer" Writer.spec+  describe "WordCount" WordCount.spec+++main :: IO ()+main = do+  let cfg = defaultConfig+#ifdef MIN_VERSION_hspec_jenkins+        { configFormatter = Just xmlFormatter }+#endif+  hspecWith cfg spec

@@ -0,0 +1,45 @@+module Test.Common+  ( shouldPrint+  , shouldNotPrint+  , withInput+  ) where++import GHC.IO.Handle (hDuplicate, hDuplicateTo)+import System.IO+import System.IO.Silently (capture_)+import System.IO.Temp (withSystemTempFile)+import Test.Hspec+import UnliftIO.Exception (bracket)+++shouldPrint :: IO a -> String -> IO ()+shouldPrint action expected = do+  actual <- capture_ action+  actual `shouldBe` expected+++shouldNotPrint :: IO a -> String -> IO ()+shouldNotPrint action expected = do+  actual <- capture_ action+  actual `shouldNotBe` expected+++-- | Execute the given action with @stdin@ redirected to read the given input.+withInput :: IO a -> String -> IO a+withInput action input =+  withSystemTempFile "capability-mock-input" $ \tmpFile tmpOut -> do+    -- write input to temp-file+    hPutStr tmpOut input+    hClose tmpOut+    -- read stdin from temp-file+    buffering <- hGetBuffering stdin+    withFile tmpFile ReadMode $ \tmpIn -> do+      let redirect = do+            old <- hDuplicate stdin+            hDuplicateTo tmpIn stdin+            pure old+          restore old = do+            hDuplicateTo old stdin+            hSetBuffering stdin buffering+            hClose old+      bracket redirect restore (\_ -> action)

@@ -0,0 +1,155 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++module WordCount where++import Capability.Reader+import Capability.State+import Capability.Writer+import Control.Lens (ifor_)+import Data.Coerce (coerce)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Control.Monad.Reader (ReaderT (..))+import Data.IORef+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Monoid (Sum (..))+import GHC.Generics (Generic)+import Test.Common+import Test.Hspec++-- | Accumulating key-value mapping.+--+-- The 'Monoid' instance will 'mappend'+-- values to keys that occur on both sides.+newtype Accum map = Accum map++instance (Ord k, Semigroup v)+  => Semigroup (Accum (Map k v)) where+    (<>) = coerce $ Map.unionWith @k @v (<>)++instance (Ord k, Semigroup v)+  => Monoid (Accum (Map k v)) where+    mempty = coerce $ Map.empty @k @v+    mappend = (<>)+++-- | Counts occurrences of values @k@.+newtype Occurrences k = Occurrences (Map k Int)+  deriving (Monoid, Semigroup) via Accum (Map k (Sum Int))+  deriving Show++-- | A single occurrence of the given value.+oneOccurrence :: k -> Occurrences k+oneOccurrence k = Occurrences $ Map.singleton k 1+++-- | Count the occurrence of a single letter.+countLetter ::+  HasWriter "letterCount" (Occurrences Char) m+  => Char -> m ()+countLetter letter = tell @"letterCount" (oneOccurrence letter)++-- | Count the occurrence of a single word.+countWord ::+  HasWriter "wordCount" (Occurrences Text) m+  => Text -> m ()+countWord word = tell @"wordCount" (oneOccurrence word)+++-- | Count the occurrence of a single word and all the letters in it.+countWordAndLetters ::+  ( HasWriter "letterCount" (Occurrences Char) m+  , HasWriter "wordCount" (Occurrences Text) m )+  => Text -> m ()+countWordAndLetters word = do+  countWord word+  mapM_ countLetter (Text.unpack word)+++-- | Count the occurrences of words and letters in a text,+-- excluding white space.+countWordsAndLettersInText ::+  ( HasWriter "letterCount" (Occurrences Char) m+  , HasWriter "wordCount" (Occurrences Text) m )+  => Text -> m ()+countWordsAndLettersInText text =+  mapM_ countWordAndLetters (Text.words text)+++-- | Counter application context.+data CounterCtx = CounterCtx+  { letterCount :: IORef (Occurrences Char)+    -- ^ Counting letter occurrences.+  , wordCount :: IORef (Occurrences Text)+    -- ^ Counting word occurrences.+  } deriving Generic++-- | Counter application monad.+newtype Counter a = Counter { runCounter :: CounterCtx -> IO a }+  deriving (Functor, Applicative, Monad) via (ReaderT CounterCtx IO)+  deriving (HasWriter "letterCount" (Occurrences Char)) via+    (WriterLog  -- Generate HasWriter 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 (HasWriter "wordCount" (Occurrences Text)) via+    WriterLog (ReaderIORef+    (Field "wordCount" "ctx" (MonadReader (ReaderT CounterCtx IO))))+++-- | Given a text count the occurrences of all words and letters in it,+-- excluding white space, and print the outcome to standard output.+wordAndLetterCount :: Text -> IO ()+wordAndLetterCount text = do+  lettersRef <- newIORef $ Occurrences Map.empty+  wordsRef <- newIORef $ Occurrences Map.empty+  let ctx = CounterCtx+        { letterCount = lettersRef+        , wordCount = wordsRef+        }+      counter :: Counter ()+      counter = countWordsAndLettersInText text+  runCounter counter ctx+  let printOccurrencesOf name ref = do+        putStrLn name+        Occurrences occurrences <- readIORef ref+        ifor_ occurrences $ \item num ->+          putStrLn $ show item ++ ": " ++ show num+  printOccurrencesOf "Letters" lettersRef+  printOccurrencesOf "Words" wordsRef+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "Counter" $ do+    it "handles the empty text" $+      wordAndLetterCount "" `shouldPrint`+        "Letters\n\+        \Words\n"+    it "handles one word" $+      wordAndLetterCount "banana" `shouldPrint`+        "Letters\n'a': 3\n'b': 1\n'n': 2\n\+        \Words\n\"banana\": 1\n"+    it "handles two words" $+      wordAndLetterCount "mississipi river" `shouldPrint`+        "Letters\n'e': 1\n'i': 5\n'm': 1\n'p': 1\n'r': 2\n's': 4\n'v': 1\n\+        \Words\n\"mississipi\": 1\n\"river\": 1\n"+    it "handles two lines" $+      wordAndLetterCount "banana apple\napple banana" `shouldPrint`+        "Letters\n'a': 8\n'b': 2\n'e': 2\n'l': 2\n'n': 4\n'p': 4\n\+        \Words\n\"apple\": 2\n\"banana\": 2\n"

@@ -0,0 +1,87 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++-- | Example uses and instances of the @HasWriter@ capability.+module Writer where++import Capability.State+import Capability.Writer+import Control.Monad.State.Strict (State, StateT (..), runState)+import Data.Monoid (Sum (..))+import Test.Hspec++----------------------------------------------------------------------+-- Example Programs++-- | Increase a counter using a writer monad.+useWriter :: HasWriter "count" (Sum Int) m => m ()+useWriter = do+  tell @"count" 1+  tell @"count" 2+  tell @"count" 3+++-- | Mix writer and state monad operations on the same tag.+--+-- Note, mixing capabilities on the same tag like this is inadvisable in+-- 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)+  => m Int+mixWriterState = do+  tell @"count" 1+  one <- get @"count"+  tell @"count" $ Sum one+  pure one+++----------------------------------------------------------------------+-- Instances++-- | @HasWriter w@ capability derived from @HasState w@.+--+-- The monoid instance ('Data.Monoid.Sum') is also selected in the deriving+-- via clause.+newtype WriterM a = WriterM (State Int a)+  deriving (Functor, Applicative, Monad)+  deriving (HasWriter "count" (Sum Int))+    via WriterLog (Coerce (Sum Int) (MonadState (State Int)))++runWriterM :: WriterM a -> (a, Int)+runWriterM (WriterM m) = runState m 0+++-- | @HasWriter w@ capability derived from @HasState w@, while also exposing+-- the underlying @HasState@.+--+-- Note, that this is inadvisable in real applications.+-- See caveat on 'mixWriterState'.+newtype BadWriterM a = BadWriterM (State Int a)+  deriving (Functor, Applicative, Monad)+  deriving (HasWriter "count" (Sum Int))+    via WriterLog (Coerce (Sum Int) (MonadState (State Int)))+  deriving (HasState "count" Int)+    via MonadState (State Int)++runBadWriterM :: BadWriterM a -> (a, Int)+runBadWriterM (BadWriterM m) = runState m 0+++----------------------------------------------------------------------+-- Test Cases++spec :: Spec+spec = do+  describe "WriterM" $+    it "evaluates useWriter" $+      runWriterM useWriter `shouldBe` ((), 6)+  describe "BadWriterM" $ do+    it "evaluates useWriter" $+      runBadWriterM useWriter `shouldBe` ((), 6)+    it "evaluates mixWriterState" $+      runBadWriterM mixWriterState `shouldBe` (1, 2)

@@ -0,0 +1,90 @@+-- | A capability is a type class over a monad which specifies the effects that+-- a function is allowed to perform. Capabilities differ from traditional monad+-- transformer type classes in that they are completely independent of the way+-- the monad is constructed. A state capability can for instance be implemented+-- as a lens on a field in a larger state monad, or an error capability could+-- provide for throwing only a subset of the errors of an error monad.+--+-- This library defines several standard, reusable capabilities that replace the+-- mtl's monad-transformer type classes. Because capabilities are not tied to+-- a particular implementation of the monad, they cannot be discharged by+-- instance resolution. Instead this library provides combinators in the form of+-- newtypes with instances, to be used with deriving-via. To learn about+-- deriving via, watch Baldur Blondal's introductory video+-- <https://skillsmatter.com/skillscasts/10934-lightning-talk-stolen-instances-taste-just-fine>.+--+-- By way of comparison, with the mtl you would write something like+--+-- @+-- foo :: (MonadReader E, MonadState S) => a -> m ()+-- @+--+-- You can use @foo@ at type @a -> ReaderT E (State S)@. But you can't use @foo@+-- with the @ReaderT@ pattern+-- <https://www.fpcomplete.com/blog/2017/06/readert-design-pattern>. With this+-- library, you would instead have:+--+-- @+-- foo :: (HasReader "conf" E, HasState "st" S) => a -> m ()+-- @+--+-- Where @"conf"@ and @"st"@ are the names (also referred to as tags) of the+-- capabilities demanded by foo. Contrary to the mtl, capabilities are named,+-- rather than disambiguated by the type of their implied state, or exception.+-- This makes it easy to have multiple state capabilities.+--+-- To /provide/ these capabilities, for instance with the ReaderT pattern, do as+-- follows (for a longer form tutorial, check the+-- <https://github.com/tweag/capability#readme README>):+--+-- @+-- newtype MyM a = MyM (ReaderT (E, IORef s))+--   deriving (Functor, Applicative, Monad)+--   deriving (HasState "st" Int) via+--     ReaderIORef (Rename 2 (Pos 2 ()+--     (MonadReader (ReaderT (E, IORef s) IO))))+--   deriving (HasReader "conf" Int) via+--     (Rename 1 (Pos 1 ()+--     (MonadReader (ReaderT (E, IORef s) IO))))+-- @+--+-- Then you can use @foo@ at type @MyM@. Or any other type which can provide+-- these capabilites.+--+-- == Module structure+--+-- Each module introduces a capability type class (or several related type+-- classes). Each class comes with a number of instances on newtypes (each+-- newtype should be seen as a combinator to be used with deriving-via to+-- provide the capability). Many newtypes come from the common+-- "Capability.Accessors" module (re-exported by each of the other modules),+-- which in particular contains a number of ways to address components of a data+-- type using the generic-lens library.+--+-- * "Capability.Reader" reader effects+-- * "Capability.State" state effects+-- * "Capability.Writer" writer effects+-- * "Capability.Error" throw and catch errors+-- * "Capability.Stream" streaming effect (aka generators)+--+-- 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.+--+-- == Further considerations+--+-- The tags of capabilities can be of any kind, they are not restricted to+-- symbols. When exporting functions demanding capabilities in libraries, it is+-- recommended to use a type as follows:+--+-- @+-- data Conf+--+-- foo :: HasReader Conf C => m ()+-- @+--+-- This way, @Conf@ can be qualified in case of a name conflict with another+-- library.++module Capability where

@@ -0,0 +1,161 @@+-- | Defines @newtype@s that serve as combinators+-- to compose deriving via strategies.++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}++module Capability.Accessors+  ( Coerce(..)+  , Rename(..)+  , Field(..)+  , Pos(..)+  , Ctor(..)+  , Lift(..)+  , (:.:)(..)+  ) where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Primitive (PrimMonad)+import GHC.TypeLits (Nat, Symbol)++-- | Coerce the type in the context @m@ to @to@.+--+-- Example:+--+-- @+-- newtype MyInt = MyInt Int+-- newtype MyReader a = MyReader (Reader Int a)+--   deriving (HasReader "a" MyInt) via+--     Coerce MyInt (MonadReader (Reader Int))+-- @+--+-- Converts the @'Capability.Reader.HasReader' \"a\" Int@ instance of+-- @'Capability.Reader.MonadReader' (Reader Int)@ to a+-- @'Capability.Reader.HasReader' \"a\" MyInt@+-- instance using @Coercible Int MyInt@.+newtype Coerce (to :: *) m (a :: *) = Coerce (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Rename the tag.+--+-- Example:+--+-- @+-- newtype MyReader a = MyReader (Reader Int a)+--   deriving (HasReader "foo" Int) via+--     Rename "bar" (MonadReader (Reader Int))+-- @+--+-- Converts the @'Capability.Reader.HasReader' \"bar\" Int@ instance of+-- @'Capability.Reader.MonadReader' (Reader Int)@ to a+-- @'Capability.Reader.HasReader' \"foo\" Int@ instance by renaming the tag.+--+-- Note, that 'Capability.Reader.MonadReader' itself does not fix a tag,+-- and @Rename@ is redundant in this example.+--+-- See 'Pos' below for a common use-case.+newtype Rename (oldtag :: k) m (a :: *) = Rename (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Access the record field @field@ in the context @m@.+--+-- Example:+--+-- @+-- data Foo = Foo { foo :: Int }+-- newtype MyReader a = MyReader (Reader Foo a)+--   deriving (HasReader "foo" Int) via+--     Field "foo" () (MonadReader (Reader Foo))+-- @+--+-- Converts the @'Capability.Reader.HasReader' () Foo@ instance of+-- @'Capability.Reader.MonadReader' (Reader Foo)@ to a+-- @'Capability.Reader.HasReader' \"foo\" Int@+-- instance by focusing on the field @foo@ in the @Foo@ record.+--+-- See 'Rename' for a way to change the tag.+newtype Field (field :: Symbol) (oldtag :: k) m (a :: *) = Field (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Access the value at position @pos@ in the context @m@.+--+-- Example:+--+-- @+-- newtype MyReader a = MyReader (Reader (Int, Bool) a)+--   deriving (HasReader 1 Int) via+--     Pos 1 () (MonadReader (Reader (Int, Bool)))+-- @+--+-- Converts the @'Capability.Reader.HasReader' () (Int, Bool)@ instance of+-- @'Capability.Reader.MonadReader' (Reader (Int, Bool))@ to a+-- @'Capability.Reader.HasReader' 1 Int@ instance+-- by focusing on the first element of the tuple.+--+-- The implied number tag can be renamed to a more descriptive name using+-- the 'Rename' combinator:+--+-- @+-- newtype MyReader a = MyReader (Reader (Int, Bool) a)+--   deriving (HasReader "foo" Int) via+--     Rename 1 (Pos 1 () (MonadReader (Reader (Int, Bool))))+-- @+newtype Pos (pos :: Nat) (oldtag :: k) m (a :: *) = Pos (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Choose the given constructor in the sum-type in context @m@.+--+-- Example:+--+-- @+-- data MyError = ErrA String | ErrB String+-- newtype MyExcept a = MyExcept (ExceptT MyError Identity a)+--   deriving (HasThrow \"ErrB" String) via+--     Ctor \"ErrB" () (MonadError (ExceptT MyError Identity))+-- @+--+-- Converts the @'Capability.Error.HasThrow' () \"MyError\"@ instance of+-- @'Capability.Error.MonadError' (ExceptT MyError Identity)@ to a+-- @'Capability.Error.HasThrow' \"ErrB\" String@+-- instance by wrapping thrown @String@s in the @ErrB@ constructor.+newtype Ctor (ctor :: Symbol) (oldtag :: k) m (a :: *) = Ctor (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++-- | Skip one level in a monad transformer stack.+--+-- Note, that instances generated with this strategy can incur a performance+-- penalty.+--+-- Example:+--+-- @+-- newtype MyStates a = MyStates (StateT Int (State Bool) a)+--   deriving (HasState "foo" Bool) via+--     Lift (StateT Int (MonadState (State Bool)))+-- @+--+-- Uses the 'Control.Monad.Trans.Class.MonadTrans' instance of+-- @StateT Int@ to lift+-- the @'Capability.State.HasState' "\foo\" Bool@ instance of the underlying+-- @'Capability.State.MonadState' (State Bool)@ over the+-- @StateT Int@ monad transformer.+newtype Lift m (a :: *) = Lift (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+++-- | Compose two accessors.+--+-- This is not necessary in deriving via clauses, but in places where a+-- transformer is expected as a type argument. E.g. 'HasError.wrapError'.+newtype (:.:)+  (t2 :: (* -> *) -> * -> *)+  (t1 :: (* -> *) -> * -> *)+  (m :: * -> *)+  (a :: *)+  = (:.:) (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+infixr 9 :.:

@@ -0,0 +1,423 @@+-- | Defines capabilities for actions that may fail or throw exceptions,+-- and optionally may catch exceptions.+--+-- Monads based on @IO@ can use the underlying @IO@ exception mechanism+-- to that end. The details of synchronous and asynchronous exception+-- handling depend on the strategy used.+-- See 'MonadThrow', 'SafeExceptions', 'MonadUnliftIO'.+--+-- The associated tag can be used to select the exception type, or to+-- select a layer in monad transformer stacks. Note, that it is illegal+-- to have multiple tags refer to overlapping exception types in the same+-- layer. Consider the following example+--+-- @+-- newtype M a = M (IO a)+--   deriving (HasThrow "foo" IOException) via+--     MonadUnliftIO IO+--   deriving (HasThrow "bar" SomeException) via+--     MonadUnliftIO IO+-- @+--+-- In this case the tags @"foo"@ and @"bar"@ refer to overlapping exception+-- types in the same layer, because @catch \@"bar"@ may also catch an exception+-- thrown under @"foo"@.++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++module Capability.Error+  ( -- * Interface+    HasThrow(..)+  , throw+  , HasCatch(..)+  , catch+  , catchJust+  , wrapError+    -- * Strategies+  , MonadError(..)+  , MonadThrow(..)+  , MonadCatch(..)+  , SafeExceptions(..)+  , MonadUnliftIO(..)+    -- ** Modifiers+  , module Capability.Accessors+    -- * Re-exported+  , Exception(..)+  , Typeable+  ) where++import Capability.Accessors+import Control.Exception (Exception(..))+import qualified Control.Exception.Safe as Safe+import Control.Lens (preview, review)+import Control.Monad ((<=<))+import qualified Control.Monad.Catch as Catch+import qualified Control.Monad.Except as Except+import Control.Monad.IO.Class (MonadIO)+import qualified Control.Monad.IO.Unlift as UnliftIO+import Control.Monad.Primitive (PrimMonad)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.Control (MonadTransControl(..))+import Data.Coerce (Coercible, coerce)+import qualified Data.Generics.Sum.Constructors as Generic+import Data.Typeable (Typeable)+import GHC.Exts (Proxy#, proxy#)+import qualified UnliftIO.Exception as UnliftIO++-- | Capability to throw exceptions of type @e@ under @tag@.+--+-- @HasThrow@/@HasCatch@ capabilities at different tags should be independent.+-- See 'HasCatch'.+class Monad m+  => HasThrow (tag :: k) (e :: *) (m :: * -> *) | tag m -> e+  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 'throw'.+    -- See 'throw' for more documentation.+    throw_ :: Proxy# tag -> e -> m a++-- | Throw an exception in the specified exception capability.+throw :: forall tag e m a. HasThrow tag e m => e -> m a+throw = throw_ (proxy# @_ @tag)+{-# INLINE throw #-}++-- | Capability to catch exceptions of type @e@ under @tag@.+--+-- @HasThrow@/@HasCatch@ capabilities at different tags should be independent.+-- In particular, the following program should throw @SomeError@ and not+-- return @()@.+-- > example ::+-- >   (HasThrow "Left" SomeError m, HasCatch "Right" SomeError m)+-- >   => m ()+-- > example =+-- >   catch @"Left"+-- >     (throw @"Right" SomeError)+-- >     \_ -> pure ()+--+-- See 'wrapError' for a way to combine multiple exception types into one.+class HasThrow tag e m+  => HasCatch (tag :: k) (e :: *) (m :: * -> *) | tag m -> e+  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 'catch'.+    -- See 'catch' for more documentation.+    catch_ :: Proxy# tag -> m a -> (e -> m a) -> m a+    -- | 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 'catchJust'.+    -- See 'catchJust' for more documentation.+    catchJust_ :: Proxy# tag -> (e -> Maybe b) -> m a -> (b -> m a) -> m a++-- | Provide a handler for exceptions thrown in the given action+-- in the given exception capability.+catch :: forall tag e m a. HasCatch tag e m => m a -> (e -> m a) -> m a+catch = catch_ (proxy# @_ @tag)+{-# INLINE catch #-}++-- | Like 'catch', but only handle the exception if the provided function+-- returns 'Just'.+catchJust :: forall tag e m a b. HasCatch tag e m+  => (e -> Maybe b) -> m a -> (b -> m a) -> m a+catchJust = catchJust_ (proxy# @_ @tag)+{-# INLINE catchJust #-}++-- | Wrap exceptions @inner@ originating from the given action according to+-- the accessor @t@.+--+-- Example:+--+-- > wrapError+-- >   @"AppError" @"ComponentError" @(Ctor "ComponentError" "AppError")+-- >   component+-- >+-- > component :: HasError "ComponentError" ComponentError m => m ()+-- > data AppError = ComponentError ComponentError+--+-- 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.+  ( 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+{-# INLINE wrapError #-}++-- XXX: Does it make sense to add a HasMask capability similar to @MonadMask@?+--   What would the meaning of the tag be?++-- | Derive 'HasError from @m@'s 'Control.Monad.Except.MonadError' instance.+newtype MonadError m (a :: *) = MonadError (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance Except.MonadError e m => HasThrow tag e (MonadError m) where+  throw_ :: forall a. Proxy# tag -> e -> MonadError m a+  throw_ _ = coerce @(e -> m a) $ Except.throwError+  {-# INLINE throw_ #-}++instance Except.MonadError e m => HasCatch tag e (MonadError m) where+  catch_ :: forall a.+    Proxy# tag -> MonadError m a -> (e -> MonadError m a) -> MonadError m a+  catch_ _ = coerce @(m a -> (e -> m a) -> m a) $ Except.catchError+  {-# INLINE catch_ #-}+  catchJust_ :: forall a b.+    Proxy# tag+    -> (e -> Maybe b)+    -> MonadError m a+    -> (b -> MonadError m a)+    -> MonadError m a+  catchJust_ tag f m h = catch_ tag m $ \e -> maybe (throw_ tag e) h $ f e+  {-# INLINE catchJust_ #-}++-- | Derive 'HasThrow' from @m@'s 'Control.Monad.Catch.MonadThrow' instance.+newtype MonadThrow (e :: *) m (a :: *) = MonadThrow (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance (Catch.Exception e, Catch.MonadThrow m)+  => HasThrow tag e (MonadThrow e m)+  where+    throw_ :: forall a. Proxy# tag -> e -> MonadThrow e m a+    throw_ _ = coerce @(e -> m a) $ Catch.throwM+    {-# INLINE throw_ #-}++-- | Derive 'HasCatch from @m@'s 'Control.Monad.Catch.MonadCatch instance.+newtype MonadCatch (e :: *) m (a :: *) = MonadCatch (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+  deriving (HasThrow tag e) via MonadThrow e m++instance (Catch.Exception e, Catch.MonadCatch m)+  => HasCatch tag e (MonadCatch e m)+  where+    catch_ :: forall a.+      Proxy# tag+      -> MonadCatch e m a+      -> (e -> MonadCatch e m a)+      -> MonadCatch e m a+    catch_ _ = coerce @(m a -> (e -> m a) -> m a) $ Catch.catch+    {-# INLINE catch_ #-}+    catchJust_ :: forall a b.+      Proxy# tag+      -> (e -> Maybe b)+      -> MonadCatch e m a+      -> (b -> MonadCatch e m a)+      -> MonadCatch e m a+    catchJust_ _ = coerce @((e -> Maybe b) -> m a -> (b -> m a) -> m a) $+      Catch.catchJust+    {-# INLINE catchJust_ #-}+++-- | Derive 'HasError' using the functionality from the @safe-exceptions@+-- package.+newtype SafeExceptions (e :: *) m (a :: *) = SafeExceptions (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance (Safe.Exception e, Safe.MonadThrow m)+  => HasThrow tag e (SafeExceptions e m)+  where+    throw_ :: forall a. Proxy# tag -> e -> SafeExceptions e m a+    throw_ _ = coerce @(e -> m a) $ Safe.throw+    {-# INLINE throw_ #-}++instance (Safe.Exception e, Safe.MonadCatch m)+  => HasCatch tag e (SafeExceptions e m)+  where+    catch_ :: forall a.+      Proxy# tag+      -> SafeExceptions e m a+      -> (e -> SafeExceptions e m a)+      -> SafeExceptions e m a+    catch_ _ = coerce @(m a -> (e -> m a) -> m a) $ Safe.catch+    {-# INLINE catch_ #-}+    catchJust_ :: forall a b.+      Proxy# tag+      -> (e -> Maybe b)+      -> SafeExceptions e m a+      -> (b -> SafeExceptions e m a)+      -> SafeExceptions e m a+    catchJust_ _ = coerce @((e -> Maybe b) -> m a -> (b -> m a) -> m a) $+      Safe.catchJust+    {-# INLINE catchJust_ #-}++-- | Derive 'HasError' using the functionality from the @unliftio@ package.+newtype MonadUnliftIO (e :: *) m (a :: *) = MonadUnliftIO (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance (UnliftIO.Exception e, MonadIO m)+  => HasThrow tag e (MonadUnliftIO e m)+  where+    throw_ :: forall a. Proxy# tag -> e -> MonadUnliftIO e m a+    throw_ _ = coerce @(e -> m a) $ UnliftIO.throwIO+    {-# INLINE throw_ #-}++instance (UnliftIO.Exception e, UnliftIO.MonadUnliftIO m)+  => HasCatch tag e (MonadUnliftIO e m)+  where+    catch_ :: forall a.+      Proxy# tag+      -> MonadUnliftIO e m a+      -> (e -> MonadUnliftIO e m a)+      -> MonadUnliftIO e m a+    catch_ _ = coerce @(m a -> (e -> m a) -> m a) $ UnliftIO.catch+    {-# INLINE catch_ #-}+    catchJust_ :: forall a b.+      Proxy# tag+      -> (e -> Maybe b)+      -> MonadUnliftIO e m a+      -> (b -> MonadUnliftIO e m a)+      -> MonadUnliftIO e m a+    catchJust_ _ = coerce @((e -> Maybe b) -> m a -> (b -> m a) -> m a) $+      UnliftIO.catchJust+    {-# INLINE catchJust_ #-}++-- | Rename the tag.+--+-- Apply cautiously. See @'HasCatch' newtag e ('Rename' oldtag m)@.+instance HasThrow oldtag e m => HasThrow newtag e (Rename oldtag m) where+  throw_ :: forall a. Proxy# newtag -> e -> Rename oldtag m a+  throw_ _ = coerce @(e -> m a) $ throw @oldtag+  {-# INLINE throw_ #-}++-- | Rename the tag.+--+-- Apply cautiously. E.g. the following code produces colliding instances,+-- where exceptions thrown in @\"Foo\"@ cannot be distinguished from exceptions+-- thrown in @\"Bar\"@ and vice-versa.+--+-- > newtype Bad a = Bad (IO a)+-- >   deriving (Functor, Applicative, Monad)+-- >   deriving+-- >     ( HasThrow "Foo" m+-- >     , HasCatch "Foo" m+-- >     ) via Rename () (MonadUnliftIO SomeError IO)+-- >   deriving+-- >     ( HasThrow "Bar" m+-- >     , HasCatch "Bar" m+-- >     ) via Rename () (MonadUnliftIO SomeError IO)+instance HasCatch oldtag e m => HasCatch newtag e (Rename oldtag m) where+  catch_ :: forall a.+    Proxy# newtag+    -> Rename oldtag m a+    -> (e -> Rename oldtag m a)+    -> Rename oldtag m a+  catch_ _ = coerce @(m a -> (e -> m a) -> m a) $ catch @oldtag+  {-# INLINE catch_ #-}+  catchJust_ :: forall a b.+    Proxy# newtag+    -> (e -> Maybe b)+    -> Rename oldtag m a+    -> (b -> Rename oldtag m a)+    -> Rename oldtag m a+  catchJust_ _ = coerce @((e -> Maybe b) -> m a -> (b -> m a) -> m a) $+    catchJust @oldtag+  {-# INLINE catchJust_ #-}++-- | Wrap the exception @e@ with the constructor @ctor@ to throw an exception+-- of type @sum@.+instance+  -- The constraint raises @-Wsimplifiable-class-constraints@. This could+  -- be avoided by instead placing @AsConstructor'@s constraints here.+  -- Unfortunately, it uses non-exported symbols from @generic-lens@.+  (Generic.AsConstructor' ctor sum e, HasThrow oldtag sum m)+  => HasThrow ctor e (Ctor ctor oldtag m)+  where+    throw_ :: forall a. Proxy# ctor -> e -> Ctor ctor oldtag m a+    throw_ _ = coerce @(e -> m a) $+      throw @oldtag . review (Generic._Ctor' @ctor @sum)+    {-# INLINE throw_ #-}++-- | Catch an exception of type @sum@ if its constructor matches @ctor@.+instance+  -- The constraint raises @-Wsimplifiable-class-constraints@. This could+  -- be avoided by instead placing @AsConstructor'@s constraints here.+  -- Unfortunately, it uses non-exported symbols from @generic-lens@.+  (Generic.AsConstructor' ctor sum e, HasCatch oldtag sum m)+  => HasCatch ctor e (Ctor ctor oldtag m)+  where+    catch_ :: forall a.+      Proxy# ctor+      -> Ctor ctor oldtag m a+      -> (e -> Ctor ctor oldtag m a)+      -> Ctor ctor oldtag m a+    catch_ _ = coerce @(m a -> (e -> m a) -> m a) $+      catchJust @oldtag @sum $ preview (Generic._Ctor' @ctor @sum)+    {-# INLINE catch_ #-}+    catchJust_ :: forall a b.+      Proxy# ctor+      -> (e -> Maybe b)+      -> Ctor ctor oldtag m a+      -> (b -> Ctor ctor oldtag m a)+      -> Ctor ctor oldtag m a+    catchJust_ _ = coerce @((e -> Maybe b) -> m a -> (b -> m a) -> m a) $ \f ->+      catchJust @oldtag @sum $ f <=< preview (Generic._Ctor' @ctor @sum)+    {-# INLINE catchJust_ #-}++-- | Lift one layer in a monad transformer stack.+instance+  ( HasThrow tag e m, MonadTrans t, Monad (t m) )+  => HasThrow tag e (Lift (t m))+  where+    throw_ :: forall a. Proxy# tag -> e -> Lift (t m) a+    throw_ tag = coerce @(e -> t m a) $ lift . throw_ tag+    {-# INLINE throw_ #-}++-- | Lift one layer in a monad transformer stack.+instance+  ( HasCatch tag e m, MonadTransControl t, Monad (t m) )+  => HasCatch tag e (Lift (t m))+  where+    catch_ :: forall a.+      Proxy# tag+      -> Lift (t m) a+      -> (e -> Lift (t m) a)+      -> Lift (t m) a+    catch_ tag = coerce @(t m a -> (e -> t m a) -> t m a) $ \m h ->+      liftWith (\run -> catch_ tag (run m) (run . h)) >>= restoreT . pure+    {-# INLINE catch_ #-}+    catchJust_ :: forall a b.+      Proxy# tag+      -> (e -> Maybe b)+      -> Lift (t m) a+      -> (b -> Lift (t m) a)+      -> Lift (t m) a+    catchJust_ tag =+      coerce @((e -> Maybe b) -> t m a -> (b -> t m a) -> t m a) $ \f m h ->+        liftWith (\run -> catchJust_ tag f (run m) (run . h)) >>= restoreT . pure+    {-# INLINE catchJust_ #-}+++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasThrow tag e (t2 (t1 m)) )+  => HasThrow tag e ((t2 :.: t1) m)+++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasCatch tag e (t2 (t1 m)) )+  => HasCatch tag e ((t2 :.: t1) m)

@@ -0,0 +1,18 @@+-- | 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+-- the scope of a sub-computation. Contrary to the "Capability.State", such+-- a change is local, and does not persist when the 'local' call ends.++module Capability.Reader+  ( -- * Interface+    module Capability.Reader.Internal.Class+    -- * Strategies+  , module Capability.Reader.Internal.Strategies+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Accessors+import Capability.Reader.Internal.Class+import Capability.Reader.Internal.Strategies

@@ -0,0 +1,104 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Reader.Internal.Class+  ( HasReader(..)+  , ask+  , asks+  , local+  , reader+  , magnify+  ) where++import Data.Coerce (Coercible, coerce)+import GHC.Exts (Proxy#, proxy#)++-- | Reader capability+--+-- An instance should fulfill the following laws.+-- At this point these laws are not definitive,+-- see <https://github.com/haskell/mtl/issues/5>.+--+-- prop> k <*> ask @t = ask @t <**> k+-- prop> ask @t *> m = m = m <* ask @t+-- prop> local @t f (ask @t) = fmap f (ask @t)+-- prop> local @t f . local @t g = local @t (g . f)+-- 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+  => 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+    -- | 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 'reader'.+    -- See 'reader' for more documentation.+    reader_ :: Proxy# tag -> (r -> a) -> m a++-- | @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)+{-# INLINE ask #-}++-- | @asks \@tag@+-- retrieves the image by @f@ of the environment+-- of the reader capability @tag@.+--+-- 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+{-# INLINE asks #-}++-- | @local \@tag f m@+-- runs the monadic action @m@ in a modified environment @e' = f e@,+-- where @e@ is the environment of the reader capability @tag@.+-- Symbolically: @return e = ask \@tag@.+local :: forall tag r m a. HasReader tag r m => (r -> r) -> m a -> m a+local = local_ (proxy# @_ @tag)+{-# INLINE local #-}++-- | @reader \@tag act@+-- lifts a purely environment-dependent action @act@ to a monadic action+-- in an arbitrary monad @m@ with capability @HasReader@.+--+-- It happens to coincide with @asks@: @reader = asks@.+reader :: forall tag r m a. HasReader tag r m => (r -> a) -> m a+reader = reader_ (proxy# @_ @tag)+{-# INLINE reader #-}++-- | Execute the given reader action on a sub-component of the current context+-- as defined by the given transformer @t@.+--+-- See 'Capability.State.zoom'.+--+-- 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.+  ( 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+{-# INLINE magnify #-}

@@ -0,0 +1,224 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.Reader.Internal.Strategies+  ( MonadReader(..)+  , ReadStatePure(..)+  , ReadState(..)+  ) where++import Capability.Accessors+import Capability.Reader.Internal.Class+import Capability.State.Internal.Class+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(..))+import Data.Coerce (Coercible, coerce)+import qualified Data.Generics.Product.Fields as Generic+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+  {-# INLINE local_ #-}+  reader_ :: forall a. Proxy# tag -> (r -> a) -> MonadReader m a+  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+    r <- state @tag $ \r -> (r, f r)+    m <* put @tag r+  {-# INLINE local_ #-}+  reader_ :: forall a. Proxy# tag -> (r -> a) -> ReadStatePure m a+  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 ->+      let+        setAndSave = state @tag $ \r -> (r, f r)+        restore r = put @tag r+      in+      bracket setAndSave restore $ \_ -> action+    {-# INLINE local_ #-}+    reader_ :: forall a. Proxy# tag -> (r -> a) -> ReadState m a+    reader_ _ = coerce @((r -> a) -> m a) $ gets @tag+    {-# INLINE reader_ #-}++-- | Convert the environment using safe coercion.+instance+  ( Coercible from to, HasReader tag from m+  , 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+    {-# INLINE local_ #-}+    reader_ :: forall a. Proxy# tag -> (to -> a) -> Coerce to m a+    reader_ tag = coerce @((from -> a) -> m a) $ reader_ tag+    {-# INLINE reader_ #-}++-- | 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+  {-# INLINE local_ #-}+  reader_ :: forall a. Proxy# newtag -> (r -> a) -> Rename oldtag m a+  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+  -- 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, 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)+      -> Field field oldtag m a+      -> Field field oldtag m a+    local_ _ = coerce @((v -> v) -> m a -> m a) $+      local @oldtag . over (Generic.field' @field)+    {-# INLINE local_ #-}+    reader_ :: forall a.+      Proxy# tag+      -> (v -> a)+      -> Field field oldtag m a+    reader_ _ f = coerce @(m a) $+      reader @oldtag $ f . view (Generic.field' @field)+    {-# INLINE reader_ #-}++-- | Zoom in on the field at position @pos@ of type @v@+-- in the environment @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, 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)+      -> Pos pos oldtag m a+      -> Pos pos oldtag m a+    local_ _ = coerce @((v -> v) -> m a -> m a) $+      local @oldtag . over (Generic.position' @pos)+    {-# INLINE local_ #-}+    reader_ :: forall a.+      Proxy# tag+      -> (v -> a)+      -> Pos pos oldtag m a+    reader_ _ f = coerce @(m a) $+      reader @oldtag $ f . view (Generic.position' @pos)+    {-# INLINE reader_ #-}++-- | Lift one layer in a monad transformer stack.+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) $+      \m -> liftWith (\run -> local @tag f $ run m) >>= restoreT . pure+    {-# INLINE local_ #-}+    reader_ :: forall a. Proxy# tag -> (r -> a) -> Lift (t m) a+    reader_ _ = coerce @((r -> a) -> t m a) $ lift . reader @tag+    {-# INLINE reader_ #-}++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasReader tag r (t2 (t1 m)) )+  => HasReader tag r ((t2 :.: t1) m)

@@ -0,0 +1,22 @@+-- | 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+-- in an @IO@ computation (except, of course, that a state capability does not+-- have to be provided by @IO@).+--+-- This is a very expressive capability. It is often preferable to restrict to+-- less powerful capabilities such as "Capability.Reader", "Capability.Writer",+-- or "Capability.Stream".++module Capability.State+  ( -- * Interface+    module Capability.State.Internal.Class+    -- * Strategies+  , module Capability.State.Internal.Strategies+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Accessors+import Capability.State.Internal.Class+import Capability.State.Internal.Strategies

@@ -0,0 +1,125 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}++{-# OPTIONS_HADDOCK hide #-}++module Capability.State.Internal.Class+  ( HasState(..)+  , get+  , put+  , state+  , modify+  , modify'+  , gets+  , zoom+  ) where++import Data.Coerce (Coercible, coerce)+import GHC.Exts (Proxy#, proxy#)++-- | State capability+--+-- An instance should fulfill the following laws.+-- At this point these laws are not definitive,+-- see <https://github.com/haskell/mtl/issues/5>.+--+-- prop> get @t >>= \s1 -> get @t >>= \s2 -> pure (s1, s2) = get @t >>= \s -> pure (s, s)+-- prop> get @t >>= \_ -> put @t s = put @t s+-- 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+  => 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++-- | @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)+{-# 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)+{-# INLINE put #-}++-- | @state \@tag f@+-- lifts a pure state computation @f@ to a monadic action in an arbitrary+-- monad @m@ with capability @HasState@.+--+-- Given the current state @s@ of the state capability @tag@+-- and @(a, s') = f s@, update the state to @s'@ and return @a@.+state :: forall tag s m a. HasState tag s m => (s -> (a, s)) -> m a+state = state_ (proxy# @_ @tag)+{-# INLINE state #-}++-- | @modify \@tag f@+-- given the current state @s@ of the state capability @tag@+-- and @s' = f s@, updates the state of the capability @tag@ to @s'@.+modify :: forall tag s m. HasState tag s m => (s -> s) -> m ()+modify f = state @tag $ \s -> ((), f s)+{-# INLINE modify #-}++-- | Same as 'modify' but strict in the new state.+modify' :: forall tag s m. HasState tag s m => (s -> s) -> m ()+modify' f = do+  s' <- get @tag+  put @tag $! f s'+{-# INLINE modify' #-}++-- | @gets \@tag f@+-- retrieves the image, by @f@ of the current state+-- of the state capability @tag@.+--+-- prop> gets @tag f = f <$> get @tag+gets :: forall tag s m a. HasState tag s m => (s -> a) -> m a+gets f = do+  s <- get @tag+  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@.+--+-- Example:+--+-- > zoom @"foobar" @"foo" @(Field "foo" "foobar") foo+-- >   :: HasState "foobar" FooBar m => m ()+-- >+-- > foo :: HasState "foo" Int m => m ()+-- > data FooBar = FooBar { foo :: Int, bar :: String }+--+-- 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.+  ( 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+{-# INLINE zoom #-}

@@ -0,0 +1,216 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# 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+  ( MonadState(..)+  , ReaderIORef(..)+  , ReaderRef(..)+  ) where++import Capability.Accessors+import Capability.Reader.Internal.Class+import Capability.State.Internal.Class+import Control.Lens (set, view)+import Control.Monad.IO.Class (MonadIO, liftIO)+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 qualified Data.Generics.Product.Fields as Generic+import qualified Data.Generics.Product.Positions as Generic+import Data.IORef+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_ #-}++-- | Convert the state using safe coercion.+instance+  ( Coercible from to, HasState tag from m+  , 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_ #-}++-- | 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 )+  => 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))+      -> Field field oldtag m a+    state_ _ = coerce @((v -> (a, v)) -> m a) $+      state @oldtag . Generic.field' @field @_ @_ @((,) a)+    {-# INLINE state_ #-}++-- | 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 )+  => 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))+      -> Pos pos oldtag m a+    state_ _ = coerce @((v -> (a, v)) -> m a) $+      state @oldtag . Generic.position' @pos @_ @_ @((,) a)+    {-# INLINE state_ #-}++-- | Lift one layer in a monad transformer stack.+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_ #-}++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , 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)+      where+        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+      let (a, s') = f s+      writeRef ref s'+      pure a+    {-# INLINE state_ #-}

@@ -0,0 +1,109 @@+-- | 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+  ( -- * Interface+    HasStream(..)+  , yield+    -- * Strategies+  , StreamStack(..)+  , StreamDList(..)+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Accessors+import Capability.State+import Capability.Writer+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_ #-}++-- | Accumulate streamed values in forward order in a difference list.+newtype StreamDList m (a :: *) = StreamDList (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)+instance HasWriter tag (DList a) m => HasStream tag a (StreamDList m) where+  yield_ _ = coerce @(a -> m ()) $ tell @tag . DList.singleton+  {-# INLINE yield_ #-}++instance Monad m => HasStream tag a (S.Stream (Of a) m) where+  yield_ _ = S.yield+  {-# INLINE yield_ #-}++-- | Lift one layer in a monad transformer stack.+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_ #-}++-- | 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)

@@ -0,0 +1,162 @@+-- | Defines a capability type class for writer effects. A writer program can+-- output values with 'tell'. The values output by two consecutive+-- sub-computation are combined using a monoid's @mappend@.+--+-- The interface of 'HasWriter' follows that of+-- 'Control.Monad.Writer.Class.MonadWriter'. However, this module does not+-- include a strategy to provide a @HasWriter@ capability from a @MonadWriter@+-- instance. It is generally a bad idea to use monads such as+-- 'Control.Monad.Writer.Strict.WriterT', as they tend to leak space, as+-- described in this+-- <https://blog.infinitenegativeutility.com/2016/7/writer-monads-and-space-leaks+-- blog post> by Getty Ritter.+--+-- Instead, you should use the 'WriterLog' strategy that implements the writer+-- monad on a state monad. There is no downside, as using 'HasWriter' instead of+-- 'HasState' directly ensures your code adheres to the writer monad interface+-- and does not misuse the underlying state monad.++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++module Capability.Writer+  ( -- * Interface+    HasWriter(..)+  , writer+  , tell+  , listen+  , pass+    -- * Strategies+  , WriterLog(..)+    -- ** Modifiers+  , module Capability.Accessors+  ) where++import Capability.Accessors+import Capability.State+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Primitive (PrimMonad)+import Data.Coerce (Coercible, coerce)+import GHC.Exts (Proxy#, proxy#)++-- | Writer capability+--+-- An instance should fulfill the following laws.+-- At this point these laws are not definitive,+-- see <https://github.com/haskell/mtl/issues/5>.+--+-- prop> listen @t (pure a) = pure (a, mempty)+-- prop> listen @t (tell @t w) = tell @t w >> pure (w, w)+-- prop> listen @t (m >>= k) = listen @t m >>= \(a, w1) -> listen @t (k a) >>= \(b, w2) -> pure (b, w1 `mappend` w2)+-- 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+class (Monoid w, Monad m)+  => HasWriter (tag :: k) (w :: *) (m :: * -> *) | tag m -> w+  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 'writer'.+    -- See 'writer' for more documentation.+    writer_ :: Proxy# tag -> (a, w) -> m a+    -- | 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 'tell'.+    -- See 'tell' for more documentation.+    tell_ :: Proxy# tag -> w -> m ()+    -- | 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 'listen'.+    -- See 'listen' for more documentation.+    listen_ :: Proxy# tag -> m a -> m (a, w)+    -- | 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 'pass'.+    -- See 'pass' for more documentation.+    pass_ :: Proxy# tag -> m (a, w -> w) -> m a++-- | @writer \@tag (a, w)@+-- lifts a pure writer action @(a, w)@ to a monadic action in an arbitrary+-- monad @m@ with capability @HasWriter@.+--+-- 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)+{-# INLINE writer #-}++-- | @tell \@tag w@+-- appends @w@ to the output of the writer capability @tag@.+tell :: forall tag w m. HasWriter tag w m => w -> m ()+tell = tell_ (proxy# @_ @tag)+{-# INLINE tell #-}++-- | @listen \@tag m@+-- executes the action @m@ and returns the output of @m@+-- in the writer capability @tag@ along with result of @m@.+-- Appends the output of @m@ to the output of the writer capability @tag@.+listen :: forall tag w m a. HasWriter tag w m => m a -> m (a, w)+listen = listen_ (proxy# @_ @tag)+{-# INLINE listen #-}++-- | @pass \@tag m@+-- executes the action @m@. Assuming @m@ returns @(a, f)@ and appends+-- @w@ to the output of the writer capability @tag@.+-- @pass \@tag m@ instead appends @w' = f w@ to the output and returns @a@.+pass :: forall tag w m a. HasWriter tag w m => m (a, w -> w) -> m a+pass = pass_ (proxy# @_ @tag)+{-# INLINE pass #-}++-- | Compose two accessors.+deriving via ((t2 :: (* -> *) -> * -> *) ((t1 :: (* -> *) -> * -> *) m))+  instance+  ( forall x. Coercible (m x) (t2 (t1 m) x)+  , Monad m, HasWriter tag w (t2 (t1 m)) )+  => HasWriter tag w ((t2 :.: t1) m)++newtype WriterLog m a = WriterLog (m a)+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)++instance (Monoid w, HasState tag w m)+  => HasWriter tag w (WriterLog m)+  where+    writer_ tag (a, w) = tell_ tag w >> pure a+    {-# INLINE writer_ #-}+    tell_ _ w = coerce @(m ()) $ modify' @tag (<> w)+    {-# INLINE tell_ #-}+    listen_ :: forall a. Proxy# tag -> WriterLog m a -> WriterLog m (a, w)+    listen_ _ m = coerce @(m (a, w)) $ do+      w0 <- get @tag+      put @tag mempty+      a <- coerce m+      w <- get @tag+      put @tag $! w0 <> w+      pure (a, w)+    {-# INLINE listen_ #-}+    pass_ :: forall a. Proxy# tag -> WriterLog m (a, w -> w) -> WriterLog m a+    pass_ _ m = coerce @(m a) $ do+      w0 <- get @tag+      put @tag mempty+      (a, f) <- coerce @_ @(m (a, w -> w)) m+      w <- get @tag+      put @tag $! w0 <> f w+      pure a+    {-# INLINE pass_ #-}

@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++-- | Defines discouraged instances of writer monad capabilities.++module Capability.Writer.Discouraged+  ( ) where++import Capability.Accessors+import Capability.Writer+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Unlift (MonadTransUnlift, Unlift(..), askUnlift)+import Data.Coerce (coerce)+import GHC.Exts (Proxy#)++-- | Lift one layer in a monad transformer stack.+--+-- Note, that if the 'HasWriter' instance is based on 'HasState', then it is+-- more efficient to apply 'Lift' to the underlying state capability. E.g.+-- you should favour+--+-- > deriving (HasWriter tag w) via+-- >   WriterLog (Lift (SomeTrans (MonadState SomeStateMonad)))+--+-- over+--+-- > deriving (HasWriter tag w) via+-- >   Lift (SomeTrans (WriterLog (MonadState SomeStateMonad)))+instance+  -- MonadTransUnlift constraint requires -Wno-simplifiable-class-constraints+  (HasWriter tag w m, MonadTransUnlift t, Monad (t m))+  => HasWriter tag w (Lift (t m))+  where+    writer_ :: forall a. Proxy# tag -> (a, w) -> Lift (t m) a+    writer_ _ = coerce @((a, w) -> t m a) $ lift . writer @tag+    {-# INLINE writer_ #-}+    tell_ _ = coerce @(w -> t m ()) $ lift . tell @tag+    {-# INLINE tell_ #-}+    listen_ :: forall a. Proxy# tag -> Lift (t m) a -> Lift (t m) (a, w)+    listen_ _ = coerce @(t m a -> t m (a, w)) $ \m -> do+      u <- askUnlift+      lift $ listen @tag $ unlift u m+    {-# INLINE listen_ #-}+    pass_ :: forall a. Proxy# tag -> Lift (t m) (a, w -> w) -> Lift (t m) a+    pass_ _ = coerce @(t m (a, w -> w) -> t m a) $ \m -> do+      u <- askUnlift+      lift $ pass @tag $ unlift u m+    {-# INLINE pass_ #-}