ether 0.4.2.0 → 0.5.0.0

raw patch · 55 files changed

+2368/−2053 lines, 55 filesdep +criteriondep +deepseqdep +ghc-primdep ~basedep ~template-haskelldep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, deepseq, ghc-prim, lens, reflection, tagged, writer-cps-mtl

Dependency ranges changed: base, template-haskell, transformers, transformers-lift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−2
• LICENSE +2/−2
• bench/Bench.hs +202/−0
• ether.cabal +174/−94
• src/Control/Ether/Abbr.hs +0/−60
• src/Control/Ether/Implicit/Abbr.hs +0/−25
• src/Control/Ether/TH.hs +0/−45
• src/Control/Ether/Util.hs +0/−33
• src/Control/Monad/Ether.hs +0/−14
• src/Control/Monad/Ether/Except.hs +0/−30
• src/Control/Monad/Ether/Except/Class.hs +0/−45
• src/Control/Monad/Ether/Implicit.hs +0/−14
• src/Control/Monad/Ether/Implicit/Except.hs +0/−62
• src/Control/Monad/Ether/Implicit/Reader.hs +0/−61
• src/Control/Monad/Ether/Implicit/State.hs +0/−8
• src/Control/Monad/Ether/Implicit/State/Lazy.hs +0/−86
• src/Control/Monad/Ether/Implicit/State/Strict.hs +0/−86
• src/Control/Monad/Ether/Implicit/Writer.hs +0/−81
• src/Control/Monad/Ether/Reader.hs +0/−19
• src/Control/Monad/Ether/Reader/Class.hs +0/−72
• src/Control/Monad/Ether/State.hs +0/−8
• src/Control/Monad/Ether/State/Class.hs +0/−74
• src/Control/Monad/Ether/State/Lazy.hs +0/−24
• src/Control/Monad/Ether/State/Strict.hs +0/−24
• src/Control/Monad/Ether/Writer.hs +0/−22
• src/Control/Monad/Ether/Writer/Class.hs +0/−83
• src/Control/Monad/Trans/Ether/Dispatch.hs +0/−256
• src/Control/Monad/Trans/Ether/Except.hs +0/−69
• src/Control/Monad/Trans/Ether/Reader.hs +0/−80
• src/Control/Monad/Trans/Ether/State.hs +0/−8
• src/Control/Monad/Trans/Ether/State/Lazy.hs +0/−94
• src/Control/Monad/Trans/Ether/State/Strict.hs +0/−94
• src/Control/Monad/Trans/Ether/Tagged.hs +0/−154
• src/Control/Monad/Trans/Ether/Writer.hs +0/−105
• src/Ether.hs +25/−0
• src/Ether/Except.hs +141/−0
• src/Ether/Internal.hs +179/−0
• src/Ether/Reader.hs +264/−0
• src/Ether/State.hs +471/−0
• src/Ether/TagDispatch.hs +188/−0
• src/Ether/TaggedTrans.hs +182/−0
• src/Ether/Writer.hs +327/−0
• test/Regression.hs +4/−0
• test/Regression/T1.hs +24/−14
• test/Regression/T10.hs +11/−10
• test/Regression/T11.hs +50/−0
• test/Regression/T12.hs +30/−0
• test/Regression/T2.hs +9/−11
• test/Regression/T3.hs +15/−16
• test/Regression/T4.hs +6/−7
• test/Regression/T5.hs +8/−11
• test/Regression/T6.hs +14/−16
• test/Regression/T7.hs +7/−6
• test/Regression/T8.hs +12/−13
• test/Regression/T9.hs +13/−15

@@ -1,7 +1,15 @@-0.4.2.0+0.5.0.0 ------- -* Add default MTL instances for DispatchT.+* Support only GHC 8.0 and higher.+* Use the `TypeApplications` extension to get rid of `Proxy`.+* Remove `Control.Ether.TH`.+* Remove `Control.Ether.Abbr`.+* Unify `Dispatch` and `TaggedTrans`.+* Better `MonadBase` and `MonadBaseControl` instances.+* Add flattening for `ReaderT` and `StateT`.+* Add zooming for `MonadState`.+* Simpler module structure.  0.4.1.0 -------

@@ -1,4 +1,4 @@-Copyright (c) 2015, Index Int+Copyright (c) 2017, Vladislav Zavialov  All rights reserved. @@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Index Int nor the names of other+    * Neither the name of Vladislav Zavialov nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

@@ -0,0 +1,202 @@+{-# OPTIONS -fno-warn-partial-type-signatures #-}++module Main (main) where++import Control.DeepSeq+import qualified Control.Lens as L+import qualified Control.Monad.Reader as M+import qualified Control.Monad.State as M+import Criterion.Main+import Ether++id' :: a -> a+id' = id+{-# NOINLINE id' #-}++readerCombinerMTL_flat_9+  :: M.MonadReader (Int, Int, Int, Int, Int, Int, Int, Int, Int) m+  => m ()+readerCombinerMTL_flat_9 = do+  rnf <$> sequenceA+    [ L.view L._1+    , L.view L._2+    , L.view L._3+    , L.view L._4+    , L.view L._5+    , L.view L._6+    , L.view L._7+    , L.view L._8+    , L.view L._9 ]+{-# NOINLINE readerCombinerMTL_flat_9 #-}++stateCombinerMTL_flat_9+  :: M.MonadState (Int, Int, Int, Int, Int, Int, Int, Int, Int) m+  => m ()+stateCombinerMTL_flat_9 = do+  M.modify (L.over L._1 id')+  M.modify (L.over L._2 id')+  M.modify (L.over L._3 id')+  M.modify (L.over L._4 id')+  M.modify (L.over L._5 id')+  M.modify (L.over L._6 id')+  M.modify (L.over L._7 id')+  M.modify (L.over L._8 id')+  M.modify (L.over L._9 id')+  rnf <$> sequenceA+    [ L.use L._1+    , L.use L._2+    , L.use L._3+    , L.use L._4+    , L.use L._5+    , L.use L._6+    , L.use L._7+    , L.use L._8+    , L.use L._9 ]+{-# NOINLINE stateCombinerMTL_flat_9 #-}++run_readerCombinerMTL_flat_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()+run_readerCombinerMTL_flat_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9) =+    M.runReader readerCombinerMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)++run_stateCombinerMTL_flat_9 ::+  (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->+    ((), (Int, Int, Int, Int, Int, Int, Int, Int, Int))+run_stateCombinerMTL_flat_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9) =+    M.runState stateCombinerMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)++readerCombinerEther_sep_9+  :: ( MonadReader 1 Int m+     , MonadReader 2 Int m+     , MonadReader 3 Int m+     , MonadReader 4 Int m+     , MonadReader 5 Int m+     , MonadReader 6 Int m+     , MonadReader 7 Int m+     , MonadReader 8 Int m+     , MonadReader 9 Int m )+    => m ()+readerCombinerEther_sep_9 = rnf <$> sequenceA+  [ ask @1+  , ask @2+  , ask @3+  , ask @4+  , ask @5+  , ask @6+  , ask @7+  , ask @8+  , ask @9 ]+{-# NOINLINE readerCombinerEther_sep_9 #-}++stateCombinerEther_sep_9+  :: ( MonadState 1 Int m+     , MonadState 2 Int m+     , MonadState 3 Int m+     , MonadState 4 Int m+     , MonadState 5 Int m+     , MonadState 6 Int m+     , MonadState 7 Int m+     , MonadState 8 Int m+     , MonadState 9 Int m )+    => m ()+stateCombinerEther_sep_9 = do+  modify @1 id'+  modify @2 id'+  modify @3 id'+  modify @4 id'+  modify @5 id'+  modify @6 id'+  modify @7 id'+  modify @8 id'+  modify @9 id'+  rnf <$> sequenceA+    [ get @1+    , get @2+    , get @3+    , get @4+    , get @5+    , get @6+    , get @7+    , get @8+    , get @9 ]+{-# NOINLINE stateCombinerEther_sep_9 #-}++run_readerCombinerEther_nested_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()+run_readerCombinerEther_nested_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9)+    = flip (runReader  @9) a1+    . flip (runReaderT @8) a2+    . flip (runReaderT @7) a3+    . flip (runReaderT @6) a4+    . flip (runReaderT @5) a5+    . flip (runReaderT @4) a6+    . flip (runReaderT @3) a7+    . flip (runReaderT @2) a8+    . flip (runReaderT @1) a9+    $ readerCombinerEther_sep_9++run_readerCombinerEther_flatten_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()+run_readerCombinerEther_flatten_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9)+    =+      runReaders+        readerCombinerEther_sep_9+          ( Tagged @1 a9,+            Tagged @2 a8,+            Tagged @3 a7,+            Tagged @4 a6,+            Tagged @5 a5,+            Tagged @6 a4,+            Tagged @7 a3,+            Tagged @8 a2,+            Tagged @9 a1 )++run_readerCombinerEther_flattenhalf_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()+run_readerCombinerEther_flattenhalf_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9) =+    flip runReaders+      ( Tagged @1 a9,+        Tagged @2 a8,+        Tagged @3 a7,+        Tagged @4 a6 ) .+    flip runReadersT+      ( Tagged @5 a5,+        Tagged @6 a4,+        Tagged @7 a3,+        Tagged @8 a2,+        Tagged @9 a1 ) $+    readerCombinerEther_sep_9++run_stateCombinerEther_flatten_9 ::+  (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->+    ((), _)+run_stateCombinerEther_flatten_9+  (a1, a2, a3, a4, a5, a6, a7, a8, a9)+    =+      runStates+        stateCombinerEther_sep_9+          ( Tagged @1 a9,+            Tagged @2 a8,+            Tagged @3 a7,+            Tagged @4 a6,+            Tagged @5 a5,+            Tagged @6 a4,+            Tagged @7 a3,+            Tagged @8 a2,+            Tagged @9 a1 )++tuple_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int)+tuple_9 = (1, -2, 3, -4, 5, -6, 7, -8, 9)++main :: IO ()+main = do+  defaultMain+    [ bench "readerCombinerMTL_flat_9" $ nf run_readerCombinerMTL_flat_9 tuple_9+    , bench "readerCombinerEther_nested_9" $ nf run_readerCombinerEther_nested_9 tuple_9+    , bench "readerCombinerEther_flatten_9" $ nf run_readerCombinerEther_flatten_9 tuple_9+    , bench "readerCombinerEther_flattenhalf_9" $+        nf run_readerCombinerEther_flattenhalf_9 tuple_9+    , bench "stateCombinerMTL_flat_9" $ nf run_stateCombinerMTL_flat_9 tuple_9+    , bench "stateCombinerEther_flatten_9" $ nf run_stateCombinerEther_flatten_9 tuple_9+    ]

@@ -1,5 +1,5 @@ name:                ether-version:             0.4.2.0+version:             0.5.0.0 synopsis:            Monad transformers and classes description:     Ether is a Haskell library that extends @mtl@ and @transformers@ with@@ -10,8 +10,8 @@ category:            Control license:             BSD3 license-file:        LICENSE-author:              Index Int-maintainer:          Index Int <vlad.z.4096@gmail.com>+author:              Vladislav Zavialov+maintainer:          Vladislav Zavialov <vlad.z.4096@gmail.com> homepage:            https://int-index.github.io/ether/ bug-reports:         https://github.com/int-index/ether/issues build-type:          Simple@@ -20,108 +20,188 @@  source-repository head -  type:                git-  location:            git@github.com:int-index/ether.git+  type: git+  location: git@github.com:int-index/ether.git   library -  exposed-modules:     Control.Ether.Abbr-                       Control.Ether.Implicit.Abbr-                       Control.Ether.TH-                       Control.Monad.Trans.Ether.Reader-                       Control.Monad.Trans.Ether.Writer-                       Control.Monad.Trans.Ether.State-                       Control.Monad.Trans.Ether.State.Lazy-                       Control.Monad.Trans.Ether.State.Strict-                       Control.Monad.Trans.Ether.Except-                       Control.Monad.Trans.Ether.Dispatch-                       Control.Monad.Trans.Ether.Tagged-                       Control.Monad.Ether-                       Control.Monad.Ether.Reader-                       Control.Monad.Ether.Reader.Class-                       Control.Monad.Ether.Writer-                       Control.Monad.Ether.Writer.Class-                       Control.Monad.Ether.State-                       Control.Monad.Ether.State.Class-                       Control.Monad.Ether.State.Lazy-                       Control.Monad.Ether.State.Strict-                       Control.Monad.Ether.Except-                       Control.Monad.Ether.Except.Class-                       Control.Monad.Ether.Implicit-                       Control.Monad.Ether.Implicit.Reader-                       Control.Monad.Ether.Implicit.Writer-                       Control.Monad.Ether.Implicit.State-                       Control.Monad.Ether.Implicit.State.Lazy-                       Control.Monad.Ether.Implicit.State.Strict-                       Control.Monad.Ether.Implicit.Except+  exposed-modules:+    Ether+    Ether.Reader+    Ether.State+    Ether.Writer+    Ether.Except+    Ether.TaggedTrans+    Ether.TagDispatch+    Ether.Internal -  other-modules:       Control.Ether.Util+  build-depends:+    base >=4.9 && <4.11,+    transformers >=0.5.4.0,+    transformers-lift >=0.2.0.0,+    mtl >=2.2.1,+    mmorph >=1.0.4,+    monad-control >=1.0.0.4,+    transformers-base >=0.4.4,+    writer-cps-mtl >= 0.1.1.4,+    exceptions >=0.8,+    template-haskell >=2.11,+    tagged >=0.8.5,+    reflection >=2.1 -  build-depends:       base >=4.7 && <4.10-               ,       transformers >=0.4.2-               ,       transformers-lift >=0.1.0.1-               ,       mtl >=2.2.1-               ,       mmorph >=1.0.4-               ,       monad-control >=1.0.0.4-               ,       transformers-base >=0.4.4-               ,       exceptions >=0.8-               ,       template-haskell >=2.9+  default-language:+    Haskell2010 -  default-language:    Haskell2010-  other-extensions:    CPP-                       ConstraintKinds-                       DataKinds-                       DefaultSignatures-                       DeriveGeneric-                       FlexibleInstances-                       FunctionalDependencies-                       GeneralizedNewtypeDeriving-                       MultiParamTypeClasses-                       ScopedTypeVariables-                       TemplateHaskell-                       TypeFamilies-                       TypeOperators-                       UndecidableInstances+  default-extensions:+    AllowAmbiguousTypes+    ConstraintKinds+    DataKinds+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    PartialTypeSignatures+    PolyKinds+    ScopedTypeVariables+    RankNTypes+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeInType+    TypeOperators+    TypeSynonymInstances+    UndecidableInstances+    UndecidableSuperClasses -  hs-source-dirs:      src-  ghc-options:         -Wall+  hs-source-dirs:+    src +  ghc-options:+    -Wall -O2  test-suite regression -  build-depends:       base >=4.7 && <4.10-               ,       transformers >=0.4.2-               ,       mtl >=2.2.1-               ,       tasty >=0.10-               ,       tasty-quickcheck >=0.8-               ,       QuickCheck >=2.8-               ,       ether+  build-depends:+    base >=4.9 && <4.11,+    transformers >=0.4.2,+    mtl >=2.2.1,+    tasty >=0.10,+    tasty-quickcheck >=0.8,+    QuickCheck >=2.8,+    ghc-prim >=0.3,+    lens >=4.14,+    ether -  main-is:             Regression.hs-  other-modules:       Regression.T1-                       Regression.T2-                       Regression.T3-                       Regression.T4-                       Regression.T5-                       Regression.T6-                       Regression.T7-                       Regression.T8-                       Regression.T9-                       Regression.T10+  main-is:+    Regression.hs -  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  default-language:    Haskell2010-  default-extensions:  ConstraintKinds-                       DataKinds-                       EmptyDataDecls-                       FlexibleContexts-                       GeneralizedNewtypeDeriving-                       LambdaCase-                       PolyKinds-                       ScopedTypeVariables-                       TemplateHaskell-                       TypeFamilies-                       TypeOperators-  ghc-options:         -Wall -fno-warn-missing-signatures+  other-modules:+    Regression.T1+    Regression.T2+    Regression.T3+    Regression.T4+    Regression.T5+    Regression.T6+    Regression.T7+    Regression.T8+    Regression.T9+    Regression.T10+    Regression.T11+    Regression.T12++  type:+    exitcode-stdio-1.0++  hs-source-dirs:+    test++  default-language:+    Haskell2010++  default-extensions:+    AllowAmbiguousTypes+    ConstraintKinds+    DataKinds+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    PartialTypeSignatures+    PolyKinds+    ScopedTypeVariables+    RankNTypes+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeInType+    TypeOperators+    TypeSynonymInstances+    UndecidableInstances+    UndecidableSuperClasses++  ghc-options:+    -Wall -fno-warn-missing-signatures+++benchmark bench++  build-depends:+    base >=4.9 && <4.11,+    mtl >=2.2.1,+    transformers >=0.4.2,+    criterion >=1.1,+    deepseq >=1.4,+    lens >=4.14,+    ether++  main-is:+    Bench.hs++  type:+    exitcode-stdio-1.0++  hs-source-dirs:+    bench++  default-language:+    Haskell2010++  default-extensions:+    AllowAmbiguousTypes+    ConstraintKinds+    DataKinds+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    PartialTypeSignatures+    PolyKinds+    ScopedTypeVariables+    RankNTypes+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeInType+    TypeOperators+    TypeSynonymInstances+    UndecidableInstances+    UndecidableSuperClasses++  ghc-options:+    -Wall -O2++  ghc-prof-options:+    -fprof-auto

@@ -1,60 +0,0 @@-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}---- | Abbreviations for constraints.--module Control.Ether.Abbr-    ( type (-->)-    , type (<--)-    , type (<->)-    , type (-!-)-    , Ether-    , ReifyAbbr-    ) where--import GHC.Exts (Constraint)--import Control.Monad.Ether---- | Turns an abbreviation into an actual constraint.-type family ReifyAbbr (abbr :: *) (m :: * -> *) :: Constraint---- | Denotes 'MonadReader'. The mnemonic is that you read values of type @r@--- from the reader environment tagged by @tag@, thus the arrows points--- from @tag@ to @r@.-data tag --> r-type instance ReifyAbbr (tag --> r) m = MonadReader tag r m---- | Denotes 'MonadWriter'. The mnemonic is that you write values of type @w@--- to the writer accumulator tagged by @tag@, thus the arrows points--- from @w@ to @tag@.-data tag <-- w-type instance ReifyAbbr (tag <-- w) m = MonadWriter tag w m---- | Denotes 'MonadState'. The mnemonic is that you can both read from and--- write into the state, thus the arrow points in both directions.-data tag <-> s-type instance ReifyAbbr (tag <-> s) m = MonadState  tag s m---- | Denotes 'MonadExcept'.-data tag -!- e-type instance ReifyAbbr (tag -!- e) m = MonadExcept tag e m---- | Reify a list of constraint abbreviations.------ > f :: Ether '[Foo --> r, Bar <-- w, Baz <-> s, Quux -!- e] m => m a------ expands into------ > f :: ( MonadReader Foo  r m--- >      , MonadWriter Bar  w m--- >      , MonadState  Baz  s m--- >      , MonadExcept Quux e m--- >      ) => m a--type family Ether (abbrs :: [*]) m :: Constraint where-    Ether '[] m = ()-    Ether (abbr ': abbrs) m = (ReifyAbbr abbr m, Ether abbrs m)

@@ -1,25 +0,0 @@-{-# LANGUAGE TypeFamilies #-}---- | See "Control.Ether.Abbr".--module Control.Ether.Implicit.Abbr (R, W, S, E) where--import Control.Ether.Abbr (ReifyAbbr)-import Control.Monad.Ether.Implicit---- | Denotes 'MonadReader'.-data R r-type instance ReifyAbbr (R r) m = MonadReader r m---- | Denotes 'MonadWriter'.-data W w-type instance ReifyAbbr (W w) m = MonadWriter w m---- | Denotes 'MonadState'.-data S s-type instance ReifyAbbr (S s) m = MonadState s m---- | Denotes 'MonadExcept'.-data E e-type instance ReifyAbbr (E e) m = MonadExcept e m-

@@ -1,45 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE CPP #-}---- | Template Haskell utilities.--module Control.Ether.TH-    ( ethereal-    ) where--import qualified Language.Haskell.TH as TH--import Data.Proxy--emptyDataDecl :: TH.Name -> TH.DecQ-#if __GLASGOW_HASKELL__ < 800-emptyDataDecl name = TH.dataD (return []) name [] [] []-#else-emptyDataDecl name = TH.dataD (return []) name [] Nothing [] (return [])-#endif--funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ-funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]--proxySimple :: TH.Name -> TH.TypeQ -> TH.Q (TH.Dec, TH.Dec)-proxySimple name ty = do-    sig <- TH.sigD name [t| Proxy $ty |]-    val <- funSimple name [e| Proxy |]-    return (sig, val)---- |--- Creates a tag and a value-level proxy for it.------ @'ethereal' \"Foo\" \"foo\"@ generates the following code:------ > data Foo--- > foo :: Proxy Foo--- > foo = Proxy-ethereal :: String -> String -> TH.DecsQ-ethereal strTagName strTagProxyName = do-    let tagName = TH.mkName strTagName-        tag = TH.conT tagName-        tagProxyName = TH.mkName strTagProxyName-    tagDecl <- emptyDataDecl tagName-    (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag-    return [tagDecl, tagProxySig, tagProxyVal]

@@ -1,33 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-module Control.Ether.Util-  ( fmap-  , MonadApplicative-  ) where--import Prelude hiding (fmap)--#if __GLASGOW_HASKELL__ < 710-import qualified Control.Applicative-import qualified Control.Monad-#else-import qualified Prelude-#endif--#if __GLASGOW_HASKELL__ < 710-fmap :: Monad f => (a -> b) -> f a -> f b-fmap = Control.Monad.liftM-#else-fmap :: Functor f => (a -> b) -> f a -> f b-fmap = Prelude.fmap-#endif--{-# INLINE fmap #-}--#if __GLASGOW_HASKELL__ < 710-type MonadApplicative m =-  ( Control.Applicative.Applicative m-  , Control.Monad.Monad m )-#else-type MonadApplicative = Monad-#endif

@@ -1,14 +0,0 @@---- | This module provides convenience exports of all--- tagged monad classes from Ether.--module Control.Monad.Ether (module X) where--import Control.Monad as X-import Control.Monad.Fix as X-import Control.Monad.Ether.Reader as X-import Control.Monad.Ether.Writer as X-import Control.Monad.Ether.State as X-import Control.Monad.Ether.Except as X-import Control.Monad.Trans.Ether.Dispatch as X-import Control.Ether.TH as X (ethereal)

@@ -1,30 +0,0 @@---- | See "Control.Monad.Except".--module Control.Monad.Ether.Except-    (-    -- * MonadExcept class-      MonadExcept(..)-    -- * The Except monad-    , Except-    , runExcept-    -- * The ExceptT monad transformer-    , ExceptT-    , exceptT-    , runExceptT-    -- * Handle functions-    , handleT-    , handle-    ) where--import Control.Monad.Ether.Except.Class-import Control.Monad.Trans.Ether.Except hiding (throw, catch)-import Data.Functor.Identity (Identity(..))---- | Runs an 'Except' and handles the exception with the given function.-handle :: proxy tag -> (e -> a) -> Except tag e a -> a-handle t h m = runIdentity (handleT t h m)---- | Runs an 'ExceptT' and handles the exception with the given function.-handleT :: Functor m => proxy tag -> (e -> a) -> ExceptT tag e m a -> m a-handleT t h m = fmap (either h id) (runExceptT t m)

@@ -1,45 +0,0 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PolyKinds #-}---- | See "Control.Monad.Except".--module Control.Monad.Ether.Except.Class-    ( MonadExcept(..)-    ) where--import qualified Control.Monad.Trans.Ether.Except as E-import qualified Control.Monad.Trans.Lift.Catch as Lift----- | See 'Control.Monad.Except.MonadError'.-class Monad m => MonadExcept tag e m | m tag -> e where--    -- | Is used within a monadic computation to begin exception processing.-    throw :: proxy tag -> e -> m a--    -- | A handler function to handle previous exceptions and return to-    -- normal execution.-    catch :: proxy tag -> m a -> (e -> m a) -> m a--instance (Monad m, e ~ e') => MonadExcept tag e (E.ExceptT tag e' m) where-    throw = E.throw-    catch = E.catch--instance {-# OVERLAPPABLE #-}-         ( Lift.LiftCatch t-         , Monad (t m)-         , MonadExcept tag e m-         ) => MonadExcept tag e (t m) where-    throw t = Lift.lift . throw t-    catch t = Lift.liftCatch (catch t)

@@ -1,14 +0,0 @@---- | This module provides convenience exports of all--- implicitly tagged monad classes from Ether.--module Control.Monad.Ether.Implicit (module X) where--import Control.Monad as X-import Control.Monad.Fix as X-import Control.Monad.Ether.Implicit.Reader as X-import Control.Monad.Ether.Implicit.Writer as X-import Control.Monad.Ether.Implicit.State as X-import Control.Monad.Ether.Implicit.Except as X-import Control.Monad.Trans.Ether.Dispatch as X-import Control.Ether.TH as X (ethereal)

@@ -1,62 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | See "Control.Monad.Ether.Except".--module Control.Monad.Ether.Implicit.Except-    (-    -- * MonadExcept class-      MonadExcept-    , throw-    , catch-    -- * The Except monad-    , Except-    , runExcept-    -- * The ExceptT monad transformer-    , ExceptT-    , exceptT-    , runExceptT-    -- * Handle functions-    , handle-    , handleT-    ) where--import Data.Proxy-import qualified Control.Monad.Ether.Except as Explicit---- | See 'Control.Monad.Ether.Except.MonadExcept'.-type MonadExcept e = Explicit.MonadExcept e e---- | See 'Control.Monad.Ether.Except.throw'.-throw :: forall e m a . MonadExcept e m => e -> m a-throw = Explicit.throw (Proxy :: Proxy e)---- | See 'Control.Monad.Ether.Except.catch'.-catch :: forall e m a . MonadExcept e m => m a -> (e -> m a) -> m a-catch = Explicit.catch (Proxy :: Proxy e)---- | See 'Control.Monad.Ether.Except.Except'.-type Except e = Explicit.Except e e---- | See 'Control.Monad.Ether.Except.runExcept'.-runExcept :: Except e a -> Either e a-runExcept = Explicit.runExcept Proxy---- | See 'Control.Monad.Ether.Except.ExceptT'.-type ExceptT e = Explicit.ExceptT e e---- | See 'Control.Monad.Ether.Except.exceptT'.-exceptT :: m (Either e a) -> ExceptT e m a-exceptT = Explicit.exceptT Proxy---- | See 'Control.Monad.Ether.Except.runExceptT'.-runExceptT :: ExceptT e m a -> m (Either e a)-runExceptT = Explicit.runExceptT Proxy---- | See 'Control.Monad.Ether.Except.handle'.-handle :: (e -> a) -> Except e a -> a-handle = Explicit.handle Proxy---- | See 'Control.Monad.Ether.Except.handleT'.-handleT :: Functor m => (e -> a) -> ExceptT e m a -> m a-handleT = Explicit.handleT Proxy

@@ -1,61 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | See "Control.Monad.Ether.Reader".--module Control.Monad.Ether.Implicit.Reader-    (-    -- * MonadReader class-      MonadReader-    , local-    , ask-    , reader-    , asks-    -- * The Reader monad-    , Reader-    , runReader-    -- * The ReaderT monad transformer-    , ReaderT-    , readerT-    , runReaderT-    ) where--import Data.Proxy-import qualified Control.Monad.Ether.Reader as Explicit---- | See 'Control.Monad.Ether.Reader.ReaderT'.-type ReaderT r = Explicit.ReaderT r r---- | See 'Control.Monad.Ether.Reader.Reader'.-type Reader  r = Explicit.Reader  r r---- | See 'Control.Monad.Ether.Reader.readerT'.-readerT :: (r -> m a) -> ReaderT r m a-readerT = Explicit.readerT Proxy---- | See 'Control.Monad.Ether.Reader.runReaderT'.-runReaderT :: ReaderT r m a -> r -> m a-runReaderT = Explicit.runReaderT Proxy---- | See 'Control.Monad.Ether.Reader.runReader'.-runReader :: Reader r a -> r -> a-runReader = Explicit.runReader Proxy---- | See 'Control.Monad.Ether.Reader.MonadReader'.-type MonadReader r = Explicit.MonadReader r r---- | See 'Control.Monad.Ether.Reader.local'.-local :: forall r m a . MonadReader r m => (r -> r) -> m a -> m a-local = Explicit.local (Proxy :: Proxy r)---- | See 'Control.Monad.Ether.Reader.ask'.-ask :: forall r m . MonadReader r m => m r-ask = Explicit.ask (Proxy :: Proxy r)---- | See 'Control.Monad.Ether.Reader.reader'.-reader :: forall r m a . MonadReader r m => (r -> a) -> m a-reader = Explicit.reader (Proxy :: Proxy r)---- | See 'Control.Monad.Ether.Reader.asks'.-asks :: forall r m a . MonadReader r m => (r -> a) -> m a-asks = Explicit.asks (Proxy :: Proxy r)

@@ -1,8 +0,0 @@---- | See "Control.Monad.Ether.State".--module Control.Monad.Ether.Implicit.State-    ( module Control.Monad.Ether.Implicit.State.Lazy-    ) where--import Control.Monad.Ether.Implicit.State.Lazy

@@ -1,86 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | See "Control.Monad.Ether.State.Lazy".--module Control.Monad.Ether.Implicit.State.Lazy-    (-    -- * MonadState class-      MonadState-    , get-    , put-    , state-    , modify-    , gets-    -- * The State monad-    , State-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    ) where--import Data.Proxy-import qualified Control.Monad.Ether.State.Lazy as Explicit---- | See 'Control.Monad.Ether.State.Lazy.StateT'.-type StateT s = Explicit.StateT s s---- | See 'Control.Monad.Ether.State.Lazy.State'.-type State  s = Explicit.State  s s---- | See 'Control.Monad.Ether.State.Lazy.stateT'.-stateT :: (s -> m (a, s)) -> StateT s m a-stateT = Explicit.stateT Proxy---- | See 'Control.Monad.Ether.State.Lazy.runStateT'.-runStateT :: StateT s m a -> s -> m (a, s)-runStateT = Explicit.runStateT Proxy---- | See 'Control.Monad.Ether.State.Lazy.runState'.-runState :: State s a -> s -> (a, s)-runState = Explicit.runState Proxy---- | See 'Control.Monad.Ether.State.Lazy.evalStateT'.-evalStateT :: Monad m => StateT s m a -> s -> m a-evalStateT = Explicit.evalStateT Proxy---- | See 'Control.Monad.Ether.State.Lazy.evalState'.-evalState :: State s a -> s -> a-evalState = Explicit.evalState Proxy---- | See 'Control.Monad.Ether.State.Lazy.execStateT'.-execStateT :: Monad m => StateT s m a -> s -> m s-execStateT = Explicit.execStateT Proxy---- | See 'Control.Monad.Ether.State.Lazy.execState'.-execState :: State s a -> s -> s-execState = Explicit.execState Proxy---- | See 'Control.Monad.Ether.State.Lazy.MonadState'.-type MonadState s = Explicit.MonadState s s---- | See 'Control.Monad.Ether.State.Lazy.get'.-get :: forall s m . MonadState s m => m s-get = Explicit.get (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Lazy.gets'.-gets :: forall s m a . MonadState s m => (s -> a) -> m a-gets = Explicit.gets (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Lazy.put'.-put :: forall s m . MonadState s m => s -> m ()-put = Explicit.put (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Lazy.state'.-state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a-state = Explicit.state (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Lazy.modify'.-modify :: forall s m . MonadState s m => (s -> s) -> m ()-modify = Explicit.modify (Proxy :: Proxy s)

@@ -1,86 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | See "Control.Monad.Ether.State.Strict".--module Control.Monad.Ether.Implicit.State.Strict-    (-    -- * MonadState class-      MonadState-    , get-    , put-    , state-    , modify-    , gets-    -- * The State monad-    , State-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    ) where--import Data.Proxy-import qualified Control.Monad.Ether.State.Strict as Explicit---- | See 'Control.Monad.Ether.State.Strict.StateT'.-type StateT s = Explicit.StateT s s---- | See 'Control.Monad.Ether.State.Strict.State'.-type State  s = Explicit.State  s s---- | See 'Control.Monad.Ether.State.Strict.stateT'.-stateT :: (s -> m (a, s)) -> StateT s m a-stateT = Explicit.stateT Proxy---- | See 'Control.Monad.Ether.State.Strict.runStateT'.-runStateT :: StateT s m a -> s -> m (a, s)-runStateT = Explicit.runStateT Proxy---- | See 'Control.Monad.Ether.State.Strict.runState'.-runState :: State s a -> s -> (a, s)-runState = Explicit.runState Proxy---- | See 'Control.Monad.Ether.State.Strict.evalStateT'.-evalStateT :: Monad m => StateT s m a -> s -> m a-evalStateT = Explicit.evalStateT Proxy---- | See 'Control.Monad.Ether.State.Strict.evalState'.-evalState :: State s a -> s -> a-evalState = Explicit.evalState Proxy---- | See 'Control.Monad.Ether.State.Strict.execStateT'.-execStateT :: Monad m => StateT s m a -> s -> m s-execStateT = Explicit.execStateT Proxy---- | See 'Control.Monad.Ether.State.Strict.execState'.-execState :: State s a -> s -> s-execState = Explicit.execState Proxy---- | See 'Control.Monad.Ether.State.Strict.MonadState'.-type MonadState s = Explicit.MonadState s s---- | See 'Control.Monad.Ether.State.Strict.get'.-get :: forall s m . MonadState s m => m s-get = Explicit.get (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Strict.gets'.-gets :: forall s m a . MonadState s m => (s -> a) -> m a-gets = Explicit.gets (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Strict.put'.-put :: forall s m . MonadState s m => s -> m ()-put = Explicit.put (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Strict.state'.-state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a-state = Explicit.state (Proxy :: Proxy s)---- | See 'Control.Monad.Ether.State.Strict.modify'.-modify :: forall s m . MonadState s m => (s -> s) -> m ()-modify = Explicit.modify (Proxy :: Proxy s)

@@ -1,81 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | See "Control.Monad.Ether.Writer".--module Control.Monad.Ether.Implicit.Writer-    (-    -- * MonadWriter class-      MonadWriter-    , writer-    , tell-    , listen-    , pass-    , listens-    , censor-    -- * The Writer monad-    , Writer-    , runWriter-    , execWriter-    -- * The WriterT monad transformer-    , WriterT-    , writerT-    , runWriterT-    , execWriterT-    ) where--import Data.Proxy-import qualified Control.Monad.Ether.Writer as Explicit---- | See 'Control.Monad.Ether.Writer.MonadWriter'.-type MonadWriter w = Explicit.MonadWriter w w---- | See 'Control.Monad.Ether.Writer.writer'.-writer :: forall w m a . MonadWriter w m => (a, w) -> m a-writer = Explicit.writer (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.tell'.-tell :: forall w m . MonadWriter w m => w -> m ()-tell = Explicit.tell (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.listen'.-listen :: forall w m a . MonadWriter w m => m a -> m (a, w)-listen = Explicit.listen (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.pass'.-pass :: forall w m a . MonadWriter w m => m (a, w -> w) -> m a-pass = Explicit.pass (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.listens'.-listens :: forall w m a b . MonadWriter w m => (w -> b) -> m a -> m (a, b)-listens = Explicit.listens (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.censor'.-censor :: forall w m a . MonadWriter w m => (w -> w) -> m a -> m a-censor = Explicit.censor (Proxy :: Proxy w)---- | See 'Control.Monad.Ether.Writer.Writer'.-type Writer w = Explicit.Writer w w---- | See 'Control.Monad.Ether.Writer.runWriter'.-runWriter :: Writer w a -> (a, w)-runWriter = Explicit.runWriter Proxy---- | See 'Control.Monad.Ether.Writer.execWriter'.-execWriter :: Writer w a -> w-execWriter = Explicit.execWriter Proxy---- | See 'Control.Monad.Ether.Writer.WriterT'.-type WriterT w = Explicit.WriterT w w---- | See 'Control.Monad.Ether.Writer.writerT'.-writerT :: m (a, w) -> WriterT w m a-writerT = Explicit.writerT Proxy---- | See 'Control.Monad.Ether.Writer.runWriterT'.-runWriterT :: WriterT w m a -> m (a, w)-runWriterT = Explicit.runWriterT Proxy---- | See 'Control.Monad.Ether.Writer.execWriterT'.-execWriterT :: Monad m => WriterT w m a -> m w-execWriterT = Explicit.execWriterT Proxy

@@ -1,19 +0,0 @@---- | See "Control.Monad.Reader".--module Control.Monad.Ether.Reader-    (-    -- * MonadReader class-      MonadReader(..)-    , asks-    -- * The Reader monad-    , Reader-    , runReader-    -- * The ReaderT monad transformer-    , ReaderT-    , readerT-    , runReaderT-    ) where--import Control.Monad.Ether.Reader.Class-import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)

@@ -1,72 +0,0 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PolyKinds #-}---- | See "Control.Monad.Reader.Class".--module Control.Monad.Ether.Reader.Class-    ( MonadReader(..)-    , asks-    ) where--import qualified Control.Monad.Trans.Ether.Reader as R-import qualified Control.Monad.Trans.Lift.Local as Lift-import qualified Control.Ether.Util as Util---- | See 'Control.Monad.Reader.MonadReader'.-class Monad m => MonadReader tag r m | m tag -> r where--    {-# MINIMAL (ask | reader), local #-}--    -- | Retrieves the monad environment.-    ask :: proxy tag -> m r-    ask t = reader t id--    -- | Executes a computation in a modified environment.-    local-        :: proxy tag-        -> (r -> r)-        -- ^ The function to modify the environment.-        -> m a-        -- ^ @Reader@ to run in the modified environment.-        -> m a--    -- | Retrieves a function of the current environment.-    reader-        :: proxy tag-        -> (r -> a)-        -- ^ The selector function to apply to the environment.-        -> m a-    reader t f = Util.fmap f (ask t)---- | Retrieves a function of the current environment.-asks-    :: MonadReader tag r m-    => proxy tag-    -> (r -> a)-    -- ^ The selector function to apply to the environment.-    -> m a-asks = reader--instance (Monad m, r ~ r') => MonadReader tag r (R.ReaderT tag r' m) where-    ask = R.ask-    local = R.local-    reader = R.reader--instance {-# OVERLAPPABLE #-}-         ( Lift.LiftLocal t-         , Monad (t m)-         , MonadReader tag r m-         ) => MonadReader tag r (t m) where-    ask t = Lift.lift (ask t)-    local t = Lift.liftLocal (ask t) (local t)

@@ -1,8 +0,0 @@---- | See "Control.Monad.State".--module Control.Monad.Ether.State-    ( module Control.Monad.Ether.State.Lazy-    ) where--import Control.Monad.Ether.State.Lazy

@@ -1,74 +0,0 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PolyKinds #-}---- | See "Control.Monad.State.Class".--module Control.Monad.Ether.State.Class-    ( MonadState(..)-    , modify-    , gets-    ) where--import qualified Control.Monad.Trans.Ether.State.Lazy   as S.L-import qualified Control.Monad.Trans.Ether.State.Strict as S.S-import qualified Control.Monad.Trans as Lift-import qualified Control.Ether.Util as Util---- | See 'Control.Monad.State.MonadState'.-class Monad m => MonadState tag s m | m tag -> s where--    {-# MINIMAL state | get, put #-}--    -- | Return the state from the internals of the monad.-    get :: proxy tag -> m s-    get t = state t (\s -> (s, s))--    -- | Replace the state inside the monad.-    put :: proxy tag -> s -> m ()-    put t s = state t (\_ -> ((), s))--    -- | Embed a simple state action into the monad.-    state :: proxy tag -> (s -> (a, s)) -> m a-    state t f = do-        s <- get t-        let ~(a, s') = f s-        put t s'-        return a---- | Modifies the state inside a state monad.-modify :: MonadState tag s m => proxy tag -> (s -> s) -> m ()-modify t f = state t (\s -> ((), f s))---- | Gets specific component of the state, using a projection function supplied.-gets :: MonadState tag s m => proxy tag -> (s -> a) -> m a-gets t f = Util.fmap f (get t)--instance (Monad m, s ~ s') => MonadState tag s (S.L.StateT tag s' m) where-    get = S.L.get-    put = S.L.put-    state = S.L.state--instance (Monad m, s ~ s') => MonadState tag s (S.S.StateT tag s' m) where-    get = S.S.get-    put = S.S.put-    state = S.S.state--instance {-# OVERLAPPABLE #-}-         ( Lift.MonadTrans t-         , Monad (t m)-         , MonadState tag s m-         ) => MonadState tag s (t m) where-    get t = Lift.lift (get t)-    put t = Lift.lift . put t-    state t = Lift.lift . state t

@@ -1,24 +0,0 @@---- | See "Control.Monad.State.Lazy".--module Control.Monad.Ether.State.Lazy-    (-    -- * MonadState class-      MonadState(..)-    , modify-    , gets-    -- * The State monad-    , State-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    ) where--import Control.Monad.Ether.State.Class-import Control.Monad.Trans.Ether.State.Lazy hiding (state, get, put)

@@ -1,24 +0,0 @@---- | See "Control.Monad.State.Strict".--module Control.Monad.Ether.State.Strict-    (-    -- * MonadState class-      MonadState(..)-    , modify-    , gets-    -- * The State monad-    , State-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    ) where--import Control.Monad.Ether.State.Class-import Control.Monad.Trans.Ether.State.Strict hiding (state, get, put)

@@ -1,22 +0,0 @@---- | See "Control.Monad.Writer".--module Control.Monad.Ether.Writer-    (-    -- * MonadWriter class-      MonadWriter(..)-    , listens-    , censor-    -- * The Writer monad-    , Writer-    , runWriter-    , execWriter-    -- * The WriterT monad transformer-    , WriterT-    , writerT-    , runWriterT-    , execWriterT-    ) where--import Control.Monad.Ether.Writer.Class-import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)

@@ -1,83 +0,0 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PolyKinds #-}---- | See "Control.Monad.Writer.Class".--module Control.Monad.Ether.Writer.Class-    ( MonadWriter(..)-    , listens-    , censor-    ) where--#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif--import qualified Control.Monad.Trans.Ether.Writer as W-import qualified Control.Monad.Trans.Lift.Listen as Lift-import qualified Control.Monad.Trans.Lift.Pass   as Lift---- | See 'Control.Monad.Writer.MonadWriter'.-class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where--    {-# MINIMAL (writer | tell), listen, pass #-}--    -- | Embed a simple writer action.-    writer :: proxy tag -> (a, w) -> m a-    writer t ~(a, w) = do-      tell t w-      return a--    -- | Append a value to the accumulator within the monad.-    tell :: proxy tag -> w -> m ()-    tell t w = writer t ((),w)--    -- | Execute an action and add its accumulator-    -- to the value of the computation.-    listen :: proxy tag -> m a -> m (a, w)--    -- | Execute an action which returns a value and a function,-    -- and return the value, applying the function to the accumulator.-    pass :: proxy tag -> m (a, w -> w) -> m a---- | Execute an action and add the result of applying the given function to--- its accumulator to the value of the computation.-listens :: MonadWriter tag w m => proxy tag -> (w -> b) -> m a -> m (a, b)-listens t f m = do-    ~(a, w) <- listen t m-    return (a, f w)---- | Execute an action and apply a function to its accumulator.-censor :: MonadWriter tag w m => proxy tag -> (w -> w) -> m a -> m a-censor t f m = pass t $ do-    a <- m-    return (a, f)--instance (Monoid w, Monad m, w ~ w') => MonadWriter tag w (W.WriterT tag w' m) where-    writer = W.writer-    tell = W.tell-    listen = W.listen-    pass = W.pass--instance {-# OVERLAPPABLE #-}-         ( Lift.LiftListen t-         , Lift.LiftPass   t-         , Monad (t m)-         , MonadWriter tag w m-         , Monoid w-         ) => MonadWriter tag w (t m) where-    writer t = Lift.lift . writer t-    tell   t = Lift.lift . tell t-    listen t = Lift.liftListen (listen t)-    pass   t = Lift.liftPass (pass t)

@@ -1,256 +0,0 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif--#if __GLASGOW_HASKELL__ >= 710-{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}-#endif--{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--{- |--Type-level machinery to manipulate constraints on the monad-transformer stack.--Out of the box it provides the following dispatch strategies:--* 'tagAttach' to use functions defined using untagged monad classes-  as if they were defined using tagged ones.--* 'tagReplace' to use functions defined using one tag-  as if they were defined using another one.--> import qualified Control.Monad.State as T-> import Control.Ether.TH (ethereal)-> import Control.Monad.Ether.State (MonadState)-> import Control.Monad.Trans.Ether.Dispatch (tagAttach, tagDispatch)->-> ethereal "Foo" "foo"-> ethereal "Bar" "bar"->-> f :: T.MonadState Int m => m String-> f = fmap show T.get->-> g :: MonadState Foo Int m => m String-> g = tagAttach foo f->-> h :: MonadState Bar Int m => m String-> h = tagReplace foo bar g---}--module Control.Monad.Trans.Ether.Dispatch-  (-  -- * The DispatchT monad transformer-    DispatchT(..)-  -- * Dispatch types and functions-  , K_TagAttach(..)-  , K_TagReplace(..)-  , tagAttach-  , tagReplace-  ) where--import Control.Applicative-import Control.Monad (MonadPlus)-import Control.Monad.Fix (MonadFix)-import Control.Monad.Trans.Class (MonadTrans)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Morph (MFunctor, MMonad)-import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)-import GHC.Generics (Generic)-import Data.Coerce (coerce)-import Data.Proxy--import qualified Control.Monad.Base as MB-import qualified Control.Monad.Trans.Control as MC-import qualified Control.Monad.Trans.Identity as Trans--import qualified Control.Monad.Trans.Lift.StT    as Lift-import qualified Control.Monad.Trans.Lift.Local  as Lift-import qualified Control.Monad.Trans.Lift.Catch  as Lift-import qualified Control.Monad.Trans.Lift.Listen as Lift-import qualified Control.Monad.Trans.Lift.Pass   as Lift-import qualified Control.Monad.Trans.Lift.CallCC as Lift--import Control.Monad.Ether.Reader.Class-import Control.Monad.Ether.State.Class-import Control.Monad.Ether.Except.Class-import Control.Monad.Ether.Writer.Class--import qualified Control.Monad.Cont   as Class-import qualified Control.Monad.Reader as Class-import qualified Control.Monad.State  as Class-import qualified Control.Monad.Except as Class-import qualified Control.Monad.Writer as Class---- | Encode type-level information for 'tagAttach'.-data K_TagAttach t = TagAttach t---- | Encode type-level information for 'tagReplace'.-data K_TagReplace tOld tNew = TagReplace tOld tNew---- | Wrap a monad to change its tags. Under the hood this is--- simply 'Trans.IdentityT', all the work is happening on the type level.-newtype DispatchT dp m a = DispatchT (Trans.IdentityT m a)-  deriving-    ( Generic-    , Functor, Applicative, Alternative, Monad, MonadPlus-    , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad-    , MonadThrow, MonadCatch, MonadMask )--type DispatchTagAttachT t = DispatchT (TagAttach t)-type DispatchTagReplaceT tOld tNew = DispatchT (TagReplace tOld tNew)---- | Type-restricted 'coerce'.-pack :: Trans.IdentityT m a -> DispatchT dp m a-pack = coerce---- | Type-restricted 'coerce'.-unpack :: DispatchT dp m a -> Trans.IdentityT m a-unpack = coerce--instance MB.MonadBase b m => MB.MonadBase b (DispatchT dp m) where-  liftBase = MB.liftBaseDefault--instance MC.MonadTransControl (DispatchT dp) where-  type StT (DispatchT dp) a = MC.StT Trans.IdentityT a-  liftWith = MC.defaultLiftWith pack unpack-  restoreT = MC.defaultRestoreT pack--instance MC.MonadBaseControl b m => MC.MonadBaseControl b (DispatchT dp m) where-  type StM (DispatchT dp m) a = MC.ComposeSt (DispatchT dp) m a-  liftBaseWith = MC.defaultLiftBaseWith-  restoreM = MC.defaultRestoreM--type instance Lift.StT (DispatchT dp) a = MC.StT (DispatchT dp) a--instance Lift.LiftLocal (DispatchT dp) where-  liftLocal = Lift.defaultLiftLocal pack unpack--instance Lift.LiftCatch (DispatchT dp) where-  liftCatch = Lift.defaultLiftCatch pack unpack--instance Lift.LiftListen (DispatchT dp) where-  liftListen = Lift.defaultLiftListen pack unpack--instance Lift.LiftPass (DispatchT dp) where-  liftPass = Lift.defaultLiftPass pack unpack--instance Lift.LiftCallCC (DispatchT dp) where-  liftCallCC  = Lift.defaultLiftCallCC  pack unpack-  liftCallCC' = Lift.defaultLiftCallCC' pack unpack---- | Attach a tag to untagged transformers.-tagAttach :: proxy t -> DispatchTagAttachT t m a -> m a-tagAttach _ = coerce---- | Replace a tag with another tag.-tagReplace-  :: proxy tOld-  -> proxy tNew-  -> DispatchTagReplaceT tOld tNew m a-  -> m a-tagReplace _ _ = coerce----- TagAttach instances--instance MonadReader tag r m-      => Class.MonadReader r (DispatchTagAttachT tag m) where-  ask   = let t = Proxy :: Proxy tag in Lift.lift (ask t)-  local = let t = Proxy :: Proxy tag in Lift.liftLocal (ask t) (local t)--instance MonadState tag s m-      => Class.MonadState s (DispatchTagAttachT tag m) where-  get = let t = Proxy :: Proxy tag in Lift.lift (get t)-  put = let t = Proxy :: Proxy tag in Lift.lift . put t--instance MonadExcept tag e m-      => Class.MonadError e (DispatchTagAttachT tag m) where-  throwError = let t = Proxy :: Proxy tag in Lift.lift . throw t-  catchError = let t = Proxy :: Proxy tag in Lift.liftCatch (catch t)--instance MonadWriter tag w m-      => Class.MonadWriter w (DispatchTagAttachT tag m) where-  writer = let t = Proxy :: Proxy tag in Lift.lift . writer t-  tell   = let t = Proxy :: Proxy tag in Lift.lift . tell t-  listen = let t = Proxy :: Proxy tag in Lift.liftListen (listen t)-  pass   = let t = Proxy :: Proxy tag in Lift.liftPass (pass t)----- TagReplace instances--instance MonadReader tNew r m-      => MonadReader tOld r (DispatchTagReplaceT tOld tNew m) where-  ask   _ = let t = Proxy :: Proxy tNew in Lift.lift (ask t)-  local _ = let t = Proxy :: Proxy tNew in Lift.liftLocal (ask t) (local t)--instance MonadState tNew s m-      => MonadState tOld s (DispatchTagReplaceT tOld tNew m) where-  get _ = let t = Proxy :: Proxy tNew in Lift.lift (get t)-  put _ = let t = Proxy :: Proxy tNew in Lift.lift . put t--instance MonadExcept tNew e m-      => MonadExcept tOld e (DispatchTagReplaceT tOld tNew m) where-  throw _ = let t = Proxy :: Proxy tNew in Lift.lift . throw t-  catch _ = let t = Proxy :: Proxy tNew in Lift.liftCatch (catch t)--instance MonadWriter tNew w m-      => MonadWriter tOld w (DispatchTagReplaceT tOld tNew m) where-  writer _ = let t = Proxy :: Proxy tNew in Lift.lift . writer t-  tell   _ = let t = Proxy :: Proxy tNew in Lift.lift . tell t-  listen _ = let t = Proxy :: Proxy tNew in Lift.liftListen (listen t)-  pass   _ = let t = Proxy :: Proxy tNew in Lift.liftPass (pass t)----- Instances for mtl classes--instance {-# OVERLAPPABLE #-}-    ( Class.MonadCont m-    ) => Class.MonadCont (DispatchT dp m)-  where-    callCC = Lift.liftCallCC' Class.callCC--instance {-# OVERLAPPABLE #-}-    ( Class.MonadReader r m-    ) => Class.MonadReader r (DispatchT dp m)-  where-    ask = Class.lift Class.ask-    local = Lift.liftLocal Class.ask Class.local-    reader = Class.lift . Class.reader--instance {-# OVERLAPPABLE #-}-    ( Class.MonadState s m-    ) => Class.MonadState s (DispatchT dp m)-  where-    get = Class.lift Class.get-    put = Class.lift . Class.put-    state = Class.lift . Class.state--instance {-# OVERLAPPABLE #-}-    ( Class.MonadWriter w m-    ) => Class.MonadWriter w (DispatchT dp m)-  where-    writer = Class.lift . Class.writer-    tell   = Class.lift . Class.tell-    listen = Lift.liftListen Class.listen-    pass   = Lift.liftPass Class.pass--instance {-# OVERLAPPABLE #-}-    ( Class.MonadError e m-    ) => Class.MonadError e (DispatchT dp m)-  where-    throwError = Class.lift . Class.throwError-    catchError = Lift.liftCatch Class.catchError

@@ -1,69 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | See "Control.Monad.Trans.Except".--module Control.Monad.Trans.Ether.Except-    (-    -- * The Except monad-      Except-    , except-    , runExcept-    -- * The ExceptT monad transformer-    , ExceptT-    , exceptT-    , runExceptT-    -- * Exception operations-    , throw-    , catch-    ) where--import Data.Functor.Identity (Identity(..))-import qualified Control.Monad.Trans.Except as Trans-import Control.Monad.Trans.Ether.Tagged----- | The parameterizable exception monad.------ Computations are either exceptions or normal values.------ The 'return' function returns a normal value, while '>>=' exits on--- the first exception.-type Except tag e = ExceptT tag e Identity---- | Runs an 'Except' and returns either an exception or a normal value.-runExcept :: proxy tag -> Except tag e a -> Either e a-runExcept _ = Trans.runExcept . unpack---- | The exception monad transformer.------ The 'return' function returns a normal value, while '>>=' exits on--- the first exception.-type ExceptT tag e = TaggedTrans tag (Trans.ExceptT e)---- | Constructor for computations in the exception monad transformer.-exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a-exceptT _ = pack . Trans.ExceptT---- | Constructor for computations in the exception monad--- (the inverse of 'runExcept').-except :: Monad m => proxy tag -> Either e a -> ExceptT tag e m a-except t = exceptT t . return---- | Runs an 'ExceptT' and returns either an exception or a normal value.-runExceptT :: proxy tag -> ExceptT tag e m a -> m (Either e a)-runExceptT _ = Trans.runExceptT . unpack---- | Is used within a monadic computation to begin exception processing.-throw :: Monad m => proxy tag -> e -> ExceptT tag e m a-throw _ = pack . Trans.throwE---- | A handler function to handle previous exceptions and return to normal execution.-catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a-catch _ m h = pack $ Trans.catchE (unpack m) (unpack . h)

@@ -1,80 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | See "Control.Monad.Trans.Reader".--module Control.Monad.Trans.Ether.Reader-    (-    -- * The Reader monad-      Reader-    , reader-    , runReader-    -- * The ReaderT monad transformer-    , ReaderT-    , readerT-    , runReaderT-    -- * Reader operations-    , ask-    , local-    ) where--import Data.Functor.Identity (Identity(..))-import qualified Control.Monad.Trans.Reader as Trans-import Control.Monad.Trans.Ether.Tagged---- | The parameterizable reader monad.------ Computations are functions of a shared environment.------ The 'return' function ignores the environment, while '>>=' passes--- the inherited environment to both subcomputations.-type Reader tag r = ReaderT tag r Identity---- | The reader monad transformer,--- which adds a read-only environment to the given monad.------ The 'return' function ignores the environment, while '>>=' passes--- the inherited environment to both subcomputations.-type ReaderT tag r = TaggedTrans tag (Trans.ReaderT r)---- | Constructor for computations in the reader monad transformer.-readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a-readerT _ = pack . Trans.ReaderT---- | Constructor for computations in the reader monad--- (the inverse of 'runReader').-reader :: Monad m => proxy tag -> (r -> a) -> ReaderT tag r m a-reader _ = pack . Trans.reader---- | Runs a 'ReaderT' with the given environment--- and returns the final value.-runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a-runReaderT _ = Trans.runReaderT . unpack---- | Runs a 'ReaderT' with the given environment--- and returns the final value.-runReader :: proxy tag -> Reader tag r a -> r -> a-runReader _ = Trans.runReader . unpack---- | Fetch the value of the environment.-ask :: Monad m => proxy tag -> ReaderT tag r m r-ask _ = pack Trans.ask---- | Execute a computation in a modified environment--- (a specialization of 'withReaderT').------ * @'runReaderT' tag ('local' tag f m) = 'runReaderT' tag m . f@-local-    :: proxy tag-    -> (r -> r)-    -- ^ The function to modify the environment.-    -> ReaderT tag r m a-    -- ^ Computation to run in the modified environment.-    -> ReaderT tag r m a-local _ f = pack . Trans.withReaderT f . unpack

@@ -1,8 +0,0 @@---- | See "Control.Monad.Trans.State".--module Control.Monad.Trans.Ether.State-    ( module Control.Monad.Trans.Ether.State.Lazy-    ) where--import Control.Monad.Trans.Ether.State.Lazy

@@ -1,94 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | See "Control.Monad.Trans.State.Lazy".--module Control.Monad.Trans.Ether.State.Lazy-    (-    -- * The State monad-      State-    , state-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    -- * State operations-    , get-    , put-    ) where--import Data.Functor.Identity (Identity(..))-import qualified Control.Monad.Trans.State.Lazy as Trans-import Control.Monad.Trans.Ether.Tagged---- | The parametrizable state monad.------ Computations have access to a mutable state.------ The 'return' function leaves the state unchanged, while '>>=' uses--- the final state of the first computation as the initial state of the second.-type State tag r = StateT tag r Identity---- | The state monad transformer.------ The 'return' function leaves the state unchanged, while '>>=' uses--- the final state of the first computation as the initial state of the second.-type StateT tag s = TaggedTrans tag (Trans.StateT s)---- | Constructor for computations in the state monad transformer.-stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a-stateT _ = pack . Trans.StateT---- | Constructor for computations in the state monad--- (the inverse of 'runState').-state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a-state _ = pack . Trans.state---- | Runs a 'StateT' with the given initial state--- and returns both the final value and the final state.-runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)-runStateT _ = Trans.runStateT . unpack---- | Runs a 'StateT' with the given initial state--- and returns the final value, discarding the final state.-evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a-evalStateT _ = Trans.evalStateT . unpack---- | Runs a 'StateT' with the given initial state--- and returns the final state, discarding the final value.-execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s-execStateT _ = Trans.execStateT . unpack---- | Runs a 'State' with the given initial state--- and returns both the final value and the final state.-runState :: proxy tag -> State tag s a -> s -> (a, s)-runState _ = Trans.runState . unpack---- | Runs a 'State' with the given initial state--- and returns the final value, discarding the final state.-evalState :: proxy tag -> State tag s a -> s -> a-evalState _ = Trans.evalState . unpack---- | Runs a 'State' with the given initial state--- and returns the final state, discarding the final value.-execState :: proxy tag -> State tag s a -> s -> s-execState _ = Trans.execState . unpack---- | Fetch the current value of the state within the monad.-get :: Monad m => proxy tag -> StateT tag s m s-get _ = pack Trans.get---- | Set the value of the state within the monad.-put :: Monad m => proxy tag -> s -> StateT tag s m ()-put _ = pack . Trans.put

@@ -1,94 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | See "Control.Monad.Trans.State.Strict".--module Control.Monad.Trans.Ether.State.Strict-    (-    -- * The State monad-      State-    , state-    , runState-    , evalState-    , execState-    -- * The StateT monad transformer-    , StateT-    , stateT-    , runStateT-    , evalStateT-    , execStateT-    -- * State operations-    , get-    , put-    ) where--import Data.Functor.Identity (Identity(..))-import qualified Control.Monad.Trans.State.Strict as Trans-import Control.Monad.Trans.Ether.Tagged---- | The parametrizable state monad.------ Computations have access to a mutable state.------ The 'return' function leaves the state unchanged, while '>>=' uses--- the final state of the first computation as the initial state of the second.-type State tag r = StateT tag r Identity---- | The state monad transformer.------ The 'return' function leaves the state unchanged, while '>>=' uses--- the final state of the first computation as the initial state of the second.-type StateT tag s = TaggedTrans tag (Trans.StateT s)---- | Constructor for computations in the state monad transformer.-stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a-stateT _ = pack . Trans.StateT---- | Constructor for computations in the state monad--- (the inverse of 'runState').-state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a-state _ = pack . Trans.state---- | Runs a 'StateT' with the given initial state--- and returns both the final value and the final state.-runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)-runStateT _ = Trans.runStateT . unpack---- | Runs a 'StateT' with the given initial state--- and returns the final value, discarding the final state.-evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a-evalStateT _ = Trans.evalStateT . unpack---- | Runs a 'StateT' with the given initial state--- and returns the final state, discarding the final value.-execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s-execStateT _ = Trans.execStateT . unpack---- | Runs a 'State' with the given initial state--- and returns both the final value and the final state.-runState :: proxy tag -> State tag s a -> s -> (a, s)-runState _ = Trans.runState . unpack---- | Runs a 'State' with the given initial state--- and returns the final value, discarding the final state.-evalState :: proxy tag -> State tag s a -> s -> a-evalState _ = Trans.evalState . unpack---- | Runs a 'State' with the given initial state--- and returns the final state, discarding the final value.-execState :: proxy tag -> State tag s a -> s -> s-execState _ = Trans.execState . unpack---- | Fetch the current value of the state within the monad.-get :: Monad m => proxy tag -> StateT tag s m s-get _ = pack Trans.get---- | Set the value of the state within the monad.-put :: Monad m => proxy tag -> s -> StateT tag s m ()-put _ = pack . Trans.put

@@ -1,154 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeFamilies #-}---- | This module defines the core data type of Ether, 'TaggedTrans',--- and a bunch of instances for it. 'TaggedTrans' attaches a tag to--- an existing monad transformer.--module Control.Monad.Trans.Ether.Tagged where--import Control.Applicative-import Control.Monad (MonadPlus)-import Control.Monad.Fix (MonadFix)-import Control.Monad.Trans.Class (MonadTrans, lift)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Morph (MFunctor, MMonad)-import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)--import qualified Control.Monad.Base as MB-import qualified Control.Monad.Trans.Control as MC--import qualified Control.Monad.Trans.Lift.StT    as Lift-import qualified Control.Monad.Trans.Lift.Local  as Lift-import qualified Control.Monad.Trans.Lift.Catch  as Lift-import qualified Control.Monad.Trans.Lift.Listen as Lift-import qualified Control.Monad.Trans.Lift.Pass   as Lift-import qualified Control.Monad.Trans.Lift.CallCC as Lift--import qualified Control.Monad.Cont.Class    as Class-import qualified Control.Monad.Reader.Class  as Class-import qualified Control.Monad.State.Class   as Class-import qualified Control.Monad.Writer.Class  as Class-import qualified Control.Monad.Error.Class   as Class--import GHC.Generics (Generic)-import Data.Coerce (coerce)--import Control.Ether.Util (MonadApplicative)---- | Tagged monad transformer.-newtype TaggedTrans tag trans (m :: * -> *) a = TaggedTrans (trans m a)-  deriving-    ( Generic-    , Functor, Applicative, Alternative, Monad, MonadPlus-    , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad-    , MonadThrow, MonadCatch, MonadMask )---- | Type-restricted 'coerce'.-pack :: trans m a -> TaggedTrans tag trans m a-pack = coerce---- | Type-restricted 'coerce'.-unpack :: TaggedTrans tag trans m a -> trans m a-unpack = coerce--instance-    ( MB.MonadBase b m-    , MonadTrans trans-    , MonadApplicative (trans m)-    ) => MB.MonadBase b (TaggedTrans tag trans m)-  where-    liftBase = MB.liftBaseDefault--instance-    ( MC.MonadTransControl trans-    ) => MC.MonadTransControl (TaggedTrans tag trans)-  where-    type StT (TaggedTrans tag trans) a = MC.StT trans a-    liftWith = MC.defaultLiftWith pack unpack-    restoreT = MC.defaultRestoreT pack--instance-    ( MC.MonadBaseControl b m-    , MC.MonadTransControl trans-    , MonadApplicative (trans m)-    ) => MC.MonadBaseControl b (TaggedTrans tag trans m)-  where-    type StM (TaggedTrans tag trans m) a = MC.ComposeSt trans m a-    liftBaseWith = MC.defaultLiftBaseWith-    restoreM = MC.defaultRestoreM--type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a--instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where-  liftLocal = Lift.defaultLiftLocal pack unpack--instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where-  liftCatch = Lift.defaultLiftCatch pack unpack--instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where-  liftListen = Lift.defaultLiftListen pack unpack--instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where-  liftPass = Lift.defaultLiftPass pack unpack--instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where-  liftCallCC  = Lift.defaultLiftCallCC  pack unpack-  liftCallCC' = Lift.defaultLiftCallCC' pack unpack---- Instances for mtl classes--instance-    ( Class.MonadCont m-    , Lift.LiftCallCC trans-    , Monad (trans m)-    ) => Class.MonadCont (TaggedTrans tag trans m)-  where-    callCC = Lift.liftCallCC' Class.callCC--instance-    ( Class.MonadReader r m-    , Lift.LiftLocal trans-    , Monad (trans m)-    ) => Class.MonadReader r (TaggedTrans tag trans m)-  where-    ask = lift Class.ask-    local = Lift.liftLocal Class.ask Class.local-    reader = lift . Class.reader--instance-    ( Class.MonadState s m-    , MonadTrans trans-    , Monad (trans m)-    ) => Class.MonadState s (TaggedTrans tag trans m)-  where-    get = lift Class.get-    put = lift . Class.put-    state = lift . Class.state--instance-    ( Class.MonadWriter w m-    , Lift.LiftListen trans-    , Lift.LiftPass trans-    , Monad (trans m)-    ) => Class.MonadWriter w (TaggedTrans tag trans m)-  where-    writer = lift . Class.writer-    tell   = lift . Class.tell-    listen = Lift.liftListen Class.listen-    pass   = Lift.liftPass Class.pass--instance-    ( Class.MonadError e m-    , Lift.LiftCatch trans-    , Monad (trans m)-    ) => Class.MonadError e (TaggedTrans tag trans m)-  where-    throwError = lift . Class.throwError-    catchError = Lift.liftCatch Class.catchError

@@ -1,105 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | See "Control.Monad.Trans.Writer".--module Control.Monad.Trans.Ether.Writer-    (-    -- * The Writer monad-      Writer-    , writer-    , runWriter-    , execWriter-    -- * The WriterT monad transformer-    , WriterT-    , writerT-    , runWriterT-    , execWriterT-    -- * Writer operations-    , tell-    , listen-    , pass-    ) where--#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif--import Data.Functor.Identity (Identity(..))-import qualified Control.Monad.Trans.Writer.Lazy as Trans-import Control.Monad.Trans.Ether.Tagged---- | The parametrizable writer monad.------ Computations can accumulate a monoid value.------ The 'return' function produces the output 'mempty', while '>>=' combines--- the outputs of the subcomputations using 'mappend'.-type Writer tag w = WriterT tag w Identity---- | The writer monad transformer.------ The 'return' function produces the output 'mempty', while '>>=' combines--- the outputs of the subcomputations using 'mappend'.-type WriterT tag w = TaggedTrans tag (Trans.WriterT w)---- | Constructor for computations in the writer monad transformer.-writerT :: proxy tag -> m (a, w) -> WriterT tag w m a-writerT _ = pack . Trans.WriterT---- | Constructor for computations in the writer monad--- (the inverse of 'runWriter').-writer :: Monad m => proxy tag -> (a, w) -> WriterT tag w m a-writer _ = pack . Trans.writer---- | Runs a 'WriterT' and returns both the normal value--- and the final accumulator.-runWriterT :: proxy tag -> WriterT tag w m a -> m (a, w)-runWriterT _ = Trans.runWriterT . unpack---- | Runs a 'Writer' and returns both the normal value--- and the final accumulator.-runWriter :: proxy tag -> Writer tag w a -> (a, w)-runWriter _ = Trans.runWriter . unpack---- | Runs a 'WriterT' and returns the final accumulator,--- discarding the normal value.-execWriterT :: Monad m => proxy tag -> WriterT tag w m a -> m w-execWriterT _ = Trans.execWriterT . unpack---- | Runs a 'Writer' and returns the final accumulator,--- discarding the normal value.-execWriter :: proxy tag -> Writer tag w a -> w-execWriter _ = Trans.execWriter . unpack---- | Appends a value to the accumulator within the monad.-tell :: Monad m => proxy tag -> w -> WriterT tag w m ()-tell t w = writer t ((), w)---- | Executes an action and adds its accumulator to the value of the computation.-listen-#if __GLASGOW_HASKELL__ < 800-  :: (Monad m, Monoid w)-#else-  :: Monad m-#endif-  => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)-listen _ = pack . Trans.listen . unpack---- | Executes an action which returns a value and a function, and returns the--- value, applying the function to the accumulator.-pass-#if __GLASGOW_HASKELL__ < 800-  :: (Monad m, Monoid w)-#else-  :: Monad m-#endif-  => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a-pass _ = pack . Trans.pass . unpack

@@ -0,0 +1,25 @@+module Ether+  ( module Control.Monad+  , module Control.Monad.Fix+  , module Control.Monad.Trans.Identity+  , module Data.Functor.Identity+  , module Data.Tagged+  , module Ether.Reader+  , module Ether.Writer+  , module Ether.State+  , module Ether.Except+  , module Ether.TagDispatch+  , module Ether.TaggedTrans+  ) where++import Control.Monad+import Control.Monad.Fix+import Control.Monad.Trans.Identity+import Data.Functor.Identity+import Data.Tagged+import Ether.Reader+import Ether.Writer+import Ether.State+import Ether.Except+import Ether.TagDispatch+import Ether.TaggedTrans

@@ -0,0 +1,141 @@+module Ether.Except+  (+  -- * MonadExcept class+    MonadExcept+  , throw+  , catch+  -- * The Except monad+  , Except+  , runExcept+  -- * The ExceptT monad transformer+  , ExceptT+  , exceptT+  , runExceptT+  -- * MonadExcept class (implicit)+  , MonadExcept'+  , throw'+  , catch'+  -- * The Except monad (implicit)+  , Except'+  , runExcept'+  -- * The ExceptT monad transformer (implicit)+  , ExceptT'+  , exceptT'+  , runExceptT'+  -- * Internal labels+  , TAGGED+  , EXCEPT+  ) where++import qualified Control.Monad.Except as T+import Control.Monad.Signatures (Catch)+import qualified Control.Monad.Trans.Lift.Catch as Lift+import Data.Coerce+import Data.Functor.Identity++import Ether.TaggedTrans+import Ether.Internal++class Monad m => MonadExcept tag e m | m tag -> e where++    -- | Is used within a monadic computation to begin exception processing.+    throw :: e -> m a++    -- | A TaggedTrans function to handle previous exceptions and return to+    -- normal execution.+    catch :: m a -> (e -> m a) -> m a++instance {-# OVERLAPPABLE #-}+         ( Lift.LiftCatch t+         , Monad (t m)+         , MonadExcept tag e m+         ) => MonadExcept tag e (t m) where++    throw = Lift.lift . throw @tag+    {-# INLINE throw #-}++    catch = Lift.liftCatch (catch @tag)+    {-# INLINE catch #-}++-- | Encode type-level information for 'ExceptT'.+data EXCEPT++-- | The parameterizable exception monad.+--+-- Computations are either exceptions or normal values.+--+-- The 'return' function returns a normal value, while '>>=' exits on+-- the first exception.+type Except tag e = ExceptT tag e Identity++-- | The exception monad transformer.+--+-- The 'return' function returns a normal value, while '>>=' exits on+-- the first exception.+type ExceptT tag e = TaggedTrans (TAGGED EXCEPT tag) (T.ExceptT e)++-- | Runs an 'Except' and returns either an exception or a normal value.+runExcept :: forall tag e a . Except tag e a -> Either e a+runExcept = coerce (T.runExcept @e @a)+{-# INLINE runExcept #-}++-- | Runs an 'ExceptT' and returns either an exception or a normal value.+runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)+runExceptT = coerce (T.runExceptT @e @m @a)+{-# INLINE runExceptT #-}++-- | Constructor for computations in the exception monad transformer.+exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a+exceptT = coerce (T.ExceptT @e @m @a)+{-# INLINE exceptT #-}++type instance HandleSuper      EXCEPT e trans   = ()+type instance HandleConstraint EXCEPT e trans m =+  T.MonadError e (trans m)++instance Handle EXCEPT e (T.ExceptT e) where+  handling r = r+  {-# INLINE handling #-}++instance+    ( Handle EXCEPT e trans+    , Monad m, Monad (trans m)+    ) => MonadExcept tag e (TaggedTrans (TAGGED EXCEPT tag) trans m)+  where+    throw =+      handling @EXCEPT @e @trans @m $+      coerce (T.throwError @e @(trans m) @a) ::+        forall eff a . e -> TaggedTrans eff trans m a+    {-# INLINE throw #-}++    catch =+      handling @EXCEPT @e @trans @m $+      coerce (T.catchError @e @(trans m) @a) ::+        forall eff a . Catch e (TaggedTrans eff trans m) a+    {-# INLINE catch #-}++type MonadExcept' e = MonadExcept e e++throw' :: forall e m a . MonadExcept' e m => e -> m a+throw' = throw @e+{-# INLINE throw' #-}++catch' :: forall e m a . MonadExcept' e m => m a -> (e -> m a) -> m a+catch' = catch @e+{-# INLINE catch' #-}++type Except' e = Except e e++runExcept' :: Except' e a -> Either e a+runExcept' = runExcept+{-# INLINE runExcept' #-}++type ExceptT' e = ExceptT e e++exceptT' :: m (Either e a) -> ExceptT' e m a+exceptT' = exceptT+{-# INLINE exceptT' #-}++runExceptT' :: ExceptT' e m a -> m (Either e a)+runExceptT' = runExceptT+{-# INLINE runExceptT' #-}

@@ -0,0 +1,179 @@+module Ether.Internal+  ( Tagged(..)+  , TagsK+  , Tags+  , HasLens(..)+  , LensLike+  , Lens+  , Lens'+  , ReifiedLens(..)+  , ReifiedLens'+  , view+  , over+  , HList(..)+  , KindOf+  , TAGGED+  , HandleSuper+  , HandleConstraint+  , Handle(..)+  ) where++import Control.Applicative+import Control.Monad+import Data.Coerce+import Data.Functor.Identity+import Data.Kind+import Data.List as List+import Data.Tagged+import Data.Traversable+import GHC.Exts (Constraint)+import qualified Language.Haskell.TH as TH++data TAGGED e t++type K_Monad = Type -> Type++type K_Trans = K_Monad -> K_Monad++type family+  HandleSuper+    (eff :: keff)+    (p :: kp)+    (trans :: K_Trans)+  :: Constraint++type family+  HandleConstraint+    (eff :: keff)+    (p :: kp)+    (trans :: K_Trans) (m :: K_Monad)+  :: Constraint++class+  HandleSuper eff p trans =>+    Handle eff p (trans :: K_Trans) | eff trans -> p+  where+    handling :: Monad m => (HandleConstraint eff p trans m => r) -> r++type LensLike f s t a b = (a -> f b) -> s -> f t++type Lens s t a b = forall f. Functor f => LensLike f s t a b++type Lens' s a = Lens s s a a++newtype ReifiedLens s t a b = Lens (Lens s t a b)++type ReifiedLens' s a = ReifiedLens s s a a++class HasLens tag outer inner | tag outer -> inner where+  lensOf :: Lens' outer inner++instance HasLens a a a where+  lensOf = id+  {-# INLINE lensOf #-}++view :: LensLike (Const a) s t a b -> s -> a+view l = coerce (l Const)+{-# INLINE view #-}++over :: LensLike Identity s t a b -> (a -> b) -> s -> t+over = coerce+{-# INLINE over #-}++data HList xs where+  HNil :: HList '[]+  HCons :: x -> HList xs -> HList (x ': xs)++type KindOf (a :: k) = k++type family TagsK (p :: Type) :: [Type]+type family Tags  (p :: Type) :: HList (TagsK p)++return []++type instance TagsK () = '[]+type instance TagsK (Tagged t a) = '[KindOf t]+type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]++return []++type instance Tags () = 'HNil+type instance Tags (Tagged t a) = 'HCons t 'HNil+type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)++do+  let+    tupCount = 62+    names    = [1..] >>= flip replicateM ['a'..'z']+  varNames <- traverse TH.newName (take tupCount names)+  fmap List.concat $+    for (List.drop 2 (List.inits varNames)) $+      \varNames' -> do+        let n = List.length varNames'+        tagsInstances <- for [() | n > 2] $ \() -> do+          tag <- TH.newName "tag"+          let+            (cur:rest) = varNames'+            tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))+              ( TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur :+                map TH.VarT rest )+            tupTy' = foldl TH.AppT (TH.ConT (TH.tupleTypeName (n-1)))+              (map TH.VarT rest)+          return $+            TH.TySynInstD ''TagsK (TH.TySynEqn [tupTy]+              ( TH.PromotedConsT `TH.AppT` (TH.ConT ''KindOf `TH.AppT` TH.VarT tag) `TH.AppT`+                (TH.ConT ''TagsK `TH.AppT` tupTy') ))+        return tagsInstances+do+  let+    tupCount = 62+    names    = [1..] >>= flip replicateM ['a'..'z']+  varNames <- traverse TH.newName (take tupCount names)+  fmap List.concat $+    for (List.drop 2 (List.inits varNames)) $+      \varNames' -> do+        let n = List.length varNames'+        tagsInstances <- for [() | n > 2] $ \() -> do+          tag <- TH.newName "tag"+          let+            (cur:rest) = varNames'+            tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))+              ( TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur :+                map TH.VarT rest )+            tupTy' = foldl TH.AppT (TH.ConT (TH.tupleTypeName (n-1)))+              (map TH.VarT rest)+            tagsInst =+              TH.TySynInstD ''Tags (TH.TySynEqn [tupTy]+                ( TH.PromotedT 'HCons `TH.AppT` TH.VarT tag `TH.AppT`+                  (TH.ConT ''Tags `TH.AppT` tupTy') ))+          return tagsInst+        hasLensInstances <- for [0..n-1] $ \k -> do+          tag <- TH.newName "tag"+          let+            (prev, cur:next) = List.splitAt k varNames'+            tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))+              ( map TH.VarT prev +++                [TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur] +++                map TH.VarT next )+          cur' <- TH.newName "x"+          f <- TH.newName "f"+          return $+            TH.InstanceD Nothing []+              (TH.ConT ''HasLens `TH.AppT` TH.VarT tag `TH.AppT` tupTy `TH.AppT` TH.VarT cur)+              [ TH.FunD 'lensOf+                  [ TH.Clause+                      [TH.VarP f, TH.TupP+                        ( map TH.VarP prev +++                          [TH.ConP 'Tagged [TH.VarP cur]] +++                          map TH.VarP next )]+                      (TH.NormalB $+                         TH.VarE 'fmap `TH.AppE`+                           (TH.LamE [TH.VarP cur']+                             (TH.TupE+                              ( map TH.VarE prev +++                                [TH.ConE 'Tagged `TH.AppE` TH.VarE cur'] +++                                map TH.VarE next ))) `TH.AppE`+                           (TH.VarE f `TH.AppE` TH.VarE cur) )+                      [] ],+                TH.PragmaD (TH.InlineP 'lensOf TH.Inline TH.FunLike TH.AllPhases) ]+        return $ tagsInstances ++ hasLensInstances

@@ -0,0 +1,264 @@+module Ether.Reader+    (+    -- * MonadReader class+      MonadReader+    , ask+    , local+    , reader+    , asks+    -- * The Reader monad+    , Reader+    , runReader+    -- * The ReaderT monad transformer+    , ReaderT+    , readerT+    , runReaderT+    -- * The Reader monad (flattened)+    , Readers+    , runReaders+    -- * The ReaderT monad transformer (flattened)+    , ReadersT+    , runReadersT+    -- * MonadReader class (implicit)+    , MonadReader'+    , local'+    , ask'+    , reader'+    , asks'+    -- * The Reader monad (implicit)+    , Reader'+    , runReader'+    -- * The ReaderT monad transformer (implicit)+    , ReaderT'+    , readerT'+    , runReaderT'+    -- * Internal labels+    , TAGGED+    , READER+    , READERS+    ) where++import qualified Control.Monad.Reader as T+import qualified Control.Monad.Trans.Lift.Local as Lift+import Control.Monad.Trans.Lift.Local (Local)+import Data.Coerce+import Data.Functor.Identity+import Data.Kind++import Ether.TaggedTrans+import Ether.Internal++class Monad m => MonadReader tag r m | m tag -> r where++    {-# MINIMAL (ask | reader), local #-}++    -- | Retrieves the monad environment.+    ask :: m r+    ask = reader @tag id++    -- | Executes a computation in a modified environment.+    local+        :: (r -> r)+        -- ^ The function to modify the environment.+        -> m a+        -- ^ @Reader@ to run in the modified environment.+        -> m a++    -- | Retrieves a function of the current environment.+    reader+        :: (r -> a)+        -- ^ The selector function to apply to the environment.+        -> m a+    reader f = fmap f (ask @tag)++instance {-# OVERLAPPABLE #-}+    ( Lift.LiftLocal t+    , Monad (t m)+    , MonadReader tag r m+    ) => MonadReader tag r (t m)+  where++    ask = Lift.lift (ask @tag)+    {-# INLINE ask #-}++    local = Lift.liftLocal (ask @tag) (local @tag)+    {-# INLINE local #-}++    reader = Lift.lift . reader @tag+    {-# INLINE reader #-}++instance {-# OVERLAPPABLE #-}+    ( Monad (trans m)+    , MonadReader tag r (TaggedTrans effs trans m)+    ) => MonadReader tag r (TaggedTrans (eff ': effs) trans (m :: Type -> Type))+  where++    ask =+      (coerce ::+        TaggedTrans         effs  trans m r ->+        TaggedTrans (eff ': effs) trans m r)+      (ask @tag)+    {-# INLINE ask #-}++    local =+      (coerce :: forall a .+        Lift.Local r (TaggedTrans         effs  trans m) a ->+        Lift.Local r (TaggedTrans (eff ': effs) trans m) a)+      (local @tag)+    {-# INLINE local #-}++    reader =+      (coerce :: forall a .+        ((r -> a) -> TaggedTrans         effs  trans m a) ->+        ((r -> a) -> TaggedTrans (eff ': effs) trans m a))+      (reader @tag)+    {-# INLINE reader #-}++-- | Retrieves a function of the current environment.+asks+  :: forall tag r m a+   . MonadReader tag r m+  => (r -> a)+  -- ^ The selector function to apply to the environment.+  -> m a+asks = reader @tag+{-# INLINE asks #-}++-- | Encode type-level information for 'ReaderT'.+data READER++-- | The parameterizable reader monad.+--+-- Computations are functions of a shared environment.+--+-- The 'return' function ignores the environment, while '>>=' passes+-- the inherited environment to both subcomputations.+type Reader tag r = ReaderT tag r Identity++-- | The reader monad transformer,+-- which adds a read-only environment to the given monad.+--+-- The 'return' function ignores the environment, while '>>=' passes+-- the inherited environment to both subcomputations.+type ReaderT tag r = TaggedTrans (TAGGED READER tag) (T.ReaderT r)++-- | Constructor for computations in the reader monad transformer.+readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a+readerT = coerce (T.ReaderT @r @m @a)+{-# INLINE readerT #-}++-- | Runs a 'ReaderT' with the given environment+-- and returns the final value.+runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a+runReaderT = coerce (T.runReaderT @r @_ @m @a)+{-# INLINE runReaderT #-}++-- | Runs a 'ReaderT' with the given environment+-- and returns the final value.+runReader :: forall tag r a . Reader tag r a -> r -> a+runReader = coerce (T.runReader @r @a)+{-# INLINE runReader #-}++type instance HandleSuper      READER r trans   = ()+type instance HandleConstraint READER r trans m =+  T.MonadReader r (trans m)++instance Handle READER r (T.ReaderT r) where+  handling r = r+  {-# INLINE handling #-}++instance+    ( Handle READER r trans+    , Monad m, Monad (trans m)+    ) => MonadReader tag r (TaggedTrans (TAGGED READER tag) trans m)+  where++    ask =+      handling @READER @r @trans @m $+      coerce (T.ask @r @(trans m))+    {-# INLINE ask #-}++    local =+      handling @READER @r @trans @m $+      coerce (T.local @r @(trans m) @a) ::+        forall eff a . Local r (TaggedTrans eff trans m) a+    {-# INLINE local #-}++    reader =+      handling @READER @r @trans @m $+      coerce (T.reader @r @(trans m) @a) ::+        forall eff a . (r -> a) -> TaggedTrans eff trans m a+    {-# INLINE reader #-}++instance+    ( HasLens tag payload r+    , Handle READER payload trans+    , Monad m, Monad (trans m)+    ) => MonadReader tag r (TaggedTrans (TAGGED READER tag ': effs) trans m)+  where++    ask =+      handling @READER @payload @trans @m $+      (coerce :: forall eff a .+                    trans m a ->+        TaggedTrans eff trans m a)+      (T.asks (view (lensOf @tag @payload @r)))+    {-# INLINE ask #-}++    local f =+      handling @READER @payload @trans @m $+      (coerce :: forall eff a .+                    (trans m a ->            trans m a) ->+        (TaggedTrans eff trans m a -> TaggedTrans eff trans m a))+      (T.local (over (lensOf @tag @payload @r) f))+    {-# INLINE local #-}++type family READERS (ts :: HList xs) :: [Type] where+  READERS 'HNil = '[]+  READERS ('HCons t ts) = TAGGED READER t ': READERS ts++type ReadersT r = TaggedTrans (READERS (Tags r)) (T.ReaderT r)++type Readers r = ReadersT r Identity++runReadersT :: forall p m a . ReadersT p m a -> p -> m a+runReadersT = coerce (T.runReaderT @p @_ @m @a)+{-# INLINE runReadersT #-}++runReaders :: forall p a . Readers p a -> p -> a+runReaders = coerce (T.runReader @p @a)+{-# INLINE runReaders #-}++type ReaderT' r = ReaderT r r++readerT' :: (r -> m a) -> ReaderT' r m a+readerT' = readerT+{-# INLINE readerT' #-}++runReaderT' :: ReaderT' r m a -> r -> m a+runReaderT' = runReaderT+{-# INLINE runReaderT' #-}++type Reader' r = Reader r r++runReader' :: Reader' r a -> r -> a+runReader' = runReader+{-# INLINE runReader' #-}++type MonadReader' r = MonadReader r r++local' :: forall r m a . MonadReader' r m => (r -> r) -> m a -> m a+local' = local @r+{-# INLINE local' #-}++ask' :: forall r m . MonadReader' r m => m r+ask' = ask @r+{-# INLINE ask' #-}++reader' :: forall r m a . MonadReader' r m => (r -> a) -> m a+reader' = reader @r+{-# INLINE reader' #-}++asks' :: forall r m a . MonadReader' r m => (r -> a) -> m a+asks' = asks @r+{-# INLINE asks' #-}

@@ -0,0 +1,471 @@+module Ether.State+    (+    -- * MonadState class+      MonadState+    , get+    , put+    , state+    , modify+    , gets+    -- * The State monad+    , State+    , runState+    , evalState+    , execState+    -- * The StateT monad transformer+    , StateT+    , stateT+    , runStateT+    , evalStateT+    , execStateT+    -- * The State monad (lazy)+    , LazyState+    , runLazyState+    , evalLazyState+    , execLazyState+    -- * The StateT monad transformer (lazy)+    , LazyStateT+    , lazyStateT+    , runLazyStateT+    , evalLazyStateT+    , execLazyStateT+    -- * The State monad (flattened)+    , States+    , runStates+    -- * The StateT monad transformer (flattened)+    , StatesT+    , runStatesT+    -- * MonadState class (implicit)+    , MonadState'+    , get'+    , put'+    , state'+    , modify'+    , gets'+    -- * The State monad (implicit)+    , State'+    , runState'+    , evalState'+    , execState'+    -- * The StateT monad transformer (implicit)+    , StateT'+    , stateT'+    , runStateT'+    , evalStateT'+    , execStateT'+    -- * The State monad (lazy, implicit)+    , LazyState'+    , runLazyState'+    , evalLazyState'+    , execLazyState'+    -- * The StateT monad transformer (lazy, implicit)+    , LazyStateT'+    , lazyStateT'+    , runLazyStateT'+    , evalLazyStateT'+    , execLazyStateT'+    -- * Zoom+    , ZoomT+    , zoom+    -- * Internal labels+    , TAGGED+    , STATE+    , STATES+    , ZOOM+    ) where++import qualified Control.Monad.State.Class as T+import qualified Control.Monad.Trans as Lift+import Control.Monad.Trans.Identity+import qualified Control.Monad.Trans.State.Lazy as T.Lazy+import qualified Control.Monad.Trans.State.Strict as T.Strict+import Data.Coerce+import Data.Functor.Identity+import Data.Kind+import Data.Proxy+import Data.Reflection++import Ether.Internal+import Ether.TaggedTrans++class Monad m => MonadState tag s m | m tag -> s where++    {-# MINIMAL state | get, put #-}++    -- | Return the state from the internals of the monad.+    get :: m s+    get = state @tag (\s -> (s, s))++    -- | Replace the state inside the monad.+    put :: s -> m ()+    put s = state @tag (\_ -> ((), s))++    -- | Embed a simple state action into the monad.+    state :: (s -> (a, s)) -> m a+    state f = do+      s <- get @tag+      let ~(a, s') = f s+      put @tag s'+      return a++instance {-# OVERLAPPABLE #-}+    ( Lift.MonadTrans t+    , Monad (t m)+    , MonadState tag s m+    ) => MonadState tag s (t m)+  where++    get = Lift.lift (get @tag)+    {-# INLINE get #-}++    put = Lift.lift . put @tag+    {-# INLINE put #-}++    state = Lift.lift . state @tag+    {-# INLINE state #-}++instance {-# OVERLAPPABLE #-}+    ( Monad (trans m)+    , MonadState tag s (TaggedTrans effs trans m)+    ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))+  where++    get =+      (coerce ::+        TaggedTrans         effs  trans m s ->+        TaggedTrans (eff ': effs) trans m s)+      (get @tag)+    {-# INLINE get #-}++    put =+      (coerce ::+        (s -> TaggedTrans         effs  trans m ()) ->+        (s -> TaggedTrans (eff ': effs) trans m ()))+      (put @tag)+    {-# INLINE put #-}++    state =+      (coerce :: forall a .+        ((s -> (a, s)) -> TaggedTrans         effs  trans m a) ->+        ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))+      (state @tag)+    {-# INLINE state #-}++-- | Modifies the state inside a state monad.+modify :: forall tag s m . MonadState tag s m => (s -> s) -> m ()+modify f = state @tag (\s -> ((), f s))+{-# INLINABLE modify #-}++-- | Gets specific component of the state, using a projection function supplied.+gets :: forall tag s m a . MonadState tag s m => (s -> a) -> m a+gets f = fmap f (get @tag)+{-# INLINABLE gets #-}++-- | Encode type-level information for 'StateT'.+data STATE++type instance HandleSuper      STATE s trans   = ()+type instance HandleConstraint STATE s trans m =+  T.MonadState s (trans m)++instance Handle STATE s (T.Strict.StateT s) where+  handling r = r+  {-# INLINE handling #-}++instance Handle STATE s (T.Lazy.StateT s) where+  handling r = r+  {-# INLINE handling #-}++instance+    ( Handle STATE s trans+    , Monad m, Monad (trans m)+    ) => MonadState tag s (TaggedTrans (TAGGED STATE tag) trans m)+  where++    get =+      handling @STATE @s @trans @m $+      coerce (T.get @s @(trans m))+    {-# INLINE get #-}++    put =+      handling @STATE @s @trans @m $+      coerce (T.put @s @(trans m))+    {-# INLINE put #-}++    state =+      handling @STATE @s @trans @m $+      coerce (T.state @s @(trans m) @a) ::+        forall eff a . (s -> (a, s)) -> TaggedTrans eff trans m a+    {-# INLINE state #-}++instance+    ( HasLens tag payload s+    , Handle STATE payload trans+    , Monad m, Monad (trans m)+    ) => MonadState tag s (TaggedTrans (TAGGED STATE tag ': effs) trans m)+  where++    get =+      handling @STATE @payload @trans @m $+      (coerce :: forall eff a .+                    trans m a ->+        TaggedTrans eff trans m a)+      (T.gets (view (lensOf @tag @payload @s)))+    {-# INLINE get #-}++    put s =+      handling @STATE @payload @trans @m $+      (coerce :: forall eff a .+                    trans m a ->+        TaggedTrans eff trans m a)+      (T.modify (over (lensOf @tag @payload @s) (const s)))+    {-# INLINE put #-}++    state f =+      handling @STATE @payload @trans @m $+      (coerce :: forall eff a .+                    trans m a ->+        TaggedTrans eff trans m a)+      (T.state (lensOf @tag @payload @s f))+    {-# INLINE state #-}++-- | The parametrizable state monad.+--+-- Computations have access to a mutable state.+--+-- The 'return' function leaves the state unchanged, while '>>=' uses+-- the final state of the first computation as the initial state of the second.+type State tag r = StateT tag r Identity++-- | The state monad transformer.+--+-- The 'return' function leaves the state unchanged, while '>>=' uses+-- the final state of the first computation as the initial state of the second.+type StateT tag s = TaggedTrans (TAGGED STATE tag) (T.Strict.StateT s)++-- | Constructor for computations in the state monad transformer.+stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a+stateT = coerce (T.Strict.StateT @s @m @a)+{-# INLINE stateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns both the final value and the final state.+runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)+runStateT = coerce (T.Strict.runStateT @s @m @a)+{-# INLINE runStateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns the final value, discarding the final state.+evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a+evalStateT = coerce (T.Strict.evalStateT @m @s @a)+{-# INLINE evalStateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns the final state, discarding the final value.+execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s+execStateT = coerce (T.Strict.execStateT @m @s @a)+{-# INLINE execStateT #-}++-- | Runs a 'State' with the given initial state+-- and returns both the final value and the final state.+runState :: forall tag s a . State tag s a -> s -> (a, s)+runState = coerce (T.Strict.runState @s @a)+{-# INLINE runState #-}++-- | Runs a 'State' with the given initial state+-- and returns the final value, discarding the final state.+evalState :: forall tag s a . State tag s a -> s -> a+evalState = coerce (T.Strict.evalState @s @a)+{-# INLINE evalState #-}++-- | Runs a 'State' with the given initial state+-- and returns the final state, discarding the final value.+execState :: forall tag s a . State tag s a -> s -> s+execState = coerce (T.Strict.execState @s @a)+{-# INLINE execState #-}++-- | The parametrizable state monad.+--+-- Computations have access to a mutable state.+--+-- The 'return' function leaves the state unchanged, while '>>=' uses+-- the final state of the first computation as the initial state of the second.+type LazyState tag r = LazyStateT tag r Identity++-- | The state monad transformer.+--+-- The 'return' function leaves the state unchanged, while '>>=' uses+-- the final state of the first computation as the initial state of the second.+type LazyStateT tag s = TaggedTrans (TAGGED STATE tag) (T.Lazy.StateT s)++-- | Constructor for computations in the state monad transformer.+lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a+lazyStateT = coerce (T.Lazy.StateT @s @m @a)+{-# INLINE lazyStateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns both the final value and the final state.+runLazyStateT :: forall tag s m a . LazyStateT tag s m a -> s -> m (a, s)+runLazyStateT = coerce (T.Lazy.runStateT @s @m @a)+{-# INLINE runLazyStateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns the final value, discarding the final state.+evalLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m a+evalLazyStateT = coerce (T.Lazy.evalStateT @m @s @a)+{-# INLINE evalLazyStateT #-}++-- | Runs a 'StateT' with the given initial state+-- and returns the final state, discarding the final value.+execLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m s+execLazyStateT = coerce (T.Lazy.execStateT @m @s @a)+{-# INLINE execLazyStateT #-}++-- | Runs a 'State' with the given initial state+-- and returns both the final value and the final state.+runLazyState :: forall tag s a . LazyState tag s a -> s -> (a, s)+runLazyState = coerce (T.Lazy.runState @s @a)+{-# INLINE runLazyState #-}++-- | Runs a 'State' with the given initial state+-- and returns the final value, discarding the final state.+evalLazyState :: forall tag s a . LazyState tag s a -> s -> a+evalLazyState = coerce (T.Lazy.evalState @s @a)+{-# INLINE evalLazyState #-}++-- | Runs a 'State' with the given initial state+-- and returns the final state, discarding the final value.+execLazyState :: forall tag s a . LazyState tag s a -> s -> s+execLazyState = coerce (T.Lazy.execState @s @a)+{-# INLINE execLazyState #-}++type family STATES (ts :: HList xs) :: [Type] where+  STATES 'HNil = '[]+  STATES ('HCons t ts) = TAGGED STATE t ': STATES ts++type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)++type States s = StatesT s Identity++runStatesT :: forall p m a . StatesT p m a -> p -> m (a, p)+runStatesT = coerce (T.Strict.runStateT @p @m @a)+{-# INLINE runStatesT #-}++runStates :: forall p a . States p a -> p -> (a, p)+runStates = coerce (T.Strict.runState @p @a)+{-# INLINE runStates #-}++type StateT' s = StateT s s++stateT' :: (s -> m (a, s)) -> StateT' s m a+stateT' = stateT+{-# INLINE stateT' #-}++runStateT' :: StateT' s m a -> s -> m (a, s)+runStateT' = runStateT+{-# INLINE runStateT' #-}++runState' :: State' s a -> s -> (a, s)+runState' = runState+{-# INLINE runState' #-}++evalStateT' :: Monad m => StateT' s m a -> s -> m a+evalStateT' = evalStateT+{-# INLINE evalStateT' #-}++type State' s = State s s++evalState' :: State' s a -> s -> a+evalState' = evalState+{-# INLINE evalState' #-}++execStateT' :: Monad m => StateT' s m a -> s -> m s+execStateT' = execStateT+{-# INLINE execStateT' #-}++execState' :: State' s a -> s -> s+execState' = execState+{-# INLINE execState' #-}++type LazyStateT' s = LazyStateT s s++lazyStateT' :: (s -> m (a, s)) -> LazyStateT' s m a+lazyStateT' = lazyStateT+{-# INLINE lazyStateT' #-}++runLazyStateT' :: LazyStateT' s m a -> s -> m (a, s)+runLazyStateT' = runLazyStateT+{-# INLINE runLazyStateT' #-}++runLazyState' :: LazyState' s a -> s -> (a, s)+runLazyState' = runLazyState+{-# INLINE runLazyState' #-}++evalLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m a+evalLazyStateT' = evalLazyStateT+{-# INLINE evalLazyStateT' #-}++type LazyState' s = LazyState s s++evalLazyState' :: LazyState' s a -> s -> a+evalLazyState' = evalLazyState+{-# INLINE evalLazyState' #-}++execLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m s+execLazyStateT' = execLazyStateT+{-# INLINE execLazyStateT' #-}++execLazyState' :: LazyState' s a -> s -> s+execLazyState' = execLazyState+{-# INLINE execLazyState' #-}++type MonadState' s = MonadState s s++get' :: forall s m . MonadState' s m => m s+get' = get @s+{-# INLINE get' #-}++gets' :: forall s m a . MonadState' s m => (s -> a) -> m a+gets' = gets @s+{-# INLINE gets' #-}++put' :: forall s m . MonadState' s m => s -> m ()+put' = put @s+{-# INLINE put' #-}++state' :: forall s m a . MonadState' s m => (s -> (a, s)) -> m a+state' = state @s+{-# INLINE state' #-}++modify' :: forall s m . MonadState' s m => (s -> s) -> m ()+modify' = modify @s+{-# INLINE modify' #-}++-- | Encode type-level information for 'zoom'.+data ZOOM t z++type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT++-- | Zoom into a part of a state using a lens.+zoom+  :: forall tag sOuter sInner m a+   . Lens' sOuter sInner+  -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => ZoomT tag z m a)+  -> m a+zoom l m = reify (Lens l) (\(_ :: Proxy z) -> coerce (m @z))+{-# INLINE zoom #-}++instance+    ( MonadState tag sOuter m+    , Reifies z (ReifiedLens' sOuter sInner)+    , trans ~ IdentityT+    ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)+  where+    state =+      (coerce :: forall eff r a .+        (r ->                       m a) ->+        (r -> TaggedTrans eff trans m a))+      (state @tag . l)+      where+        Lens l = reflect (Proxy :: Proxy z)+    {-# INLINE state #-}

@@ -0,0 +1,188 @@+{- |++Type-level machinery to manipulate constraints on the monad+transformer stack.++Out of the box it provides the following dispatch strategies:++* 'tagAttach' to use functions defined using untagged monad classes+  as if they were defined using tagged ones.++* 'tagReplace' to use functions defined using one tag+  as if they were defined using another one.++> import Ether+> import Control.Monad.State as Mtl+>+> data Foo+> data Bar+>+> f :: Mtl.MonadState Int m => m String+> f = fmap show Mtl.get+>+> g :: Ether.MonadState Foo Int m => m String+> g = tagAttach @Foo f+>+> h :: Ether.MonadState Bar Int m => m String+> h = tagReplace @Foo @Bar g++-}++module Ether.TagDispatch+  (+  -- * The Tag Attach monad transformer+    TagAttachT+  , tagAttach+  -- * The Tag Replace monad transformer+  , TagReplaceT+  , tagReplace+  -- * Internal labels+  , TAG_ATTACH+  , TAG_REPLACE+  ) where++import qualified Control.Monad.Error.Class   as Mtl+import qualified Control.Monad.Reader.Class  as Mtl+import qualified Control.Monad.State.Class   as Mtl+import qualified Control.Monad.Writer.Class  as Mtl++import Ether.Except+import Ether.Reader+import Ether.State+import Ether.Writer+import Ether.TaggedTrans++import Control.Monad.Trans.Identity+import Data.Coerce++-- | Encode type-level information for 'tagAttach'.+data TAG_ATTACH t++type TagAttachT t = TaggedTrans (TAG_ATTACH t) IdentityT++-- | Attach a tag to untagged transformers.+tagAttach :: forall tag m a . TagAttachT tag m a -> m a+tagAttach = coerce (runIdentityT @_ @m @a)+{-# INLINE tagAttach #-}++instance {-# OVERLAPPING #-}+    ( MonadReader tag r m, trans ~ IdentityT+    ) => Mtl.MonadReader r (TaggedTrans (TAG_ATTACH tag) trans m)+  where++    ask = ask @tag+    {-# INLINE ask #-}++    local = local @tag+    {-# INLINE local #-}++    reader = reader @tag+    {-# INLINE reader #-}++instance {-# OVERLAPPING #-}+    ( MonadState tag s m, trans ~ IdentityT+    ) => Mtl.MonadState s (TaggedTrans (TAG_ATTACH tag) trans m)+  where++    get = get @tag+    {-# INLINE get #-}++    put = put @tag+    {-# INLINE put #-}++    state = state @tag+    {-# INLINE state #-}++instance {-# OVERLAPPING #-}+    ( MonadExcept tag e m, trans ~ IdentityT+    ) => Mtl.MonadError e (TaggedTrans (TAG_ATTACH tag) trans m)+  where++    throwError = throw @tag+    {-# INLINE throwError #-}++    catchError = catch @tag+    {-# INLINE catchError #-}++instance {-# OVERLAPPING #-}+    ( MonadWriter tag w m, trans ~ IdentityT+    ) => Mtl.MonadWriter w (TaggedTrans (TAG_ATTACH tag) trans m)+  where++    writer = writer @tag+    {-# INLINE writer #-}++    tell = tell @tag+    {-# INLINE tell #-}++    listen = listen @tag+    {-# INLINE listen #-}++    pass = pass @tag+    {-# INLINE pass #-}++-- | Encode type-level information for 'tagReplace'.+data TAG_REPLACE tOld tNew++type TagReplaceT tOld tNew = TaggedTrans (TAG_REPLACE tOld tNew) IdentityT++-- | Replace a tag with another tag.+tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a+tagReplace = coerce (runIdentityT @_ @m @a)+{-# INLINE tagReplace #-}++instance+    ( MonadReader tNew r m, trans ~ IdentityT+    ) => MonadReader tOld r (TaggedTrans (TAG_REPLACE tOld tNew) trans m)+  where++    ask = ask @tNew+    {-# INLINE ask #-}++    local = local @tNew+    {-# INLINE local #-}++    reader = reader @tNew+    {-# INLINE reader #-}++instance+    ( MonadState tNew s m, trans ~ IdentityT+    ) => MonadState tOld s (TaggedTrans (TAG_REPLACE tOld tNew) trans m)+  where++    get = get @tNew+    {-# INLINE get #-}++    put = put @tNew+    {-# INLINE put #-}++    state = state @tNew+    {-# INLINE state #-}++instance+    ( MonadExcept tNew e m, trans ~ IdentityT+    ) => MonadExcept tOld e (TaggedTrans (TAG_REPLACE tOld tNew) trans m)+  where++    throw = throw @tNew+    {-# INLINE throw #-}++    catch = catch @tNew+    {-# INLINE catch #-}++instance+    ( MonadWriter tNew w m, trans ~ IdentityT+    ) => MonadWriter tOld w (TaggedTrans (TAG_REPLACE tOld tNew) trans m)+  where++    writer = writer @tNew+    {-# INLINE writer #-}++    tell = tell @tNew+    {-# INLINE tell #-}++    listen = listen @tNew+    {-# INLINE listen #-}++    pass = pass @tNew+    {-# INLINE pass #-}

@@ -0,0 +1,182 @@+module Ether.TaggedTrans+  ( TaggedTrans(..)+  ) where++import Control.Applicative+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor, MMonad)+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)++import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC++import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift++import qualified Control.Monad.Cont.Class    as Mtl+import qualified Control.Monad.Reader.Class  as Mtl+import qualified Control.Monad.State.Class   as Mtl+import qualified Control.Monad.Writer.Class  as Mtl+import qualified Control.Monad.Error.Class   as Mtl++import GHC.Generics (Generic)+import Data.Coerce (coerce)++newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)+  deriving+    ( Generic+    , Functor, Applicative, Alternative, Monad, MonadPlus+    , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad+    , MonadThrow, MonadCatch, MonadMask )++type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a++type Unpack tag trans m a = TaggedTrans tag trans m a -> trans m a++instance+    ( MB.MonadBase b (trans m)+    ) => MB.MonadBase b (TaggedTrans tag trans m)+  where+    liftBase =+      (coerce :: forall a .+        (b a -> trans m a) ->+        (b a -> TaggedTrans tag trans m a))+      MB.liftBase+    {-# INLINE liftBase #-}++instance+    ( MC.MonadTransControl trans+    ) => MC.MonadTransControl (TaggedTrans tag trans)+  where+    type StT (TaggedTrans tag trans) a = MC.StT trans a++    liftWith = MC.defaultLiftWith+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)+    {-# INLINE liftWith #-}++    restoreT = MC.defaultRestoreT+      (coerce :: Pack tag trans m a)+    {-# INLINE restoreT #-}++type LiftBaseWith b m a = (MC.RunInBase m b -> b a) -> m a++newtype LiftBaseWith' b m a = LBW { unLBW :: LiftBaseWith b m a }++coerceLiftBaseWith ::+  LiftBaseWith b                 (trans m) a ->+  LiftBaseWith b (TaggedTrans tag trans m) a+coerceLiftBaseWith lbw =+  unLBW (coerce (LBW lbw))+{-# INLINE coerceLiftBaseWith #-}++instance+    ( MC.MonadBaseControl b (trans m)+    ) => MC.MonadBaseControl b (TaggedTrans tag trans m)+  where+    type StM (TaggedTrans tag trans m) a = MC.StM (trans m) a++    liftBaseWith = coerceLiftBaseWith MC.liftBaseWith+    {-# INLINE liftBaseWith #-}++    restoreM =+      (coerce :: forall a .+        (MC.StM (trans m) a ->                 trans m a) ->+        (MC.StM (trans m) a -> TaggedTrans tag trans m a))+      MC.restoreM+    {-# INLINE restoreM #-}++type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a++instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where+  liftLocal =+    Lift.defaultLiftLocal+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)++instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where+  liftCatch =+    Lift.defaultLiftCatch+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)++instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where+  liftListen =+    Lift.defaultLiftListen+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)++instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where+  liftPass =+    Lift.defaultLiftPass+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)++instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where+  liftCallCC  =+    Lift.defaultLiftCallCC+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)+  liftCallCC' =+    Lift.defaultLiftCallCC'+      (coerce :: Pack tag trans m a)+      (coerce :: Unpack tag trans m a)+++-- Instances for mtl classes++instance+    ( Mtl.MonadCont m+    , Lift.LiftCallCC trans+    , Monad (trans m)+    ) => Mtl.MonadCont (TaggedTrans tag trans m)+  where+    callCC = Lift.liftCallCC' Mtl.callCC++instance+    ( Mtl.MonadReader r m+    , Lift.LiftLocal trans+    , Monad (trans m)+    ) => Mtl.MonadReader r (TaggedTrans tag trans m)+  where+    ask = lift Mtl.ask+    local = Lift.liftLocal Mtl.ask Mtl.local+    reader = lift . Mtl.reader++instance+    ( Mtl.MonadState s m+    , MonadTrans trans+    , Monad (trans m)+    ) => Mtl.MonadState s (TaggedTrans tag trans m)+  where+    get = lift Mtl.get+    put = lift . Mtl.put+    state = lift . Mtl.state++instance+    ( Mtl.MonadWriter w m+    , Lift.LiftListen trans+    , Lift.LiftPass trans+    , Monad (trans m)+    ) => Mtl.MonadWriter w (TaggedTrans tag trans m)+  where+    writer = lift . Mtl.writer+    tell   = lift . Mtl.tell+    listen = Lift.liftListen Mtl.listen+    pass   = Lift.liftPass Mtl.pass++instance+    ( Mtl.MonadError e m+    , Lift.LiftCatch trans+    , Monad (trans m)+    ) => Mtl.MonadError e (TaggedTrans tag trans m)+  where+    throwError = lift . Mtl.throwError+    catchError = Lift.liftCatch Mtl.catchError

@@ -0,0 +1,327 @@+module Ether.Writer+  (+  -- * MonadWriter class+    MonadWriter+  , writer+  , tell+  , listen+  , pass+  , listens+  , censor+  -- * The Writer monad+  , Writer+  , runWriter+  , execWriter+  -- * The WriterT monad transformer+  , WriterT+  , writerT+  , runWriterT+  , execWriterT+  -- * The Writer monad (lazy)+  , LazyWriter+  , runLazyWriter+  , execLazyWriter+  -- * The WriterT monad transformer (lazy)+  , LazyWriterT+  , lazyWriterT+  , runLazyWriterT+  , execLazyWriterT+  -- * MonadWriter class (implicit)+  , MonadWriter'+  , writer'+  , tell'+  , listen'+  , pass'+  , listens'+  , censor'+  -- * The Writer monad (implicit)+  , Writer'+  , runWriter'+  , execWriter'+  -- * The WriterT monad transformer (implicit)+  , WriterT'+  , writerT'+  , runWriterT'+  , execWriterT'+  -- * The Writer monad (lazy, implicit)+  , LazyWriter'+  , runLazyWriter'+  , execLazyWriter'+  -- * The WriterT monad transformer (lazy, implicit)+  , LazyWriterT'+  , lazyWriterT'+  , runLazyWriterT'+  , execLazyWriterT'+  -- * Internal labels+  , TAGGED+  , WRITER+  ) where++import Control.Monad.Signatures (Listen, Pass)+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Writer.Class as T+import qualified Control.Monad.Writer.CPS as T.CPS+import qualified Control.Monad.Writer.Lazy as T.Lazy+import Data.Coerce+import Data.Functor.Identity++import Ether.Internal+import Ether.TaggedTrans++class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where++    {-# MINIMAL (writer | tell), listen, pass #-}++    -- | Embed a simple writer action.+    writer :: (a, w) -> m a+    writer ~(a, w) = a <$ tell @tag w++    -- | Append a value to the accumulator within the monad.+    tell :: w -> m ()+    tell w = writer @tag ((),w)++    -- | Execute an action and add its accumulator+    -- to the value of the computation.+    listen :: m a -> m (a, w)++    -- | Execute an action which returns a value and a function,+    -- and return the value, applying the function to the accumulator.+    pass :: m (a, w -> w) -> m a++instance {-# OVERLAPPABLE #-}+         ( Lift.LiftListen t+         , Lift.LiftPass   t+         , Monad (t m)+         , MonadWriter tag w m+         , Monoid w+         ) => MonadWriter tag w (t m) where++    writer = Lift.lift . writer @tag+    {-# INLINE writer #-}++    tell   = Lift.lift . tell @tag+    {-# INLINE tell #-}++    listen = Lift.liftListen (listen @tag)+    {-# INLINE listen #-}++    pass   = Lift.liftPass (pass @tag)+    {-# INLINE pass #-}++-- | Execute an action and add the result of applying the given function to+-- its accumulator to the value of the computation.+listens :: forall tag w m a b . MonadWriter tag w m => (w -> b) -> m a -> m (a, b)+listens f m = do+  ~(a, w) <- listen @tag m+  return (a, f w)++-- | Execute an action and apply a function to its accumulator.+censor :: forall tag w m a . MonadWriter tag w m => (w -> w) -> m a -> m a+censor f m = pass @tag $ do+  a <- m+  return (a, f)++-- | Encode type-level information for 'WriterT'.+data WRITER++type instance HandleSuper      WRITER w trans   = Monoid w+type instance HandleConstraint WRITER w trans m =+  T.MonadWriter w (trans m)++instance Monoid w => Handle WRITER w (T.CPS.WriterT w) where+  handling r = r+  {-# INLINE handling #-}++instance Monoid w => Handle WRITER w (T.Lazy.WriterT w) where+  handling r = r+  {-# INLINE handling #-}++instance+    ( Handle WRITER w trans+    , Monad m, Monad (trans m)+    ) => MonadWriter tag w (TaggedTrans (TAGGED WRITER tag) trans m)+  where++    writer =+      handling @WRITER @w @trans @m $+      coerce (T.writer @w @(trans m) @a) ::+        forall eff a . (a, w) -> TaggedTrans eff trans m a+    {-# INLINE writer #-}++    tell =+      handling @WRITER @w @trans @m $+      coerce (T.tell @w @(trans m))+    {-# INLINE tell #-}++    listen =+      handling @WRITER @w @trans @m $+      coerce (T.listen @w @(trans m) @a) ::+        forall eff a . Listen w (TaggedTrans eff trans m) a+    {-# INLINE listen #-}++    pass =+      handling @WRITER @w @trans @m $+      coerce (T.pass @w @(trans m) @a) ::+        forall eff a . Pass w (TaggedTrans eff trans m) a+    {-# INLINE pass #-}++-- | The parametrizable writer monad.+--+-- Computations can accumulate a monoid value.+--+-- The 'return' function produces the output 'mempty', while '>>=' combines+-- the outputs of the subcomputations using 'mappend'.+type Writer tag w = WriterT tag w Identity++-- | The writer monad transformer.+--+-- The 'return' function produces the output 'mempty', while '>>=' combines+-- the outputs of the subcomputations using 'mappend'.+type WriterT tag w = TaggedTrans (TAGGED WRITER tag) (T.CPS.WriterT w)++-- | Constructor for computations in the writer monad transformer.+writerT :: forall tag w m a . (Functor m, Monoid w) => m (a, w) -> WriterT tag w m a+writerT = coerce (T.CPS.writerT @m @w @a)+{-# INLINE writerT #-}++-- | Runs a 'WriterT' and returns both the normal value+-- and the final accumulator.+runWriterT :: forall tag w m a . Monoid w => WriterT tag w m a -> m (a, w)+runWriterT = coerce (T.CPS.runWriterT @w @m @a)+{-# INLINE runWriterT #-}++-- | Runs a 'Writer' and returns both the normal value+-- and the final accumulator.+runWriter :: forall tag w a . Monoid w => Writer tag w a -> (a, w)+runWriter = coerce (T.CPS.runWriter @w @a)+{-# INLINE runWriter #-}++-- | Runs a 'WriterT' and returns the final accumulator,+-- discarding the normal value.+execWriterT :: forall tag w m a . (Monad m, Monoid w) => WriterT tag w m a -> m w+execWriterT = coerce (T.CPS.execWriterT @m @w @a)+{-# INLINE execWriterT #-}++-- | Runs a 'Writer' and returns the final accumulator,+-- discarding the normal value.+execWriter :: forall tag w a . Monoid w => Writer tag w a -> w+execWriter = coerce (T.CPS.execWriter @w @a)+{-# INLINE execWriter #-}++-- | The parametrizable writer monad.+--+-- Computations can accumulate a monoid value.+--+-- The 'return' function produces the output 'mempty', while '>>=' combines+-- the outputs of the subcomputations using 'mappend'.+type LazyWriter tag w = LazyWriterT tag w Identity++-- | The writer monad transformer.+--+-- The 'return' function produces the output 'mempty', while '>>=' combines+-- the outputs of the subcomputations using 'mappend'.+type LazyWriterT tag w = TaggedTrans (TAGGED WRITER tag) (T.Lazy.WriterT w)++-- | Constructor for computations in the writer monad transformer.+lazyWriterT :: forall tag w m a . m (a, w) -> LazyWriterT tag w m a+lazyWriterT = coerce (T.Lazy.WriterT @w @m @a)+{-# INLINE lazyWriterT #-}++-- | Runs a 'WriterT' and returns both the normal value+-- and the final accumulator.+runLazyWriterT :: forall tag w m a . LazyWriterT tag w m a -> m (a, w)+runLazyWriterT = coerce (T.Lazy.runWriterT @w @m @a)+{-# INLINE runLazyWriterT #-}++-- | Runs a 'Writer' and returns both the normal value+-- and the final accumulator.+runLazyWriter :: forall tag w a . LazyWriter tag w a -> (a, w)+runLazyWriter = coerce (T.Lazy.runWriter @w @a)+{-# INLINE runLazyWriter #-}++-- | Runs a 'WriterT' and returns the final accumulator,+-- discarding the normal value.+execLazyWriterT :: forall tag w m a . Monad m => LazyWriterT tag w m a -> m w+execLazyWriterT = coerce (T.Lazy.execWriterT @m @w @a)+{-# INLINE execLazyWriterT #-}++-- | Runs a 'Writer' and returns the final accumulator,+-- discarding the normal value.+execLazyWriter :: forall tag w a . LazyWriter tag w a -> w+execLazyWriter = coerce (T.Lazy.execWriter @w @a)+{-# INLINE execLazyWriter #-}++type Writer' w = Writer w w++runWriter' :: Monoid w => Writer' w a -> (a, w)+runWriter' = runWriter+{-# INLINE runWriter' #-}++execWriter' :: Monoid w => Writer' w a -> w+execWriter' = execWriter+{-# INLINE execWriter' #-}++type WriterT' w = WriterT w w++writerT' :: (Functor m, Monoid w) => m (a, w) -> WriterT' w m a+writerT' = writerT+{-# INLINE writerT' #-}++runWriterT' :: Monoid w => WriterT' w m a -> m (a, w)+runWriterT' = runWriterT+{-# INLINE runWriterT' #-}++execWriterT' :: (Monad m, Monoid w) => WriterT' w m a -> m w+execWriterT' = execWriterT+{-# INLINE execWriterT' #-}++type LazyWriter' w = LazyWriter w w++runLazyWriter' :: LazyWriter' w a -> (a, w)+runLazyWriter' = runLazyWriter+{-# INLINE runLazyWriter' #-}++execLazyWriter' :: LazyWriter' w a -> w+execLazyWriter' = execLazyWriter+{-# INLINE execLazyWriter' #-}++type LazyWriterT' w = LazyWriterT w w++lazyWriterT' :: m (a, w) -> LazyWriterT' w m a+lazyWriterT' = lazyWriterT+{-# INLINE lazyWriterT' #-}++runLazyWriterT' :: LazyWriterT' w m a -> m (a, w)+runLazyWriterT' = runLazyWriterT+{-# INLINE runLazyWriterT' #-}++execLazyWriterT' :: Monad m => LazyWriterT' w m a -> m w+execLazyWriterT' = execLazyWriterT+{-# INLINE execLazyWriterT' #-}++type MonadWriter' w = MonadWriter w w++writer' :: forall w m a . MonadWriter' w m => (a, w) -> m a+writer' = writer @w+{-# INLINE writer' #-}++tell' :: forall w m . MonadWriter' w m => w -> m ()+tell' = tell @w+{-# INLINE tell' #-}++listen' :: forall w m a . MonadWriter' w m => m a -> m (a, w)+listen' = listen @w+{-# INLINE listen' #-}++pass' :: forall w m a . MonadWriter' w m => m (a, w -> w) -> m a+pass' = pass @w+{-# INLINE pass' #-}++listens' :: forall w m a b . MonadWriter' w m => (w -> b) -> m a -> m (a, b)+listens' = listens @w+{-# INLINE listens' #-}++censor' :: forall w m a . MonadWriter' w m => (w -> w) -> m a -> m a+censor' = censor @w+{-# INLINE censor' #-}

@@ -12,6 +12,8 @@ import Regression.T8 import Regression.T9 import Regression.T10+import Regression.T11+import Regression.T12  main :: IO () main = defaultMain suite@@ -28,4 +30,6 @@   , test8   , test9   , test10+  , test11+  , test12   ]

@@ -1,30 +1,34 @@ module Regression.T1 (test1) where -import Control.Monad.Ether-import Control.Ether.Abbr+import Ether+import Data.List (group)  import Test.Tasty import Test.Tasty.QuickCheck -ethereal "Tag1" "tag1"-ethereal "Tag2" "tag2"+data Tag1+data Tag2  testEther-  :: Ether '[Tag1 --> String, Tag2 --> String] m+  :: (MonadReader Tag1 String m, MonadReader Tag2 String m)   => m ((String, String), (String, String)) testEther = do-  s1 <- ask tag1-  s2 <- ask tag2+  s1 <- ask @Tag1+  s2 <- ask @Tag2   let s1s2 = (s1, s2)-  s1s2' <- local tag2 (map succ) $ do-    s1' <- ask tag1-    s2' <- ask tag2+  s1s2' <- local @Tag2 (map succ) $ do+    s1' <- ask @Tag1+    s2' <- ask @Tag2     return (s1', s2')   return (s1s2, s1s2') -runner1 s1 s2 = flip (runReader tag1) s1 . flip (runReaderT tag2) s2-runner2 s1 s2 = flip (runReader tag2) s2 . flip (runReaderT tag1) s1+runner1 s1 s2 = flip (runReader @Tag1) s1 . flip (runReaderT @Tag2) s2+runner2 s1 s2 = flip (runReader @Tag2) s2 . flip (runReaderT @Tag1) s1+runner3 s1 s2 = flip runReaders (Tagged @Tag1 s1, Tagged @Tag2 s2) +same :: Eq a => [a] -> Bool+same = (<=1) . length . group+ test1 :: TestTree test1 = testGroup "T1: Reader local environment"   [ testProperty "runner₁ works"@@ -33,7 +37,13 @@   , testProperty "runner₂ works"       $ \s1 s2 -> property       $ runner2 s1 s2 testEther == ((s1, s2), (s1, map succ s2))-  , testProperty "runner₁ == runner₂"+  , testProperty "runner₃ works"       $ \s1 s2 -> property-      $ runner1 s1 s2 testEther == runner2 s1 s2 testEther+      $ runner3 s1 s2 testEther == ((s1, s2), (s1, map succ s2))+  , testProperty "runner₁ == runner₂ == runner₃"+      $ \s1 s2 -> property+      $ same+        [ runner1 s1 s2 testEther+        , runner2 s1 s2 testEther+        , runner3 s1 s2 testEther ]   ]

@@ -2,22 +2,23 @@  import Control.Applicative import Data.Functor.Identity-import qualified Control.Monad.Ether.Implicit as I +import Ether+ import Test.Tasty import Test.Tasty.QuickCheck -testEther :: Integer -> I.StateT Integer Maybe [Integer]+testEther :: Integer -> StateT' Integer Maybe [Integer] testEther m = range   where     range = liftA2 (:) yield (range <|> pure [])-    yield = I.stateT $ \n -> do-      I.guard (n <= m)+    yield = stateT' $ \n -> do+      guard (n <= m)       Just (n, n + 1) -testEther' :: Integer -> I.State Integer [Integer]+testEther' :: Integer -> State' Integer [Integer] testEther' m =-  I.stateT $ Identity . maybe ([], m + 1) id . I.runStateT (testEther m)+  stateT' $ Identity . maybe ([], m + 1) id . runStateT' (testEther m)  next1 :: Integer -> Integer -> Maybe Integer next1 m n@@ -32,11 +33,11 @@ test10 :: TestTree test10 = testGroup "T10: Alternative instance"   [ testProperty "execStateT works"-  $ \m n -> I.execStateT (testEther m) n == next1 m n+  $ \m n -> execStateT' (testEther m) n == next1 m n   , testProperty "evalStateT works"-  $ \m n -> I.evalStateT (testEther m) n == range1 m n+  $ \m n -> evalStateT' (testEther m) n == range1 m n   , testProperty "execState works"-  $ \m n -> I.execState (testEther' m) n == m + 1+  $ \m n -> execState' (testEther' m) n == m + 1   , testProperty "evalState works"-  $ \m n -> I.evalState (testEther' m) n == [n..m]+  $ \m n -> evalState' (testEther' m) n == [n..m]   ]

@@ -0,0 +1,50 @@+module Regression.T11 (test11) where++import Ether++import Data.Bool+import qualified Control.Monad.State as T+import qualified Control.Monad.Reader as T++import Test.Tasty+import Test.Tasty.QuickCheck++data STag++testEther+  :: ( MonadState STag [Integer] m+     , T.MonadState Bool m+     , T.MonadReader Integer m )+  => m ()+testEther = do+  T.modify not+  f <- bool negate id <$> T.get+  n <- T.ask+  T.local succ testEther+  modify @STag (f n:)++model :: Integer -> [Integer]+model n = zipWith ($) (cycle [id, negate]) [n..]++runner1 n+  = flip (T.runReader) n+  . flip (execLazyStateT @STag) []+  . flip T.evalStateT False++runner2 n+  = flip T.evalState False+  . flip (execLazyStateT @STag) []+  . flip T.runReaderT n++test11 :: TestTree+test11 = testGroup "T11: Lazy sequence"+  [ testProperty "runner₁ works"+    $ \l n -> property+    $ take l (runner1 n testEther) == take l (model n)+  , testProperty "runner₂ works"+    $ \l n -> property+    $ take l (runner2 n testEther) == take l (model n)+  , testProperty "runner₁ == runner₂"+    $ \l n -> property+    $ take l (runner1 n testEther) == take l (runner2 n testEther)+  ]

@@ -0,0 +1,30 @@+module Regression.T12 (test12) where++import Ether+import Control.Lens++import Test.Tasty+import Test.Tasty.QuickCheck++data Foo++succState :: Enum a => MonadState Foo a m => m ()+succState = modify @Foo succ++testEther :: (Enum a, MonadState Foo (a, a) m) => m (a, a)+testEther = do+  Ether.zoom @Foo _1 succState+  Ether.zoom @Foo _2 $ modify @Foo pred+  get @Foo++model :: Enum a => (a, a) -> (a, a)+model (a1, a2) = (succ a1, pred a2)++runner = evalState @Foo++test12 :: TestTree+test12 = testGroup "T12: State zooming"+  [ testProperty "runner works"+    $ \(a1 :: Integer, a2 :: Integer) -> property+    $ runner testEther (a1, a2) == model (a1, a2)+  ]

@@ -1,29 +1,27 @@ module Regression.T2 (test2) where -import Control.Ether.Abbr-import qualified Control.Monad.Ether.Implicit as I-import qualified Control.Ether.Implicit.Abbr as I+import Ether  import Test.Tasty import Test.Tasty.QuickCheck -testEther :: Ether '[I.R Integer, I.R Bool] m => m String-testEther = I.local (succ :: Integer -> Integer) $ do-  n :: Integer <- I.ask-  b <- I.local not I.ask+testEther :: (MonadReader' Integer m, MonadReader' Bool m) => m String+testEther = local' (succ :: Integer -> Integer) $ do+  n :: Integer <- asks' (*2)+  b <- local' not ask'   return (if b then "" else show n) -runner1 (n :: Integer) = flip I.runReader n . flip I.runReaderT True-runner2 (n :: Integer) = flip I.runReader True . flip I.runReaderT n+runner1 (n :: Integer) = flip runReader' n    . flip runReaderT' True+runner2 (n :: Integer) = flip runReader' True . flip runReaderT' n  test2 :: TestTree test2 = testGroup "T2: Implicit tags"   [ testProperty "runner₁ works"     $ \n -> property-    $ runner1 n testEther == show (succ n)+    $ runner1 n testEther == show (succ n * 2)   , testProperty "runner₂ works"     $ \n -> property-    $ runner2 n testEther == show (succ n)+    $ runner2 n testEther == show (succ n * 2)   , testProperty "runner₁ == runner₂"     $ \n -> property     $ runner1 n testEther == runner2 n testEther

@@ -1,7 +1,6 @@ module Regression.T3 (test3) where -import Control.Ether.Abbr-import Control.Monad.Ether+import Ether  import qualified Control.Monad.Reader as T import qualified Control.Monad.State as T@@ -9,8 +8,8 @@ import Test.Tasty import Test.Tasty.QuickCheck -ethereal "RTag" "rTag"-ethereal "STag" "sTag"+data RTag+data STag  testMTL :: (T.MonadReader Int m, T.MonadState Int m) => m Int testMTL = do@@ -20,23 +19,23 @@   return (a * b)  testEther-  :: Ether '[STag --> Int, STag <-> Int, RTag --> Int] m+  :: (MonadReader STag Int m, MonadState STag Int m, MonadReader RTag Int m)   => m (Int, Int, Int)-testEther = local rTag (*2) $ do-  a_mul_b <- tagAttach sTag testMTL-  a_add_b <- get sTag-  modify sTag negate-  c <- ask rTag+testEther = local @RTag (*2) $ do+  a_mul_b <- tagAttach @STag testMTL+  a_add_b <- get @STag+  modify @STag negate+  c <- ask @RTag   return (a_mul_b, a_add_b, c)  runner1 s r-  = flip (runReader  rTag) (negate r)-  . flip (runReaderT sTag) r-  . flip (runStateT  sTag) s+  = flip (runReader  @RTag) (negate r)+  . flip (runReaderT @STag) r+  . flip (runStateT  @STag) s runner2 s r-  = flip (runReader  rTag) (negate r)-  . flip (runStateT  sTag) s-  . flip (runReaderT sTag) r+  = flip (runReader  @RTag) (negate r)+  . flip (runStateT  @STag) s+  . flip (runReaderT @STag) r  test3 :: TestTree test3 = testGroup "T3: Tag attachement"

@@ -1,19 +1,18 @@ module Regression.T4 (test4) where -import Control.Ether.Abbr-import Control.Monad.Ether+import Ether  import Test.Tasty import Test.Tasty.QuickCheck -ethereal "RTag" "rTag"+data RTag -testEther :: Ether '[RTag --> Int] m => m Int-testEther = ask rTag+testEther :: MonadReader RTag Int m => m Int+testEther = ask @RTag  runner r-  = flip (runReader  rTag) (r' :: Int)-  . flip (runReaderT rTag) (r  :: Int)+  = flip (runReader  @RTag) (r' :: Int)+  . flip (runReaderT @RTag) (r  :: Int)   where     r' = negate r 

@@ -1,9 +1,6 @@ module Regression.T5 (test5) where -import Control.Ether.Abbr--import qualified Control.Monad.Ether.Implicit as I-import qualified Control.Ether.Implicit.Abbr as I+import Ether  import Test.Tasty import Test.Tasty.QuickCheck@@ -16,22 +13,22 @@  testEther   :: (Num a, Ord a)-  => Ether '[I.R a, I.S Counter] m+  => (MonadReader' a m, MonadState' Counter m)   => m a testEther = do-  a <- I.ask+  a <- ask'   if a <= 0     then do-      I.put (0 :: Counter)+      put' (0 :: Counter)       return 1     else do-      I.modify incCounter -- overriden in the base case-      b <- I.runReaderT testEther (a - 1)-      I.modify incCounter+      modify' incCounter -- overriden in the base case+      b <- runReaderT' testEther (a - 1)+      modify' incCounter       return (a * b)  runner :: (Num a, Ord a) => a -> (a, Counter)-runner a = I.runState (I.runReaderT testEther a) (0 :: Counter)+runner a = runState' (runReaderT' testEther a) (0 :: Counter)  factorial :: (Num a, Enum a) => a -> a factorial a = product [1..a]

@@ -1,10 +1,7 @@ module Regression.T6 (test6) where -import Control.Monad-import Control.Ether.Abbr--import qualified Control.Monad.Ether.Implicit as I-import qualified Control.Ether.Implicit.Abbr as I+import Data.Function+import Ether  import Test.Tasty import Test.Tasty.QuickCheck@@ -17,32 +14,33 @@  testEther   :: (Floating a, Ord a)-  => Ether '[I.E DivideByZero, I.E (NegativeLog a)] m+  => (MonadExcept' DivideByZero m, MonadExcept' (NegativeLog a) m)   => a -> a -> m a testEther a b = do-  when (b == 0) (I.throw DivideByZero)+  when (b == 0) (throw' DivideByZero)   let d = a / b-  when (d < 0) (I.throw (NegativeLog d))+  when (d < 0) (throw' (NegativeLog d))   return (log d) --- Copied verbatim from "Data.Function" to support @base < 4.8@.-(&) :: a -> (a -> b) -> b-x & f = f x- handleNegativeLog (NegativeLog (x :: Double)) = "nl: " ++ show x handleDivideByZero DivideByZero = "dz" +handleT' :: Functor m => (e -> a) -> ExceptT' e m a -> m a+handleT' h m = fmap (either h id) (runExceptT' m)+ runner1 :: Double -> Double -> String runner1 a b = do   (show `fmap` testEther a b)-    & I.handleT handleNegativeLog-    & I.handle  handleDivideByZero+    & handleT' handleNegativeLog+    & handleT'  handleDivideByZero+    & runIdentity  runner2 :: Double -> Double -> String runner2 a b = do   (show `fmap` testEther a b)-    & I.handleT handleDivideByZero-    & I.handle  handleNegativeLog+    & handleT' handleDivideByZero+    & handleT' handleNegativeLog+    & runIdentity  logDiv :: Double -> Double -> String logDiv a b

@@ -3,13 +3,13 @@ import Data.Monoid import Control.Monad -import Control.Monad.Ether+import Ether import qualified Control.Monad.Writer as T  import Test.Tasty import Test.Tasty.QuickCheck -ethereal "WTag" "wTag"+data WTag  testEther   :: Num a@@ -18,17 +18,18 @@   => [a] -> m () testEther xs = do   forM_ xs $ \x -> do-    T.tell (Sum x)-    tell wTag (Sum 1)+    u1 <- T.tell (Sum x)+    u2 <- tell @WTag (Sum 1)+    when (u1 /= u2) $ error "Impossible"  runner1 :: Num a => [a] -> (a, a) runner1 xs =-  let (s, c) = T.runWriter . execWriterT wTag $ testEther xs+  let (s, c) = T.runWriter . execWriterT @WTag $ testEther xs   in (getSum s, getSum c)  runner2 :: Num a => [a] -> (a, a) runner2 xs =-  let (c, s) = runWriter wTag . T.execWriterT $ testEther xs+  let (c, s) = runWriter @WTag . T.execWriterT $ testEther xs   in (getSum s, getSum c)  triangular :: Integral a => a -> a

@@ -1,15 +1,14 @@ module Regression.T8 (test8) where -import Control.Ether.Abbr-import Control.Monad.Ether+import Ether  import qualified Control.Monad.State as T  import Test.Tasty import Test.Tasty.QuickCheck -ethereal "Foo" "foo"-ethereal "Bar" "bar"+data Foo+data Bar  testMTL1 :: T.MonadState Int m => m () testMTL1 = T.modify negate@@ -18,25 +17,25 @@ testMTL2 = T.modify not  testEther-  :: Ether '[Foo <-> Int, Bar <-> Bool] m+  :: (MonadState Foo Int m, MonadState Bar Bool m)   => m String testEther = do-  tagAttach foo testMTL1-  tagAttach bar testMTL2-  a <- gets foo show-  b <- gets bar show+  tagAttach @Foo testMTL1+  tagAttach @Bar testMTL2+  a <- gets @Foo show+  b <- gets @Bar show   return (a ++ b)  model :: Int -> Bool -> String model a b = show (negate a) ++ show (not b)  runner1 a b-  = flip (evalState  foo) a-  . flip (evalStateT bar) b+  = flip (evalState  @Foo) a+  . flip (evalStateT @Bar) b  runner2 a b-  = flip (evalState  bar) b-  . flip (evalStateT foo) a+  = flip (evalState  @Bar) b+  . flip (evalStateT @Foo) a  test8 :: TestTree test8 = testGroup "T8: Multiple tag attachements"

@@ -1,25 +1,23 @@ module Regression.T9 (test9) where -import Control.Ether.Abbr-import Control.Monad.Ether+import Ether  import Test.Tasty import Test.Tasty.QuickCheck -ethereal "Foo" "foo"-ethereal "Bar" "bar"-+data Foo+data Bar -testEther1 :: Ether '[Foo <-> Int] m => m String+testEther1 :: MonadState Foo Int m => m String testEther1 = do-  modify foo negate-  gets foo show+  modify @Foo negate+  gets @Foo show -testEther2 :: Ether '[Bar <-> Int] m => m String-testEther2 = tagReplace foo bar testEther1+testEther2 :: MonadState Bar Int m => m String+testEther2 = tagReplace @Foo @Bar testEther1  testEther-  :: Ether '[Foo <-> Int, Bar <-> Int] m+  :: (MonadState Foo Int m, MonadState Bar Int m)   => m String testEther = do   a <- testEther1@@ -30,12 +28,12 @@ model a b = show (negate a) ++ show (negate b)  runner1 a b-  = flip (evalState  foo) a-  . flip (evalStateT bar) b+  = flip (evalState  @Foo) a+  . flip (evalStateT @Bar) b  runner2 a b-  = flip (evalState  bar) b-  . flip (evalStateT foo) a+  = flip (evalState  @Bar) b+  . flip (evalStateT @Foo) a  test9 :: TestTree test9 = testGroup "T9: Tag replacement"