fused-effects 1.0.0.1 → 1.0.2.0

raw patch · 71 files changed

+1018/−346 lines, 71 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +33/−0
• benchmark/Bench.hs +20/−10
• benchmark/Bench/NonDet.hs +2/−2
• benchmark/Bench/NonDet/NQueens.hs +5/−2
• benchmark/Bench/Reader.hs +30/−0
• examples/Labelled.hs +73/−0
• examples/Main.hs +2/−0
• fused-effects.cabal +7/−2
• src/Control/Algebra.hs +28/−21
• src/Control/Carrier/Choose/Church.hs +17/−11
• src/Control/Carrier/Cull/Church.hs +15/−10
• src/Control/Carrier/Cut/Church.hs +15/−10
• src/Control/Carrier/Empty/Maybe.hs +11/−7
• src/Control/Carrier/Error/Either.hs +13/−9
• src/Control/Carrier/Fail/Either.hs +13/−9
• src/Control/Carrier/Fresh/Strict.hs +13/−9
• src/Control/Carrier/Interpret.hs +20/−11
• src/Control/Carrier/Lift.hs +10/−9
• src/Control/Carrier/NonDet/Church.hs +14/−9
• src/Control/Carrier/Reader.hs +12/−8
• src/Control/Carrier/State/Lazy.hs +13/−9
• src/Control/Carrier/State/Strict.hs +14/−9
• src/Control/Carrier/Throw/Either.hs +13/−9
• src/Control/Carrier/Trace/Ignoring.hs +12/−8
• src/Control/Carrier/Trace/Printing.hs +13/−9
• src/Control/Carrier/Trace/Returning.hs +15/−11
• src/Control/Carrier/Writer/Strict.hs +13/−9
• src/Control/Effect/Catch/Internal.hs +3/−1
• src/Control/Effect/Choose.hs +5/−5
• src/Control/Effect/Choose/Internal.hs +2/−1
• src/Control/Effect/Class.hs +7/−1
• src/Control/Effect/Cull.hs +3/−1
• src/Control/Effect/Cut.hs +4/−1
• src/Control/Effect/Empty/Internal.hs +3/−1
• src/Control/Effect/Fail.hs +3/−2
• src/Control/Effect/Fresh.hs +3/−3
• src/Control/Effect/Labelled.hs +129/−0
• src/Control/Effect/Lift.hs +10/−1
• src/Control/Effect/Lift/Internal.hs +2/−1
• src/Control/Effect/Reader.hs +3/−0
• src/Control/Effect/Reader/Internal.hs +3/−1
• src/Control/Effect/Reader/Labelled.hs +57/−0
• src/Control/Effect/State.hs +14/−0
• src/Control/Effect/State/Internal.hs +2/−1
• src/Control/Effect/State/Labelled.hs +95/−0
• src/Control/Effect/Sum.hs +25/−5
• src/Control/Effect/Throw/Internal.hs +4/−3
• src/Control/Effect/Trace.hs +2/−1
• src/Control/Effect/Writer.hs +2/−1
• src/Control/Effect/Writer/Internal.hs +3/−1
• test/Catch.hs +3/−1
• test/Choose.hs +9/−6
• test/Cull.hs +10/−7
• test/Cut.hs +14/−9
• test/Cut/Church.hs +2/−2
• test/Empty.hs +11/−6
• test/Error.hs +10/−7
• test/Fail.hs +10/−6
• test/Fresh.hs +8/−5
• test/Fusion.hs +3/−1
• test/Gen.hs +31/−18
• test/Lift.hs +5/−6
• test/Monad.hs +6/−2
• test/MonadFix.hs +4/−0
• test/NonDet.hs +13/−8
• test/NonDet/Church.hs +1/−1
• test/Reader.hs +13/−7
• test/State.hs +11/−6
• test/Test.hs +1/−1
• test/Throw.hs +10/−5
• test/Writer.hs +13/−8

@@ -1,7 +1,25 @@+# v1.0.2.0++- Adds a `state` operation for the `State` effect. ([#353](https://github.com/fused-effects/fused-effects/pull/353))++- Adds a function reassociating sums leftwards to `Control.Effect.Sum`. ([#354](https://github.com/fused-effects/fused-effects/pull/354))++- Inlines `inj`. ([#354](https://github.com/fused-effects/fused-effects/pull/354))++- Adds labelled effects in `Control.Effect.Labelled`. Labelled effects allow flexible disambiguation and dependency for parametric effects, enabling better type inference, restricted usage, and associated type parameters. ([#354](https://github.com/fused-effects/fused-effects/pull/354))++- Adds labelled interface for `Reader` and `State` effects in `Control.Effect.Reader.Labelled` and `Control.Effect.State.Labelled`. The functions in this interface are identical to their parent effect save that they accept a label parameter as an explicit type argument, suitable for use with an explicit type application; this can clean up code that would otherwise need an invocation of `runUnderLabel` to associate a labelled operation with its label. ([#354](https://github.com/fused-effects/fused-effects/pull/354))++- Adds a `sendIO` operation for the `Lift IO` effect. ([#360](https://github.com/fused-effects/fused-effects/pull/360))++- Inlines the `Reader` operations. ([#347](https://github.com/fused-effects/fused-effects/pull/347))++ # v1.0.0.1  - Adds passthrough `Algebra` instances for `Ap` and `Alt`, allowing the invocation of effects inside these structures without extraneous constructor applications. + # v1.0.0.0  - Adds an `Empty` effect, modelling nondeterminism without choice ([#196](https://github.com/fused-effects/fused-effects/pull/196)).@@ -82,6 +100,7 @@  - Adds support for ghc 8.8.1. + # v0.5.0.0  - Derives `Generic1` instances for all non-existentially-quantified effect datatypes.@@ -94,6 +113,7 @@  - Re-exports `Carrier`, `Member`, and `run` from the various effect modules, reducing the number of imports needed when using existing effects. + ## Backwards-incompatible changes  - Replaces `runResource` with an equivalent function that uses `MonadUnliftIO` to select the correct unlifting function (a la `withResource`, which is removed in favor of `runResource`).@@ -112,23 +132,27 @@  - Deprecates `handlePure` in favour of `hmap`. + # v0.4.0.0  ## Backwards-incompatible changes  - Removes APIs deprecated in 0.3.0.0, including `Eff`, `interpret`, `ret`, and the `handle*` family of helper functions. + ## Other changes  - Adds the ability to derive default instances of `HFunctor` and `Effect` for first-order effects, using the `-XDeriveAnyClass` extension. - Adds a generic `Interpose` effect that enables arbitrary "eavesdropping" on other effects. + # 0.3.1.0  - Improved speed of `Reader`, `State`, `Writer`, and `Pure` effects by defining and inlining auxiliary `Applicative` methods. - Adds `runInterpret` & `runInterpretState` handlers in `Control.Effect.Interpret` as a convenient way to experiment with effect handlers without defining a new carrier type and `Carrier` instance. Such handlers are somewhat less efficient than custom `Carrier`s, but allow for a smooth upgrade path when more efficiency is required. - Added `unliftio-core` as a dependency so as to provide a blessed API for unlift-style effects and a solution to the cubic-caller problem. + # 0.3.0.0  ## Backwards-incompatible changes@@ -142,6 +166,7 @@ - Renames `Control.Effect.Void`, `Void`, and `VoidC` to `Control.Effect.Pure`, `Pure`, and `PureC` respectively.   This is a backwards-incompatible change for code mentioning `VoidC`; it should be updated to reference `PureC` instead. + ## Deprecations  - `Eff` and `interpret`, in favour of computing directly in the carriers. This enables the compiler to perform significant optimizations; see the benchmarks for details.@@ -152,6 +177,7 @@  All deprecated APIs will be removed in the next release. + ## Other changes  - Adds a lazy `State` carrier in `Control.Effect.State.Lazy`@@ -160,14 +186,17 @@ - Moves `OnceC` from `Control.Effect.NonDet` to `Control.Effect.Cull` to avoid cyclic dependencies. - Adds a `runCutAll` handler for `Cut` effects, returning a collection of all results. + # 0.2.0.2  - Loosens the bounds on QuickCheck to accommodate 2.x. + # 0.2.0.1  - Fixes the benchmarks, and builds them in CI to avoid regressing them again. + # 0.2.0.0  - Adds `listen`, `listens`, and `censor` operations to `Writer`.@@ -181,10 +210,12 @@ - Adds `bracketOnError`, `finally`, and `onException` to `Resource`. - Adds `sendM` to `Lift`. + # 0.1.2.1  - Loosens the bounds on QuickCheck to accommodate 0.12. + # 0.1.2.0  - Adds support for ghc 8.6.2, courtesy of @jkachmar.@@ -193,9 +224,11 @@ - Adds an example of using `NonDet`, `Cut`, and a character parser effect to define parsers. - Fixes the table of contents links in the README. + # 0.1.1.0  - Adds a `runNonDetOnce` handler which terminates immediately upon finding a solution.+  # 0.1.0.0 

@@ -1,21 +1,31 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes, TypeApplications, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Avoid lambda" #-} module Main ( main ) where -import Control.Algebra-import Control.Carrier.Interpret-import Control.Carrier.State.Strict-import Control.Carrier.Writer.Strict-import Control.Monad (replicateM_)-import Data.Monoid (Sum(..))-import Gauge+import           Control.Algebra+import           Control.Carrier.Interpret+import           Control.Carrier.State.Strict+import           Control.Carrier.Writer.Strict+import           Control.Monad (replicateM_)+import           Data.Monoid (Sum(..))+import           Gauge +import qualified Bench.Reader as Reader import qualified Bench.NonDet as NonDet  main :: IO () main = defaultMain-  [ NonDet.benchmark+  [ Reader.benchmark+  , NonDet.benchmark   , bgroup "WriterC"     [ bench "100"   $ whnf (run . execWriter @(Sum Int) . tellLoop) 100     , bench "1000"  $ whnf (run . execWriter @(Sum Int) . tellLoop) 1000@@ -51,4 +61,4 @@ tellLoop i = replicateM_ i (tell (Sum (1 :: Int)))  modLoop :: Has (State (Sum Int)) sig m => Int -> m ()-modLoop i = replicateM_ i (modify (+ (Sum (1 :: Int))))+modLoop i = replicateM_ i (modify (+ Sum (1 :: Int)))

@@ -3,10 +3,10 @@ ( benchmark ) where -import Control.Algebra+import qualified Bench.NonDet.NQueens as NQueens+import           Control.Algebra import qualified Control.Carrier.NonDet.Church as NonDet.Church import           Gauge hiding (benchmark)-import qualified Bench.NonDet.NQueens as NQueens  benchmark :: Gauge.Benchmark benchmark = bgroup "NonDet"

@@ -1,5 +1,8 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes,-             TypeApplications, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- Based largely on the implementation by Sreekar Shastry,

@@ -0,0 +1,30 @@+{-# LANGUAGE TypeApplications #-}++module Bench.Reader+( benchmark+) where++import Control.Carrier.Reader+import Control.Monad++import Gauge hiding (benchmark)++asking :: Has (Reader Char) sig m => Int -> m ()+asking i = replicateM_ i (ask @Char)++locally :: Has (Reader Char) sig m => Int -> m ()+locally i = replicateM_ i (local @Char succ (ask @Char))++benchmark :: Gauge.Benchmark+benchmark = bgroup "Control.Carrier.Reader"+  [ bgroup "ask"+    [ bench "10" $ whnf (run . runReader 'a' . asking) 10+    , bench "100" $ whnf (run . runReader 'b' . asking) 100+    , bench "1000" $ whnf (run . runReader 'c' . asking) 1000+    ]+  , bgroup "local"+    [ bench "10" $ whnf (run . runReader 'a' . locally) 10+    , bench "100" $ whnf (run . runReader 'b' . locally) 100+    , bench "1000" $ whnf (run . runReader 'c' . locally) 1000+    ]+  ]

@@ -0,0 +1,73 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+module Labelled+( example+) where++import Test.Tasty+import Test.Tasty.HUnit+import Control.Applicative+import Control.Effect.Labelled+import Control.Carrier.Reader+import Control.Carrier.State.Strict+import qualified Control.Effect.Reader.Labelled as L+import qualified Control.Effect.State.Labelled as L++sample :: ( HasLabelled "fore" (Reader Int) sig m+          , HasLabelled "aft" (Reader Int) sig m+          )+       => m Int+sample = liftA2 (+) (runUnderLabel @"fore" ask) (runUnderLabel @"aft" ask)++withHelpers :: ( HasLabelled "fore" (Reader Int) sig m+               , HasLabelled "aft" (Reader Int) sig m+               )+            => m Int+withHelpers = liftA2 (+) (L.ask @"fore") (L.ask @"aft")++numerically :: ( HasLabelled 1 (Reader Int) sig m+               , HasLabelled 2 (Reader Int) sig m+               )+            => m Int+numerically = liftA2 (+) (L.ask @1) (L.ask @2)++readerExamples :: TestTree+readerExamples = testGroup "Reader"+  [ testCase "runUnderLabel"           ((run (runReader (5 :: Int) (runLabelled @"fore" (runReader (10 :: Int) (runLabelled @"aft" sample))))) @=? 15)+  , testCase "Reader.Labelled helpers" ((run (runReader (5 :: Int) (runLabelled @"fore" (runReader (10 :: Int) (runLabelled @"aft" withHelpers))))) @=? 15)+  , testCase "Nat labels"              ((run (runReader (5 :: Int) (runLabelled @1 (runReader (10 :: Int) (runLabelled @2 numerically))))) @=? 15)+  ]++sampleS :: ( HasLabelled "fore" (State Int) sig m+          , HasLabelled "aft" (State Int) sig m+          )+       => m Int+sampleS = liftA2 (+) (runUnderLabel @"fore" get) (runUnderLabel @"aft" get)++helpersS :: ( HasLabelled "fore" (State Int) sig m+               , HasLabelled "aft" (State Int) sig m+               )+            => m Int+helpersS = liftA2 (+) (L.get @"fore") (L.get @"aft")++boolean :: ( HasLabelled 'True (State Int) sig m+           , HasLabelled 'False (State Int) sig m+           )+            => m Int+boolean = liftA2 (+) (L.get @'True) (L.get @'False)++stateExamples :: TestTree+stateExamples = testGroup "State"+  [ testCase "runUnderLabel"          ((run (evalState (5 :: Int) (runLabelled @"fore" (evalState (10 :: Int) (runLabelled @"aft" sampleS))))) @=? 15)+  , testCase "State.Labelled helpers" ((run (evalState (5 :: Int) (runLabelled @"fore" (evalState (10 :: Int) (runLabelled @"aft" helpersS))))) @=? 15)+  , testCase "Boolean labels"         ((run (evalState (5 :: Int) (runLabelled @'True (evalState (10 :: Int) (runLabelled @'False boolean))))) @=? 15)+  ]+++example :: TestTree+example = testGroup "Control.Effect.Labelled"+  [ readerExamples+  , stateExamples+  ]+

@@ -3,6 +3,7 @@ ) where  import qualified Inference+import qualified Labelled import qualified Parser import qualified ReinterpretLog import qualified Teletype@@ -14,4 +15,5 @@   , Parser.example   , ReinterpretLog.example   , Teletype.example+  , Labelled.example   ]

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                fused-effects-version:             1.0.0.1+version:             1.0.2.0 synopsis:            A fast, flexible, fused effect system. description:         A fast, flexible, fused effect system, à la Effect Handlers in Scope, Monad Transformers and Modular Algebraic Effects: What Binds Them Together, and Fusion for Free—Efficient Algebraic Effect Handlers. homepage:            https://github.com/fused-effects/fused-effects@@ -20,7 +20,7 @@   GHC == 8.2.2   GHC == 8.4.4   GHC == 8.6.5-  GHC == 8.8.1+  GHC == 8.8.3  common common   default-language: Haskell2010@@ -74,10 +74,13 @@     Control.Effect.Error     Control.Effect.Fail     Control.Effect.Fresh+    Control.Effect.Labelled     Control.Effect.Lift     Control.Effect.NonDet     Control.Effect.Reader+    Control.Effect.Reader.Labelled     Control.Effect.State+    Control.Effect.State.Labelled     Control.Effect.Sum     Control.Effect.Throw     Control.Effect.Trace@@ -105,6 +108,7 @@   main-is:        Main.hs   other-modules:     Inference+    Labelled     Parser     ReinterpretLog     Teletype@@ -177,6 +181,7 @@   hs-source-dirs: benchmark   main-is:        Bench.hs   other-modules:+    Bench.Reader     Bench.NonDet     Bench.NonDet.NQueens   build-depends:

@@ -1,4 +1,11 @@-{-# LANGUAGE CPP, ConstraintKinds, DeriveFunctor, FlexibleInstances, FunctionalDependencies, RankNTypes, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | The 'Algebra' class is the mechanism with which effects are interpreted. @@ -16,21 +23,19 @@ , module Control.Effect.Class ) where -import Control.Effect.Catch.Internal-import Control.Effect.Choose.Internal-import Control.Effect.Class-import Control.Effect.Empty.Internal-import Control.Effect.Error.Internal-import Control.Effect.Lift.Internal-import Control.Effect.NonDet.Internal-import Control.Effect.Reader.Internal-import Control.Effect.State.Internal-import Control.Effect.Sum ((:+:)(..), Member(..), Members)-import Control.Effect.Throw.Internal-import Control.Effect.Writer.Internal-import Control.Monad ((<=<))-import Data.Coerce-import Data.Functor.Identity+import           Control.Effect.Catch.Internal+import           Control.Effect.Choose.Internal+import           Control.Effect.Class+import           Control.Effect.Empty.Internal+import           Control.Effect.Error.Internal+import           Control.Effect.Lift.Internal+import           Control.Effect.NonDet.Internal+import           Control.Effect.Reader.Internal+import           Control.Effect.State.Internal+import           Control.Effect.Sum ((:+:)(..), Member(..), Members)+import           Control.Effect.Throw.Internal+import           Control.Effect.Writer.Internal+import           Control.Monad ((<=<)) import qualified Control.Monad.Trans.Except as Except import qualified Control.Monad.Trans.Identity as Identity import qualified Control.Monad.Trans.Reader as Reader@@ -40,10 +45,12 @@ import qualified Control.Monad.Trans.State.Strict as State.Strict import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict-import Data.List.NonEmpty (NonEmpty)-import Data.Monoid+import           Data.Coerce+import           Data.Functor.Identity+import           Data.List.NonEmpty (NonEmpty)+import           Data.Monoid import qualified Data.Semigroup as S-import Data.Tuple (swap)+import           Data.Tuple (swap)  -- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'alg' method. --@@ -135,7 +142,7 @@ #endif  -- | This instance permits effectful actions to be lifted into the 'Alt' monad,--- which eases the invocation of repeated alternation with '<|>':+-- which eases the invocation of repeated alternation with 'Control.Applicative.<|>': -- -- > a <|> b <|> c <|> d --@@ -150,7 +157,7 @@ instance Algebra sig m => Algebra (Reader r :+: sig) (Reader.ReaderT r m) where   alg (L (Ask       k)) = Reader.ask >>= k   alg (L (Local f m k)) = Reader.local f m >>= k-  alg (R other)         = Reader.ReaderT $ \ r -> alg (hmap (flip Reader.runReaderT r) other)+  alg (R other)         = Reader.ReaderT $ \ r -> alg (hmap (`Reader.runReaderT` r) other)  newtype RWSTF w s a = RWSTF { unRWSTF :: (a, s, w) }   deriving (Functor)

@@ -1,4 +1,10 @@-{-# LANGUAGE DeriveTraversable, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | A carrier for 'Choose' effects (nondeterminism without failure). @@ -16,18 +22,18 @@ , module Control.Effect.Choose ) where -import Control.Algebra-import Control.Applicative (liftA2)-import Control.Effect.Choose+import           Control.Algebra+import           Control.Applicative (liftA2)+import           Control.Effect.Choose import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Coerce (coerce)-import Data.Functor.Identity-import Data.List.NonEmpty (NonEmpty(..), head, tail)+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Coerce (coerce)+import           Data.Functor.Identity+import           Data.List.NonEmpty (NonEmpty(..), head, tail) import qualified Data.Semigroup as S-import Prelude hiding (head, tail)+import           Prelude hiding (head, tail)  -- | Run a 'Choose' effect with continuations respectively interpreting '<|>' and 'pure'. --

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for 'Cull' and 'NonDet' effects used in tandem (@Cull :+: NonDet@). --@@ -15,16 +20,16 @@ , module Control.Effect.NonDet ) where -import Control.Algebra-import Control.Applicative (liftA2)-import Control.Carrier.NonDet.Church-import Control.Carrier.Reader-import Control.Effect.Cull-import Control.Effect.NonDet+import           Control.Algebra+import           Control.Applicative (liftA2)+import           Control.Carrier.NonDet.Church+import           Control.Carrier.Reader+import           Control.Effect.Cull+import           Control.Effect.NonDet import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Cull' effect with continuations respectively interpreting '<|>', 'pure', and 'empty'. Branches outside of any 'cull' block will not be pruned. --

@@ -1,4 +1,9 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for 'Cut' and 'NonDet' effects used in tandem (@Cut :+: NonDet@). --@@ -15,16 +20,16 @@ , module Control.Effect.NonDet ) where -import Control.Algebra-import Control.Applicative (liftA2)-import Control.Effect.Cut-import Control.Effect.NonDet+import           Control.Algebra+import           Control.Applicative (liftA2)+import           Control.Effect.Cut+import           Control.Effect.NonDet import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Coerce (coerce)-import Data.Functor.Identity+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Coerce (coerce)+import           Data.Functor.Identity  -- | Run a 'Cut' effect with continuations respectively interpreting 'pure' / '<|>', 'empty', and 'cutfail'. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | A carrier for an 'Empty' effect, indicating failure with a 'Nothing' value. Users that need access to an error message should use the 'Control.Effect.Fail.Fail' effect. @@ -15,13 +19,13 @@ , module Control.Effect.Empty ) where -import Control.Algebra-import Control.Effect.Empty+import           Control.Algebra+import           Control.Effect.Empty import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe  -- | Run an 'Empty' effect, returning 'Nothing' for empty computations, or 'Just' the result otherwise. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for an 'Error' effect. --@@ -11,15 +15,15 @@ , module Control.Effect.Error ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Effect.Error-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Effect.Error+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Trans.Except+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Except  -- | Run an 'Error' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for a 'Control.Effect.Fail.Fail' effect, returning the result as an 'Either' 'String'. Failed computations will return a 'Left' containing the 'String' value passed to 'Fail.fail'. --@@ -11,15 +15,15 @@ , module Control.Effect.Fail ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Carrier.Throw.Either-import Control.Effect.Fail-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Carrier.Throw.Either+import           Control.Effect.Fail+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Control.Effect.Fail.Fail' effect, returning failure messages in 'Left' and successful computations’ results in 'Right'. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for a 'Fresh' effect, providing access to a monotonically increasing stream of 'Int' values. --@@ -12,15 +16,15 @@ , module Control.Effect.Fresh ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Carrier.State.Strict-import Control.Effect.Fresh-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Carrier.State.Strict+import           Control.Effect.Fresh+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Fresh' effect counting up from 0. --

@@ -1,4 +1,13 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Provides an 'InterpretC' carrier capable of interpreting an arbitrary effect using a passed-in higher order function to interpret that effect. This is suitable for prototyping new effects quickly. @@ -15,16 +24,16 @@ , run ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Carrier.State.Strict-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Carrier.State.Strict+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Functor.Const (Const(..))-import Unsafe.Coerce (unsafeCoerce)+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Functor.Const (Const(..))+import           Unsafe.Coerce (unsafeCoerce)  -- | A @Handler@ is a function that interprets effects described by @sig@ into the carrier monad @m@. newtype Handler sig m = Handler@@ -72,7 +81,7 @@   -> m (s, a) runInterpretState handler state m   = runState state-  $ runInterpret (\e -> StateC (\s -> handler s e)) m+  $ runInterpret (\e -> StateC (`handler` e)) m  -- | @since 1.0.0.0 newtype InterpretC s (sig :: (* -> *) -> * -> *) m a = InterpretC (m a)

@@ -1,4 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}  -- | A carrier for 'Lift' allowing monadic actions to be lifted from an outer context into an inner one with 'sendM', and for an inner context to run actions in an outer one with 'liftWith'. --@@ -11,15 +12,15 @@ , module Control.Effect.Lift ) where -import Control.Algebra-import Control.Applicative (Alternative)-import Control.Effect.Lift-import Control.Monad (MonadPlus)+import           Control.Algebra+import           Control.Applicative (Alternative)+import           Control.Effect.Lift+import           Control.Monad (MonadPlus) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Functor.Identity+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Functor.Identity  -- | Extract a 'Lift'ed 'Monad'ic action from an effectful computation. --

@@ -1,4 +1,9 @@-{-# LANGUAGE DeriveTraversable, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | Provides 'NonDetC', a carrier for 'NonDet' effects providing choice and failure. @@ -17,15 +22,15 @@ , module Control.Effect.NonDet ) where -import Control.Algebra-import Control.Applicative (liftA2)-import Control.Effect.NonDet+import           Control.Algebra+import           Control.Applicative (liftA2)+import           Control.Effect.NonDet import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Coerce (coerce)-import Data.Functor.Identity+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Coerce (coerce)+import           Data.Functor.Identity  -- | Run a 'NonDet' effect, using the provided functions to interpret choice, leaf results, and failure. --

@@ -1,4 +1,8 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for 'Reader' effects. --@@ -11,14 +15,14 @@ , module Control.Effect.Reader ) where -import Control.Algebra-import Control.Applicative (Alternative(..), liftA2)-import Control.Effect.Reader-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..), liftA2)+import           Control.Effect.Reader+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Reader' effect with the passed environment value. --

@@ -1,4 +1,8 @@-{-# LANGUAGE ExplicitForAll, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | A carrier for the 'State' effect that refrains from evaluating its state until necessary. This is less efficient than "Control.Carrier.State.Strict" but allows some cyclic computations to terminate that would loop infinitely in a strict state carrier. @@ -17,14 +21,14 @@ , module Control.Effect.State ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Effect.State-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Effect.State+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a lazy 'State' effect, yielding the result value and the final state. More programs terminate with lazy state than strict state, but injudicious use of lazy state may lead to thunk buildup. --@@ -80,7 +84,7 @@     ~(s'', x) <- mx s'     pure (s'', f x)   {-# INLINE (<*>) #-}-  m *> k = m >>= \_ -> k+  m *> k = m >>= const k   {-# INLINE (*>) #-}  instance Monad m => Monad (StateC s m) where

@@ -1,4 +1,9 @@-{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | A carrier for the 'State' effect. It evaluates its inner state strictly, which is the correct choice for the majority of use cases. @@ -16,14 +21,14 @@ , module Control.Effect.State ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Effect.State-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Effect.State+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'State' effect starting from the passed value. --@@ -77,7 +82,7 @@     (s'', a') <- a s'     pure (s'', f' a')   {-# INLINE (<*>) #-}-  m *> k = m >>= \_ -> k+  m *> k = m >>= const k   {-# INLINE (*>) #-}  instance (Alternative m, Monad m) => Alternative (StateC s m) where

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | A carrier for a 'Throw' effect.  @since 1.0.0.0@@ -11,15 +15,15 @@ , module Control.Effect.Throw ) where -import Control.Algebra-import Control.Applicative (Alternative)-import Control.Carrier.Error.Either-import Control.Effect.Throw-import Control.Monad (MonadPlus)+import           Control.Algebra+import           Control.Applicative (Alternative)+import           Control.Carrier.Error.Either+import           Control.Effect.Throw+import           Control.Monad (MonadPlus) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Throw' effect, returning failures in 'Left' and successful computations’ results in 'Right'. runThrow :: ThrowC e m a -> m (Either e a)

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for the 'Control.Effect.Trace' effect that ignores all traced results. Useful when you wish to disable tracing without removing all trace statements. --@@ -11,14 +15,14 @@ , module Control.Effect.Trace ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Effect.Trace-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Effect.Trace+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Trace' effect, ignoring all traces. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for the 'Control.Effect.Trace' effect that prints all traced results to stderr. --@@ -11,15 +15,15 @@ , module Control.Effect.Trace ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Effect.Trace-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Effect.Trace+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import System.IO+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           System.IO  -- | Run a 'Trace' effect, printing traces to 'stderr'. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | A carrier for the 'Control.Effect.Trace' effect that aggregates and returns all traced values. --@@ -11,17 +15,17 @@ , module Control.Effect.Trace ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Carrier.Writer.Strict-import Control.Effect.Trace-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Carrier.Writer.Strict+import           Control.Effect.Trace+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Bifunctor (first)-import Data.Monoid (Endo(..))+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.Bifunctor (first)+import           Data.Monoid (Endo(..))  -- | Run a 'Trace' effect, returning all traces as a list. --

@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | A carrier for 'Writer' effects. This carrier performs its append operations strictly and thus avoids the space leaks inherent in lazy writer monads. These appends are left-associative; as such, @[]@ is a poor choice of monoid for computations that entail many calls to 'tell'. The [Seq](http://hackage.haskell.org/package/containersdocs/Data-Sequence.html) or [DList](http://hackage.haskell.org/package/dlist) monoids may be a superior choice. @@ -16,15 +20,15 @@ , module Control.Effect.Writer ) where -import Control.Algebra-import Control.Applicative (Alternative(..))-import Control.Carrier.State.Strict-import Control.Effect.Writer-import Control.Monad (MonadPlus(..))+import           Control.Algebra+import           Control.Applicative (Alternative(..))+import           Control.Carrier.State.Strict+import           Control.Effect.Writer+import           Control.Monad (MonadPlus(..)) import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import           Control.Monad.Fix+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class  -- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log alongside the result value. --

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-} module Control.Effect.Catch.Internal ( Catch(..) ) where

@@ -29,11 +29,11 @@ , run ) where -import Control.Algebra-import Control.Effect.Choose.Internal (Choose(..))-import Control.Effect.Empty-import Data.Bool (bool)-import Data.List.NonEmpty (NonEmpty (..))+import           Control.Algebra+import           Control.Effect.Choose.Internal (Choose(..))+import           Control.Effect.Empty+import           Data.Bool (bool)+import           Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Semigroup as S  -- | Nondeterministically choose between two computations.

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} module Control.Effect.Choose.Internal ( Choose(..) ) where

@@ -1,4 +1,10 @@-{-# LANGUAGE DefaultSignatures, EmptyCase, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}  -- | Provides the 'HFunctor' and 'Effect' classes that effect types implement. --

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-} {- | Provides an effect to cull choices in a given nondeterministic context. This effect is used in concert with 'Control.Effect.NonDet.NonDet'.  Computations run inside a call to 'cull' will return at most one result.

@@ -1,4 +1,7 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, GeneralizedNewtypeDeriving, StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}  {- | Provides an effect to delimit backtracking in a given nondeterministic context. This effect is used in concert with 'Control.Effect.NonDet.NonDet'. 

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-} module Control.Effect.Empty.Internal ( Empty(..) ) where

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures, PatternSynonyms #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PatternSynonyms #-}  {- | An effect providing failure with an error message. @@ -23,7 +24,7 @@ , run ) where -import Control.Effect.Throw+import           Control.Effect.Throw import qualified Control.Monad.Fail as Fail  -- | @since 0.1.0.0

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}  {- | This effect provides source to an infinite source of 'Int' values, suitable for generating "fresh" values to uniquely identify data without needing to invoke random numbers or impure IO. @@ -22,8 +23,7 @@ import GHC.Generics (Generic1)  -- | @since 0.1.0.0-data Fresh m k-  = Fresh (Int -> m k)+newtype Fresh m k = Fresh (Int -> m k)   deriving (Functor, Generic1)  instance HFunctor Fresh

@@ -0,0 +1,129 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+-- | Labelled effects, allowing flexible disambiguation and dependency of parametric effects.+--+-- Among other things, this can be used to:+--+-- * Improve inference by relating parametric effect types to some arbitrary label. This can be used to lift existing effect operations, or to define new ones; cf "Control.Effect.Reader.Labelled", "Control.Effect.State.Labelled" for examples of lifting effect operations into labelled effect operations.+--+-- * Express stronger relationships between an effect and the context it’s run in, e.g. to give an effect shadowing semantics, allowing only one instance of it to be active at a time in a given context.+--+-- * Resolve ambiguous types by relating parameters to a concrete label type.+--+-- @since 1.0.2.0+module Control.Effect.Labelled+( runLabelled+, Labelled(Labelled)+, LabelledMember(..)+, HasLabelled+, sendLabelled+, runUnderLabel+, UnderLabel(UnderLabel)+, module Control.Algebra+) where++import Control.Algebra+import Control.Applicative (Alternative)+import Control.Effect.Sum (reassociateSumL)+import Control.Monad (MonadPlus)+import Control.Monad.Fail as Fail+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Kind (Type)++-- | An effect transformer turning effects into labelled effects, and a carrier transformer turning carriers into labelled carriers for the same (labelled) effects.+--+-- @since 1.0.2.0+newtype Labelled (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) m a = Labelled (sub m a)+  deriving (Alternative, Applicative, Effect, Functor, HFunctor, Monad, Fail.MonadFail, MonadIO, MonadPlus, MonadTrans)++-- | @since 1.0.2.0+runLabelled :: forall label sub m a . Labelled label sub m a -> sub m a+runLabelled (Labelled l) = l++instance (Algebra (eff :+: sig) (sub m), HFunctor eff, HFunctor sig) => Algebra (Labelled label eff :+: sig) (Labelled label sub m) where+  alg = \case+    L eff -> Labelled (send (handleCoercible (runLabelled eff)))+    R sig -> Labelled (send (handleCoercible sig))+  {-# INLINE alg #-}+++-- | The class of labelled types present in a signature.+--+-- @since 1.0.2.0+class LabelledMember label (sub :: (Type -> Type) -> (Type -> Type)) sup | label sup -> sub where+  -- | Inject a member of a signature into the signature.+  --+  -- @since 1.0.2.0+  injLabelled :: Labelled label sub m a -> sup m a++-- | Reflexivity: @t@ is a member of itself.+instance LabelledMember label t (Labelled label t) where+  injLabelled = id+  {-# INLINE injLabelled #-}++-- | Left-recursion: if @t@ is a member of @l1 ':+:' l2 ':+:' r@, then we can inject it into @(l1 ':+:' l2) ':+:' r@ by injection into a right-recursive signature, followed by left-association.+instance {-# OVERLAPPABLE #-}+         LabelledMember label t (l1 :+: l2 :+: r)+      => LabelledMember label t ((l1 :+: l2) :+: r) where+  injLabelled = reassociateSumL . injLabelled+  {-# INLINE injLabelled #-}++-- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1).+instance {-# OVERLAPPABLE #-}+         LabelledMember label l (Labelled label l :+: r) where+  injLabelled = L+  {-# INLINE injLabelled #-}++-- | Right-recursion: if @t@ is a member of @r@, we can inject it into @r@ in O(n), followed by lifting that into @l ':+:' r@ in O(1).+instance {-# OVERLAPPABLE #-}+         LabelledMember label l r+      => LabelledMember label l (l' :+: r) where+  injLabelled = R . injLabelled+  {-# INLINE injLabelled #-}+++-- | @m@ is a carrier for @sig@ containing @eff@ associated with @label@.+--+-- Note that if @eff@ is a sum, it will /not/ be decomposed into multiple 'LabelledMember' constraints. While this technically is possible, it results in unsolvable constraints, as the functional dependencies in 'Labelled' prevent assocating the same label with multiple distinct effects within a signature.+--+-- @since 1.0.2.0+type HasLabelled label eff sig m = (LabelledMember label eff sig, Algebra sig m)++-- | Construct a request for a labelled effect to be interpreted by some handler later on.+--+-- @since 1.0.2.0+sendLabelled :: forall label eff sig m a . HasLabelled label eff sig m => eff m a -> m a+sendLabelled = alg . injLabelled @label . Labelled+{-# INLINABLE sendLabelled #-}+++-- | A transformer to lift effectful actions to labelled effectful actions.+--+-- @since 1.0.2.0+newtype UnderLabel (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) (m :: Type -> Type) a = UnderLabel (m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadIO, MonadPlus)++-- | @since 1.0.2.0+runUnderLabel :: forall label sub m a . UnderLabel label sub m a -> m a+runUnderLabel (UnderLabel l) = l++instance MonadTrans (UnderLabel sub label) where+  lift = UnderLabel+  {-# INLINE lift #-}++instance (LabelledMember label sub sig, HFunctor sub, Algebra sig m) => Algebra (sub :+: sig) (UnderLabel label sub m) where+  alg = \case+    L sub -> UnderLabel (sendLabelled @label (handleCoercible sub))+    R sig -> UnderLabel (send (handleCoercible sig))+  {-# INLINE alg #-}

@@ -17,6 +17,7 @@ ( -- * Lift effect   Lift(..) , sendM+, sendIO , liftWith   -- * Re-exports , Algebra@@ -36,13 +37,21 @@ sendM :: (Has (Lift n) sig m, Functor n) => n a -> m a sendM m = send (LiftWith (\ ctx _ -> (<$ ctx) <$> m) pure) +-- | A type-restricted variant of 'sendM' for 'IO' actions.+--+-- This is particularly useful when you have a @'Has' ('Lift' 'IO') sig m@ constraint for the use of 'liftWith', and want to run an action abstracted over 'Control.Monad.IO.Class.MonadIO'. 'IO' has a 'Control.Monad.IO.Class.MonadIO' instance, and 'sendIO'’s type restricts the action’s type to 'IO' without further type annotations.+--+-- @since 1.0.2.0+sendIO :: Has (Lift IO) sig m => IO a -> m a+sendIO = sendM + -- | Run actions in an outer context. -- -- This can be used to provide interoperation with @base@ functionality like @"Control.Exception".'Control.Exception.catch'@: -- -- @--- 'liftWith' $ \ ctx hdl -> 'Control.Exception.catch' (hdl (m <$ ctx)) (hdl . (<$ ctx) . h)+-- 'liftWith' $ \\ ctx hdl -> 'Control.Exception.catch' (hdl (m <$ ctx)) (hdl . (<$ ctx) . h) -- @ -- -- The higher-order function takes both an initial context, and a handler phrased as the same sort of distributive law as described in the documentation for 'thread'. This handler takes actions lifted into a context functor, which can be either the initial context, or the derived context produced by handling a previous action.

@@ -1,4 +1,5 @@-{-# LANGUAGE ExistentialQuantification, RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-} module Control.Effect.Lift.Internal ( Lift(..) ) where

@@ -38,6 +38,7 @@ -- @since 0.1.0.0 ask :: Has (Reader r) sig m => m r ask = send (Ask pure)+{-# INLINE ask #-}  -- | Project a function out of the current environment value. --@@ -48,6 +49,7 @@ -- @since 0.1.0.0 asks :: Has (Reader r) sig m => (r -> a) -> m a asks f = send (Ask (pure . f))+{-# INLINE asks #-}  -- | Run a computation with an environment value locally modified by the passed function. --@@ -58,3 +60,4 @@ -- @since 0.1.0.0 local :: Has (Reader r) sig m => (r -> r) -> m a -> m a local f m = send (Local f m pure)+{-# INLINE local #-}

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-} module Control.Effect.Reader.Internal ( Reader(..) ) where

@@ -0,0 +1,57 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeApplications #-}+-- | Labelled 'Reader' operations.+--+-- @since 1.0.2.0+module Control.Effect.Reader.Labelled+( -- * Reader effect+  Reader+, ask+, asks+, local+  -- * Re-exports+, Algebra+, Effect+, Has+, run+) where++import           Control.Effect.Labelled+import qualified Control.Effect.Reader as R+import           Control.Effect.Reader.Internal++-- | Retrieve the environment value.+--+-- @+-- runReader a ('runLabelled' @label ('ask' @label) '>>=' k) = runReader a (k a)+-- @+--+-- @since 1.0.2.0+ask :: forall label r m sig . HasLabelled label (Reader r) sig m => m r+ask = runUnderLabel @label R.ask+{-# INLINE ask #-}++-- | Project a function out of the current environment value.+--+-- @+-- 'asks' @label f = 'fmap' f ('ask' @label)+-- @+--+-- @since 1.0.2.0+asks :: forall label r m a sig . HasLabelled label (Reader r) sig m => (r -> a) -> m a+asks f = runUnderLabel @label (R.asks f)+{-# INLINE asks #-}++-- | Run a computation with an environment value locally modified by the passed function.+--+-- @+-- runReader a ('runLabelled' @label ('local' @label f m)) = runReader (f a) m+-- @+--+-- @since 1.0.2.0+local :: forall label r m a sig . HasLabelled label (Reader r) sig m => (r -> r) -> m a -> m a+local f m = runUnderLabel @label (R.local f (UnderLabel m))+{-# INLINE local #-}

@@ -22,6 +22,7 @@ , put , modify , modifyLazy+, state   -- * Re-exports , Algebra , Effect@@ -90,3 +91,16 @@ modifyLazy :: Has (State s) sig m => (s -> s) -> m () modifyLazy f = get >>= put . f {-# INLINEABLE modifyLazy #-}++-- | Compute a new state and a value in a single step.+--+-- @+-- 'state' f = 'gets' f '>>=' \\ (s, a) -> 'put' s '>>' 'pure' a+-- @+--+-- @since 1.0.2.0+state :: Has (State s) sig m => (s -> (s, a)) -> m a+state f = do+  (s', a) <- gets f+  a <$ put s'+{-# INLINEABLE state #-}

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} module Control.Effect.State.Internal ( State(..) ) where

@@ -0,0 +1,95 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- | Labelled 'State' operations.+--+-- @since 1.0.2.0+module Control.Effect.State.Labelled+( -- * State effect+  State+, get+, gets+, put+, modify+, modifyLazy+, state+  -- * Re-exports+, Algebra+, Effect+, Has+, run+) where++import           Control.Effect.Labelled+import qualified Control.Effect.State as S+import           Control.Effect.State.Internal++-- | Get the current state value.+--+-- @+-- runState a ('runLabelled' @label ('get' @label) '>>=' k) = runState a (k a)+-- @+--+-- @since 1.0.2.0+get :: forall label s m sig . HasLabelled label (State s) sig m => m s+get = runUnderLabel @label S.get+{-# INLINEABLE get #-}++-- | Project a function out of the current state value.+--+-- @+-- 'gets' f = 'fmap' f 'get'+-- @+--+-- @since 1.0.2.0+gets :: forall label s m a sig . HasLabelled label (State s) sig m => (s -> a) -> m a+gets f = runUnderLabel @label (S.gets f)+{-# INLINEABLE gets #-}++-- | Replace the state value with a new value.+--+-- @+-- runState a ('runLabelled' @label ('put' @label b) '>>' m) = runState b m+-- @+--+-- @since 1.0.2.0+put :: forall label s m sig . HasLabelled label (State s) sig m => s -> m ()+put s = runUnderLabel @label (S.put s)+{-# INLINEABLE put #-}++-- | Replace the state value with the result of applying a function to the current state value.+--   This is strict in the new state.+--+-- @+-- 'modify' f = 'get' '>>=' ('put' . f '$!')+-- @+--+-- @since 1.0.2.0+modify :: forall label s m sig . HasLabelled label (State s) sig m => (s -> s) -> m ()+modify f = runUnderLabel @label (S.modify f)+{-# INLINEABLE modify #-}++-- | Replace the state value with the result of applying a function to the current state value.+--   This is lazy in the new state; injudicious use of this function may lead to space leaks.+--+-- @+-- 'modifyLazy' f = 'get' '>>=' 'put' . f+-- @+--+-- @since 1.0.2.0+modifyLazy :: forall label s m sig . HasLabelled label (State s) sig m => (s -> s) -> m ()+modifyLazy f = runUnderLabel @label (S.modifyLazy f)+{-# INLINEABLE modifyLazy #-}++-- | Compute a new state and a value in a single step.+--+-- @+-- 'state' f = 'gets' f '>>=' \\ (s, a) -> 'put' s '>>' 'pure' a+-- @+--+-- @since 1.0.2.0+state :: forall label s m a sig . HasLabelled label (State s) sig m => (s -> (s, a)) -> m a+state f = runUnderLabel @label (S.state f)+{-# INLINEABLE state #-}

@@ -1,4 +1,11 @@-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Operations on /sums/, combining effects into a /signature/. --@@ -9,6 +16,7 @@ , Members   -- * Sums , (:+:)(..)+, reassociateSumL ) where  import Control.Effect.Class@@ -41,26 +49,38 @@ -- | Reflexivity: @t@ is a member of itself. instance Member t t where   inj = id+  {-# INLINE inj #-}  -- | Left-recursion: if @t@ is a member of @l1 ':+:' l2 ':+:' r@, then we can inject it into @(l1 ':+:' l2) ':+:' r@ by injection into a right-recursive signature, followed by left-association. instance {-# OVERLAPPABLE #-}          Member t (l1 :+: l2 :+: r)       => Member t ((l1 :+: l2) :+: r) where-  inj = reassoc . inj where-    reassoc (L l)     = L (L l)-    reassoc (R (L l)) = L (R l)-    reassoc (R (R r)) = R r+  inj = reassociateSumL . inj+  {-# INLINE inj #-}  -- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1). instance {-# OVERLAPPABLE #-}          Member l (l :+: r) where   inj = L+  {-# INLINE inj #-}  -- | Right-recursion: if @t@ is a member of @r@, we can inject it into @r@ in O(n), followed by lifting that into @l ':+:' r@ in O(1). instance {-# OVERLAPPABLE #-}          Member l r       => Member l (l' :+: r) where   inj = R . inj+  {-# INLINE inj #-}+++-- | Reassociate a right-nested sum leftwards.+--+-- @since 1.0.2.0+reassociateSumL :: (l1 :+: l2 :+: r) m a -> ((l1 :+: l2) :+: r) m a+reassociateSumL = \case+  L l     -> L (L l)+  R (L l) -> L (R l)+  R (R r) -> R r+{-# INLINE reassociateSumL #-}   -- | Decompose sums on the left into multiple 'Member' constraints.

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-} module Control.Effect.Throw.Internal ( Throw(..) ) where@@ -7,8 +9,7 @@ import GHC.Generics (Generic1)  -- | @since 1.0.0.0-data Throw e (m :: * -> *) k-  = Throw e+newtype Throw e (m :: * -> *) k = Throw e   deriving (Functor, Generic1)  instance HFunctor (Throw e)

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}  {- | An effect that provides a record of 'String' values ("traces") aggregate during the execution of a given computation. 

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}  {- | An effect allowing writes to an accumulated quantity alongside a computed value. A 'Writer' @w@ effect keeps track of a monoidal datum of type @w@ and strictly appends to that monoidal value with the 'tell' effect. Writes to that value can be detected and intercepted with the 'listen' and 'censor' effects. 

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-} module Control.Effect.Writer.Internal ( Writer(..) ) where

@@ -1,4 +1,6 @@-{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Catch ( tests , genN

@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Choose ( tests , genN@@ -6,13 +9,13 @@ ) where  import qualified Control.Carrier.Choose.Church as ChooseC-import Control.Effect.Choose-import Data.List.NonEmpty-import Gen+import           Control.Effect.Choose+import           Data.List.NonEmpty+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Choose"

@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} -- GHC 8.2.2 warns that the Has Cull sig m constraint on gen0 is redundant, but doesn’t typecheck without it. Newer GHCs typecheck just fine either way and also don’t warn, so … whatever? {-# OPTIONS_GHC -Wno-redundant-constraints #-} module Cull@@ -9,15 +12,15 @@ ) where  import qualified Control.Carrier.Cull.Church as CullC-import Control.Effect.Choose-import Control.Effect.Cull-import Control.Effect.NonDet (NonDet)-import Gen+import           Control.Effect.Choose+import           Control.Effect.Cull+import           Control.Effect.NonDet (NonDet)+import           Gen import qualified Monad import qualified MonadFix import qualified NonDet-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Cull"

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Cut ( tests , gen0@@ -7,18 +12,18 @@ ) where  import qualified Control.Carrier.Cut.Church as CutC-import Control.Carrier.Reader-import Control.Effect.Choose-import Control.Effect.Cut (Cut, call, cutfail)-import Control.Effect.NonDet (NonDet)-import Data.Semigroup as S ((<>))-import Gen+import           Control.Carrier.Reader+import           Control.Effect.Choose+import           Control.Effect.Cut (Cut, call, cutfail)+import           Control.Effect.NonDet (NonDet)+import           Data.Semigroup as S ((<>))+import           Gen import qualified Monad import qualified MonadFix import qualified NonDet import qualified Reader-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Cut"

@@ -11,7 +11,7 @@ tests :: TestTree tests = testGroup "Cut.Church"   [ testCase "cutfail operates through higher-order effects" $-    (runCutA @[] (local (id @()) cutfail <|> pure 'a')) ()+    runCutA @[] (local (id @()) cutfail <|> pure 'a') ()     @?=-    (runCutA @[] (cutfail <|> pure 'a')) ()+    runCutA @[] (cutfail <|> pure 'a') ()   ]

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Empty ( tests , gen0@@ -6,13 +11,13 @@ ) where  import qualified Control.Carrier.Empty.Maybe as EmptyC-import Control.Effect.Empty-import Data.Maybe (maybeToList)-import Gen+import           Control.Effect.Empty+import           Data.Maybe (maybeToList)+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Empty"

@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Error ( tests , gen0@@ -6,19 +9,19 @@ , test ) where +import qualified Catch import qualified Control.Carrier.Error.Either as ErrorC-import Control.Effect.Error+import           Control.Effect.Error import qualified Control.Monad.Trans.Except as ExceptT-import qualified Catch-import Data.Semigroup as S ((<>))-import Gen+import           Data.Semigroup as S ((<>))+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty+import           Test.Tasty import qualified Throw  tests :: TestTree-tests = testGroup "Error" $+tests = testGroup "Error"   [ testGroup "ErrorC"  $     [ testMonad     , testMonadFix

@@ -1,4 +1,8 @@-{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Fail ( tests , gen0@@ -6,13 +10,13 @@ ) where  import qualified Control.Carrier.Fail.Either as FailC-import Control.Effect.Fail as Fail-import Gen-import Hedgehog.Range as Range+import           Control.Effect.Fail as Fail+import           Gen+import           Hedgehog.Range as Range import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Fail"

@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Fresh ( tests , gen@@ -6,13 +9,13 @@ ) where  import qualified Control.Carrier.Fresh.Strict as FreshC-import Control.Effect.Fresh-import Gen+import           Control.Effect.Fresh+import           Gen import qualified Hedgehog.Range as R import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Fresh"

@@ -1,4 +1,6 @@-{-# LANGUAGE MultiWayIf, TemplateHaskell, TypeApplications #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O2 -fplugin Test.Inspection.Plugin #-} module Fusion ( tests

@@ -1,4 +1,17 @@-{-# LANGUAGE DataKinds, DeriveFunctor, DeriveGeneric, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, LambdaCase, PatternSynonyms, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances, ViewPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-identities #-} module Gen ( module Data.Functor.Identity@@ -57,24 +70,24 @@ , Fn.apply ) where -import Control.Applicative-import Control.Monad.Trans.Class-import Control.Monad.Trans.Writer-import Data.Foldable (traverse_)-import Data.Function (on)-import Data.Functor.Classes (showsUnaryWith)-import Data.Functor.Identity-import Data.Proxy+import           Control.Applicative+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Writer+import           Data.Foldable (traverse_)+import           Data.Function (on)+import           Data.Functor.Classes (showsUnaryWith)+import           Data.Functor.Identity+import           Data.Proxy import qualified Data.Semigroup as S import qualified Data.Set as Set-import Data.String (fromString)-import GHC.Generics ((:.:)(..))-import GHC.Stack-import GHC.TypeLits-import Hedgehog+import           Data.String (fromString)+import           GHC.Generics ((:.:)(..))+import           GHC.Stack+import           GHC.TypeLits+import           Hedgehog import qualified Hedgehog.Function as Fn-import Hedgehog.Gen as Hedgehog-import Hedgehog.Range+import           Hedgehog.Gen as Hedgehog+import           Hedgehog.Range  -- | A generator for computations, given a higher-order generator for effectful operations, & a generator for results. m@@ -85,7 +98,7 @@   -> GenM m                                              -- ^ A computation generator. m terminals nonterminals = m where   m :: GenM m-  m = \ a -> Comp1 $ scale (`div` 2) $ recursive Hedgehog.choice+  m a = Comp1 $ scale (`div` 2) $ recursive Hedgehog.choice     (unComp1 <$> ((Gen.label "pure" pure <*> a) : terminals a))     ( unComp1 (addLabel ">>" (Gen.subtermM2 (m a) (m a) (\ a b -> infixL 1 ">>" (>>) <*> a <*> b)))     : (unComp1 <$> nonterminals m a))@@ -286,7 +299,7 @@     Pair -> showParen True (showString ",")     InfixL p s _ :<*> a :<*> b -> showParen (d > p) (showsPrec p a . showString " " . showString s . showString " " . showsPrec (succ p) b)     InfixR p s _ :<*> a :<*> b -> showParen (d > p) (showsPrec (succ p) a . showString " " . showString s . showString " " . showsPrec p b)-    Pair :<*> a :<*> b -> showParen True (showsPrec 0 a . showString ", " . showsPrec 0 b)+    Pair :<*> a :<*> b -> showParen True (shows a . showString ", " . shows b)     InfixL p s _ :<*> a -> showParen True (showsPrec p a . showString " " . showString s)     InfixR p s _ :<*> a -> showParen True (showsPrec (succ p) a . showString " " . showString s)     f :<*> a -> showParen (d > 10) (showsPrec 10 f . showString " " . showsPrec 11 a)

@@ -1,14 +1,13 @@-{-# LANGUAGE TypeApplications #-} module Lift ( tests ) where -import Control.Carrier.State.Strict-import Control.Effect.Lift+import           Control.Carrier.State.Strict+import           Control.Effect.Lift import qualified Control.Exception as E-import Control.Monad.IO.Class-import Test.Tasty-import Test.Tasty.HUnit+import           Control.Monad.IO.Class+import           Test.Tasty+import           Test.Tasty.HUnit  tests :: TestTree tests = testGroup "Lift"

@@ -1,9 +1,13 @@ {-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Monad law, left identity" #-}+{-# HLINT ignore "Monad law, right identity" #-}+{-# HLINT ignore "Use <$>" #-} module Monad ( test ) where -import Control.Monad ((>=>), ap)+import Control.Monad (ap, (>=>)) import Gen import Test.Tasty import Test.Tasty.Hedgehog@@ -19,7 +23,7 @@   -> [TestTree] test m a b c s (Run run) =   [ testProperty "return is the left-identity of >>=" . forall (s :. a :. fn (m b) :. Nil) $-    \ s a k -> run ((return a >>= k) <$ s) === run ((k a) <$ s)+    \ s a k -> run ((return a >>= k) <$ s) === run (k a <$ s)   , testProperty "return is the right-identity of >>=" . forall (s :. m a :. Nil) $     \ s m -> run ((m >>= return) <$ s) === run (m <$ s)   , testProperty ">>= is associative" . forall (s :. m a :. fn (m b) :. fn (m c) :. Nil) $

@@ -1,4 +1,8 @@ {-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Avoid lambda" #-}+{-# HLINT ignore "Avoid lambda using `infix`" #-}+{-# HLINT ignore "Use fmap" #-} module MonadFix ( test ) where

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Alternative law, left identity" #-}+{-# HLINT ignore "Alternative law, right identity" #-}+{-# HLINT ignore "Eta reduce" #-} module NonDet ( tests , gen0@@ -8,16 +13,16 @@  import qualified Choose import qualified Control.Carrier.NonDet.Church as Church.NonDetC-import Control.Effect.Choose-import Control.Effect.Empty-import Control.Effect.NonDet (NonDet)-import Data.Semigroup as S ((<>))+import           Control.Effect.Choose+import           Control.Effect.Empty+import           Control.Effect.NonDet (NonDet)+import           Data.Semigroup as S ((<>)) import qualified Empty-import Gen+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "NonDet"

@@ -4,7 +4,7 @@  import Control.Carrier.Error.Either import Control.Carrier.NonDet.Church-import Control.Carrier.State.Strict+import Control.Carrier.State.Strict hiding (state) import Prelude hiding (error) import Test.Tasty import Test.Tasty.HUnit

@@ -1,4 +1,10 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Reader ( tests , gen0@@ -7,17 +13,17 @@ ) where  import qualified Control.Carrier.Reader as ReaderC-import Control.Effect.Reader+import           Control.Effect.Reader import qualified Control.Monad.Trans.Reader as ReaderT import qualified Control.Monad.Trans.RWS.Lazy as LazyRWST import qualified Control.Monad.Trans.RWS.Strict as StrictRWST-import Data.Function ((&))-import Gen-import GHC.Generics ((:.:)(..))+import           Data.Function ((&))+import           Gen+import           GHC.Generics ((:.:)(..)) import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Reader"

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module State ( tests , gen0@@ -7,17 +12,17 @@  import qualified Control.Carrier.State.Lazy as LazyStateC import qualified Control.Carrier.State.Strict as StrictStateC-import Control.Effect.State+import           Control.Effect.State import qualified Control.Monad.Trans.RWS.Lazy as LazyRWST import qualified Control.Monad.Trans.RWS.Strict as StrictRWST import qualified Control.Monad.Trans.State.Lazy as LazyStateT import qualified Control.Monad.Trans.State.Strict as StrictStateT-import Data.Tuple (swap)-import Gen+import           Data.Tuple (swap)+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "State"

@@ -17,9 +17,9 @@ import qualified NonDet.Church import qualified Reader import qualified State+import           Test.Tasty import qualified Throw import qualified Writer-import Test.Tasty  main :: IO () main = defaultMain $ testGroup "unit tests"

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Throw ( tests , gen0@@ -6,12 +11,12 @@ ) where  import qualified Control.Carrier.Throw.Either as ThrowC-import Control.Effect.Throw-import Gen+import           Control.Effect.Throw+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Throw"

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Eta reduce" #-} module Writer ( tests , gen0@@ -6,20 +11,20 @@ , test ) where -import Control.Arrow ((&&&))+import           Control.Arrow ((&&&)) import qualified Control.Carrier.Writer.Strict as WriterC-import Control.Effect.Writer+import           Control.Effect.Writer import qualified Control.Monad.Trans.RWS.Lazy as LazyRWST import qualified Control.Monad.Trans.RWS.Strict as StrictRWST import qualified Control.Monad.Trans.Writer.Lazy as LazyWriterT import qualified Control.Monad.Trans.Writer.Strict as StrictWriterT-import Data.Bifunctor (first)-import Data.Tuple (swap)-import Gen+import           Data.Bifunctor (first)+import           Data.Tuple (swap)+import           Gen import qualified Monad import qualified MonadFix-import Test.Tasty-import Test.Tasty.Hedgehog+import           Test.Tasty+import           Test.Tasty.Hedgehog  tests :: TestTree tests = testGroup "Writer"