ether (empty) → 0.1.0.0
raw patch · 31 files changed
+2667/−0 lines, 31 filesdep +QuickCheckdep +basedep +ethersetup-changed
Dependencies added: QuickCheck, base, ether, mtl, newtype-generics, tasty, tasty-quickcheck, template-haskell, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- ether.cabal +80/−0
- src/Control/Ether/TH.hs +58/−0
- src/Control/Ether/Tagged.hs +160/−0
- src/Control/Ether/Util.hs +37/−0
- src/Control/Ether/Wrapped.hs +86/−0
- src/Control/Monad/Ether/Except.hs +19/−0
- src/Control/Monad/Ether/Except/Class.hs +116/−0
- src/Control/Monad/Ether/Implicit/Except.hs +57/−0
- src/Control/Monad/Ether/Implicit/Except/TH.hs +22/−0
- src/Control/Monad/Ether/Implicit/Reader.hs +66/−0
- src/Control/Monad/Ether/Implicit/State.hs +8/−0
- src/Control/Monad/Ether/Implicit/State/Lazy.hs +91/−0
- src/Control/Monad/Ether/Implicit/State/Strict.hs +91/−0
- src/Control/Monad/Ether/Implicit/Writer.hs +81/−0
- src/Control/Monad/Ether/Reader.hs +20/−0
- src/Control/Monad/Ether/Reader/Class.hs +145/−0
- src/Control/Monad/Ether/State.hs +8/−0
- src/Control/Monad/Ether/State/Class.hs +158/−0
- src/Control/Monad/Ether/State/Lazy.hs +25/−0
- src/Control/Monad/Ether/State/Strict.hs +25/−0
- src/Control/Monad/Ether/Writer.hs +23/−0
- src/Control/Monad/Ether/Writer/Class.hs +158/−0
- src/Control/Monad/Trans/Ether/Except.hs +156/−0
- src/Control/Monad/Trans/Ether/Reader.hs +167/−0
- src/Control/Monad/Trans/Ether/State.hs +8/−0
- src/Control/Monad/Trans/Ether/State/Lazy.hs +180/−0
- src/Control/Monad/Trans/Ether/State/Strict.hs +180/−0
- src/Control/Monad/Trans/Ether/Writer.hs +170/−0
- test/Regression.hs +240/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Index Int++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Index Int nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ether.cabal view
@@ -0,0 +1,80 @@+name: ether+version: 0.1.0.0+synopsis: Monad transformers and classes+description:+ Ether is a Haskell library that extends @mtl@ and @transformers@ with+ tagged monad transformers and classes in a compatible way.++category: Control+license: BSD3+license-file: LICENSE+author: Index Int+maintainer: Index Int <vlad.z.4096@gmail.com>+homepage: https://int-index.github.io/ether/+bug-reports: https://github.com/int-index/ether/issues+build-type: Simple+cabal-version: >=1.22++source-repository head++ type: git+ location: git@github.com:int-index/ether.git+++library++ exposed-modules: Control.Ether.Tagged+ Control.Ether.Wrapped+ 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.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.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+ Control.Monad.Ether.Implicit.Except.TH++ other-modules: Control.Ether.Util++ build-depends: base >=4.8 && <4.9+ , transformers >=0.4.0.3+ , mtl >=2.2.1+ , template-haskell >=2.10+ , newtype-generics >=0.4.1++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+++test-suite regression++ build-depends: base >=4.8 && <4.9+ , transformers >=0.4.0.3+ , mtl >=2.2.1+ , tasty >=0.10+ , tasty-quickcheck >=0.8+ , QuickCheck >=2.8+ , ether++ main-is: Regression.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Control/Ether/TH.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Template haskell utilities.++module Control.Ether.TH+ ( ethereal+ , fmapN+ , deepN+ ) where++import qualified Language.Haskell.TH as TH++import Data.Proxy++emptyDataDecl :: TH.Name -> TH.DecQ+emptyDataDecl name = TH.dataD (return []) name [] [] []++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]++-- |+-- Compose 'fmap' @n@ times.+--+-- @$('fmapN' 5) = fmap.fmap.fmap.fmap.fmap@+fmapN :: Int -> TH.ExpQ+fmapN 0 = [|id|]+fmapN n = TH.infixApp [|fmap|] [|(.)|] (fmapN (n - 1))++-- |+-- 'fmap' a function @n@ levels deep.+--+-- @$('deepN' 3 [| f |]) = $('fmapN' 3) f ($('fmapN' 2) f ($('fmapN' 1) f id))@+deepN :: Int -> TH.ExpQ -> TH.ExpQ+deepN 0 _ = [|id|]+deepN n f = [| $(fmapN n) $f $(deepN (n-1) f) |]
+ src/Control/Ether/Tagged.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DefaultSignatures #-}++-- | Type-level machinery for tag manipulation.++module Control.Ether.Tagged+ ( Taggable(..)+ , Tagged(..)+ , Tags+ , Inners+ , UniqueTag+ , UniqueTags+ , ensureUniqueTags+ ) where++import Data.Proxy (Proxy)+import Data.Functor.Identity (Identity)+import Data.Monoid (First, Last)+import qualified Control.Monad.ST.Strict as Strict (ST)+import qualified Control.Monad.ST.Lazy as Lazy (ST)+import GHC.Conc (STM)+import GHC.Exts (Constraint)+import qualified Control.Newtype as NT+import Control.Ether.Util (type (++), MaybeToList)++import qualified Control.Monad.Trans.Cont as Trans+import qualified Control.Monad.Trans.Except as Trans+import qualified Control.Monad.Trans.Identity as Trans+import qualified Control.Monad.Trans.List as Trans+import qualified Control.Monad.Trans.Maybe as Trans+import qualified Control.Monad.Trans.Reader as Trans+import qualified Control.Monad.Trans.State.Lazy as Trans.Lazy+import qualified Control.Monad.Trans.State.Strict as Trans.Strict+import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy+import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict++-- |+-- The main purpose of the 'UniqueTag' class is to provide clear error+-- messages when the tag uniqueness property is violated. You should never+-- write instances for it unless you know what you're doing.+class UniqueTag a++type family IsUnique (x :: k) (as :: [k]) :: Constraint where+ IsUnique x (x ': as) = UniqueTag x+ IsUnique x (a ': as) = IsUnique x as+ IsUnique x '[] = ()++type family Unique (as :: [k]) :: Constraint where+ Unique '[] = ()+ Unique (a ': as) = (IsUnique a as, Unique as)++-- |+-- The 'UniqueTags` constraint placed on a type variable representing a+-- monad transformer stack ensures that every tag in the stack appears+-- only once.+type family UniqueTags (m :: * -> *) :: Constraint where+ UniqueTags m = Unique (Tags m)++-- |+-- Type-restricted version of 'id' that adds a 'UniqueTags' constraint to+-- the provided monadic value.+ensureUniqueTags :: UniqueTags m => m a -> m a+ensureUniqueTags = id++type family ListMapTag (as :: [* -> *]) :: [*] where+ ListMapTag '[] = '[]+ ListMapTag (a ': as) = MaybeToList (Tag a) ++ ListMapTag as++-- | The 'Taggable' class defines the type families to manage tags in monad+-- transformer stacks. Its kind is restricted to @* -> *@ to prevent incorrect+-- instances.+class Taggable (m :: * -> *) where++ -- | The 'Tag' type family equals @Nothing@ for most types, but for tagged+ -- monad transformers it equals @Just tag@.+ type Tag m :: Maybe *+ type instance Tag m = 'Nothing++ -- | The 'Inner' type family equals @Nothing@ for most types, but for+ -- monad transformers with inner monad @m@ it equals @Just m@.+ type Inner m :: Maybe (* -> *)+ type instance Inner m = 'Nothing++type family Inners' m where+ Inners' 'Nothing = '[]+ Inners' ('Just n) = n ': Inners n++-- | The 'Inners' type function recursively applies 'Inner' and returns the+-- results in a type-level list.+type Inners m = Inners' (Inner m)++instance Taggable IO+instance Taggable Identity++instance Taggable Maybe+instance Taggable Last+instance Taggable First+instance Taggable ((->) r)+instance Taggable STM+instance Taggable (Either e)+instance Taggable Proxy+instance Taggable (Strict.ST s)+instance Taggable (Lazy.ST s)++instance Taggable (Trans.ContT r m) where+ type Inner (Trans.ContT r m) = 'Just m++instance Taggable (Trans.ExceptT e m) where+ type Inner (Trans.ExceptT e m) = 'Just m++instance Taggable (Trans.IdentityT m) where+ type Inner (Trans.IdentityT m) = 'Just m++instance Taggable (Trans.ListT m) where+ type Inner (Trans.ListT m) = 'Just m++instance Taggable (Trans.MaybeT m) where+ type Inner (Trans.MaybeT m) = 'Just m++instance Taggable (Trans.ReaderT r m) where+ type Inner (Trans.ReaderT r m) = 'Just m++instance Taggable (Trans.Lazy.StateT s m) where+ type Inner (Trans.Lazy.StateT s m) = 'Just m++instance Taggable (Trans.Strict.StateT s m) where+ type Inner (Trans.Strict.StateT s m) = 'Just m++instance Taggable (Trans.Lazy.WriterT w m) where+ type Inner (Trans.Lazy.WriterT w m) = 'Just m++instance Taggable (Trans.Strict.WriterT w m) where+ type Inner (Trans.Strict.WriterT w m) = 'Just m++-- | The 'Tags' type function returns a type-level list of all tags in+-- a monad transformer stack. Requires 'Taggable' instances.+type Tags (m :: * -> *) = MaybeToList (Tag m) ++ ListMapTag (Inners m)++-- | The 'Tagged' type class establishes a relationship between a tagged+-- monad transformer and its untagged counterpart.+class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where++ type Untagged m :: * -> *++ tagged :: proxy tag -> Untagged m a -> m a+ default tagged :: NT.Newtype (m a) => proxy tag -> NT.O (m a) -> m a+ tagged _ = NT.pack++ untagged :: proxy tag -> m a -> Untagged m a+ default untagged :: NT.Newtype (m a) => proxy tag -> m a -> NT.O (m a)+ untagged _ = NT.unpack
+ src/Control/Ether/Util.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE DataKinds, PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+module Control.Ether.Util+ ( liftCatch_ExceptT+ , liftListen_WriterT+ , liftPass_WriterT+ , type (++)+ , MaybeToList+ ) where++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.Except as Trans+import qualified Control.Monad.Trans.Writer as Trans++type family (as :: [*]) ++ (bs :: [*]) :: [*] where+ '[] ++ bs = bs+ (a ': as) ++ bs = a ': (as ++ bs)++type family MaybeToList (mt :: Maybe k) :: [k] where+ MaybeToList 'Nothing = '[]+ MaybeToList ('Just t) = '[t]++liftCatch_ExceptT :: Sig.Catch e m (Either e' a) -> Sig.Catch e (Trans.ExceptT e' m) a+liftCatch_ExceptT catchE m h = Trans.ExceptT $ catchE (Trans.runExceptT m) (Trans.runExceptT . h)++-- TODO: Not sure if correct+liftListen_WriterT :: Monad m => Sig.Listen w' m (a, w) -> Sig.Listen w' (Trans.WriterT w m) a+liftListen_WriterT listen m = Trans.WriterT $ do+ ~((a, w'), w) <- listen (Trans.runWriterT m)+ return ((a, w), w')++-- TODO: Not sure if correct+liftPass_WriterT :: Monad m => Sig.Pass w' m (a, w) -> Sig.Pass w' (Trans.WriterT w m) a+liftPass_WriterT pass m = Trans.WriterT $ pass $ do+ ~((a, f), w) <- Trans.runWriterT m+ return ((a, w), f)
+ src/Control/Ether/Wrapped.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{- |+Annotating monads with tags to turn untagged constraints into tagged ones.++> import qualified Control.Monad.State as T+> import Control.Ether.TH (ethereal)+> import Control.Monad.Ether.State (MonadState)+> import Control.Ether.Wrapped (ethered)+>+> ethereal "Foo" "foo"+>+> f :: T.MonadState Int m => m String+> f = fmap show T.get+> +> g :: MonadState Foo Int m => m String+> g = ethered foo f+-}++module Control.Ether.Wrapped+ ( WrappedEther(..)+ , ethered+ ) where++import Data.Proxy (Proxy(Proxy))+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO)+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.Reader as Class+import qualified Control.Monad.State as Class+import qualified Control.Monad.Except as Class+import qualified Control.Monad.Writer as Class++-- | Wrap a monad to attach a tag to it.+newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }+ deriving ( Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadIO )++-- | Annotate a polymorphic monadic computation with a tag.+ethered :: proxy tag -> WrappedEther tag m a -> m a+ethered _proxy = unwrapEther++instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where+ ask = WrapEther $ ask (Proxy :: Proxy tag)+ local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther++instance MonadReader tag r m => MonadReader tag r (WrappedEther tag' m) where+ ask t = WrapEther $ ask t+ local t f = WrapEther . local t f . unwrapEther++instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where+ get = WrapEther $ get (Proxy :: Proxy tag)+ put = WrapEther . put (Proxy :: Proxy tag)++instance MonadState tag s m => MonadState tag s (WrappedEther tag' m) where+ get t = WrapEther $ get t+ put t = WrapEther . put t++instance MonadExcept tag e m => Class.MonadError e (WrappedEther tag m) where+ throwError = WrapEther . throw (Proxy :: Proxy tag)+ catchError m h = WrapEther $ catch (Proxy :: Proxy tag) (unwrapEther m) (unwrapEther . h)++instance MonadExcept tag e m => MonadExcept tag e (WrappedEther tag' m) where+ throw t = WrapEther . throw t+ catch t m h = WrapEther $ catch t (unwrapEther m) (unwrapEther . h)++instance MonadWriter tag w m => Class.MonadWriter w (WrappedEther tag m) where+ tell = WrapEther . tell (Proxy :: Proxy tag)+ listen = WrapEther . listen (Proxy :: Proxy tag) . unwrapEther+ pass = WrapEther . pass (Proxy :: Proxy tag) . unwrapEther++instance MonadWriter tag w m => MonadWriter tag w (WrappedEther tag' m) where+ tell t = WrapEther . tell t+ listen t = WrapEther . listen t . unwrapEther+ pass t = WrapEther . pass t . unwrapEther
+ src/Control/Monad/Ether/Except.hs view
@@ -0,0 +1,19 @@++-- | See "Control.Monad.Except".++module Control.Monad.Ether.Except+ (+ -- * MonadExcept class+ MonadExcept(..)+ -- * The Except monad+ , Except+ , runExcept+ -- * The ExceptT monad transformer+ , ExceptT+ , exceptT+ , runExceptT+ , mapExceptT+ ) where++import Control.Monad.Ether.Except.Class+import Control.Monad.Trans.Ether.Except hiding (throw, catch)
+ src/Control/Monad/Ether/Except/Class.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | See "Control.Monad.Except".++module Control.Monad.Ether.Except.Class+ ( MonadExcept(..)+ ) where++import Data.Proxy (Proxy(Proxy))+import Control.Monad.Trans (lift)++import Control.Monad.Trans.Ether.Except hiding (throw, catch)+import qualified Control.Monad.Trans.Ether.Except as E+import qualified Control.Monad.Trans.Ether.Reader as R+import qualified Control.Monad.Trans.Ether.Writer as W+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.Ether.Util as Util++-- for mtl instances+import qualified Control.Monad.Trans.Except as Trans.E+import qualified Control.Monad.Trans.Identity as Trans.I+import qualified Control.Monad.Trans.List as Trans.L+import qualified Control.Monad.Trans.Maybe as Trans.M+import qualified Control.Monad.Trans.Reader as Trans.R+import qualified Control.Monad.Trans.State.Lazy as Trans.S.Lazy+import qualified Control.Monad.Trans.State.Strict as Trans.S.Strict+import qualified Control.Monad.Trans.Writer.Lazy as Trans.W.Lazy+import qualified Control.Monad.Trans.Writer.Strict as Trans.W.Strict+++-- | 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 {-# OVERLAPPING #-} Monad m => MonadExcept tag e (ExceptT tag e m) where+ throw = E.throw+ catch = E.catch++instance MonadExcept tag e m => MonadExcept tag e (ExceptT tag' e' m) where+ throw t = lift . throw t+ catch t = liftCatch Proxy (catch t)++-- Instances for other tagged transformers++instance MonadExcept tag e m => MonadExcept tag e (R.ReaderT tag' r m) where+ throw t = lift . throw t+ catch t = R.liftCatch Proxy (catch t)++instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (W.WriterT tag' w m) where+ throw t = lift . throw t+ catch t = W.liftCatch Proxy (catch t)++instance MonadExcept tag e m => MonadExcept tag e (S.L.StateT tag' s m) where+ throw t = lift . throw t+ catch t = S.L.liftCatch Proxy (catch t)++instance MonadExcept tag e m => MonadExcept tag e (S.S.StateT tag' s m) where+ throw t = lift . throw t+ catch t = S.S.liftCatch Proxy (catch t)+++-- Instances for mtl transformers++instance MonadExcept tag e m => MonadExcept tag e (Trans.E.ExceptT e' m) where+ throw t = lift . throw t+ catch t = Util.liftCatch_ExceptT (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.I.IdentityT m) where+ throw t = lift . throw t+ catch t = Trans.I.liftCatch (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.L.ListT m) where+ throw t = lift . throw t+ catch t = Trans.L.liftCatch (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.M.MaybeT m) where+ throw t = lift . throw t+ catch t = Trans.M.liftCatch (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.R.ReaderT r m) where+ throw t = lift . throw t+ catch t = Trans.R.liftCatch (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Lazy.StateT s m) where+ throw t = lift . throw t+ catch t = Trans.S.Lazy.liftCatch (catch t)++instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Strict.StateT s m) where+ throw t = lift . throw t+ catch t = Trans.S.Strict.liftCatch (catch t)++instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Lazy.WriterT w m) where+ throw t = lift . throw t+ catch t = Trans.W.Lazy.liftCatch (catch t)++instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Strict.WriterT w m) where+ throw t = lift . throw t+ catch t = Trans.W.Strict.liftCatch (catch t)
+ src/Control/Monad/Ether/Implicit/Except.hs view
@@ -0,0 +1,57 @@+{-# 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+ , mapExceptT+ ) 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.mapExceptT'.+-- Note that due to implicit tagging the exception type cannot be changed.+mapExceptT :: (m (Either e a) -> n (Either e b)) -> ExceptT e m a -> ExceptT e n b+mapExceptT = Explicit.mapExceptT Proxy
+ src/Control/Monad/Ether/Implicit/Except/TH.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Template Haskell utilities for exception handling.++module Control.Monad.Ether.Implicit.Except.TH (try', try) where++import qualified Language.Haskell.TH as TH+import Control.Ether.TH (deepN)+import Control.Monad.Ether.Implicit.Except++-- | Basic building block for 'try'. Runs an 'ExceptT' with a handler.+try' :: Functor m => ExceptT e m a -> (e -> a) -> m a+try' m h = either h id <$> runExceptT m++-- | Handle @n@ exceptions with supplied handlers.+--+-- > $(try 3) monadicComputation+-- > (\Exception1 -> ...)+-- > (\Exception2 -> ...)+-- > (\Exception3 -> ...)+try :: Int -> TH.ExpQ+try n = deepN n [|try'|]
+ src/Control/Monad/Ether/Implicit/Reader.hs view
@@ -0,0 +1,66 @@+{-# 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+ , mapReaderT+ ) 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.mapReaderT'.+mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b+mapReaderT = Explicit.mapReaderT Proxy++-- | See 'Control.Monad.Ether.Reader.MonadReader'.+type MonadReader r = Explicit.MonadReader r r++-- | See 'Control.Monad.Ether.Reader.local'.+local :: forall m r a . MonadReader r m => (r -> r) -> m a -> m a+local = Explicit.local (Proxy :: Proxy r)++-- | See 'Control.Monad.Ether.Reader.ask'.+ask :: forall m r . MonadReader r m => m r+ask = Explicit.ask (Proxy :: Proxy r)++-- | See 'Control.Monad.Ether.Reader.reader'.+reader :: forall m r a . MonadReader r m => (r -> a) -> m a+reader = Explicit.reader (Proxy :: Proxy r)++-- | See 'Control.Monad.Ether.Reader.asks'.+asks :: forall m r a . MonadReader r m => (r -> a) -> m a+asks = Explicit.asks (Proxy :: Proxy r)
+ src/Control/Monad/Ether/Implicit/State.hs view
@@ -0,0 +1,8 @@++-- | 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
+ src/Control/Monad/Ether/Implicit/State/Lazy.hs view
@@ -0,0 +1,91 @@+{-# 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+ , mapStateT+ ) 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.mapStateT'.+mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b+mapStateT = Explicit.mapStateT Proxy++-- | See 'Control.Monad.Ether.State.Lazy.MonadState'.+type MonadState s = Explicit.MonadState s s++-- | See 'Control.Monad.Ether.State.Lazy.get'.+get :: forall m s . MonadState s m => m s+get = Explicit.get (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Lazy.gets'.+gets :: forall m s a . MonadState s m => (s -> a) -> m a+gets = Explicit.gets (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Lazy.put'.+put :: forall m s . MonadState s m => s -> m ()+put = Explicit.put (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Lazy.state'.+state :: forall m s a . MonadState s m => (s -> (a, s)) -> m a+state = Explicit.state (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Lazy.modify'.+modify :: forall m s . MonadState s m => (s -> s) -> m ()+modify = Explicit.modify (Proxy :: Proxy s)
+ src/Control/Monad/Ether/Implicit/State/Strict.hs view
@@ -0,0 +1,91 @@+{-# 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+ , mapStateT+ ) 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.mapStateT'.+mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b+mapStateT = Explicit.mapStateT Proxy++-- | See 'Control.Monad.Ether.State.Strict.MonadState'.+type MonadState s = Explicit.MonadState s s++-- | See 'Control.Monad.Ether.State.Strict.get'.+get :: forall m s . MonadState s m => m s+get = Explicit.get (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Strict.gets'.+gets :: forall m s a . MonadState s m => (s -> a) -> m a+gets = Explicit.gets (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Strict.put'.+put :: forall m s . MonadState s m => s -> m ()+put = Explicit.put (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Strict.state'.+state :: forall m s a . MonadState s m => (s -> (a, s)) -> m a+state = Explicit.state (Proxy :: Proxy s)++-- | See 'Control.Monad.Ether.State.Strict.modify'.+modify :: forall m s . MonadState s m => (s -> s) -> m ()+modify = Explicit.modify (Proxy :: Proxy s)
+ src/Control/Monad/Ether/Implicit/Writer.hs view
@@ -0,0 +1,81 @@+{-# 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 m w a . MonadWriter w m => (a, w) -> m a+writer = Explicit.writer (Proxy :: Proxy w)++-- | See 'Control.Monad.Ether.Writer.tell'.+tell :: forall m w . MonadWriter w m => w -> m ()+tell = Explicit.tell (Proxy :: Proxy w)++-- | See 'Control.Monad.Ether.Writer.listen'.+listen :: forall m w a . MonadWriter w m => m a -> m (a, w)+listen = Explicit.listen (Proxy :: Proxy w)++-- | See 'Control.Monad.Ether.Writer.pass'.+pass :: forall m w a . MonadWriter w m => m (a, w -> w) -> m a+pass = Explicit.pass (Proxy :: Proxy w)++-- | See 'Control.Monad.Ether.Writer.listens'.+listens :: forall m w 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 m w 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
+ src/Control/Monad/Ether/Reader.hs view
@@ -0,0 +1,20 @@++-- | 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+ , mapReaderT+ ) where++import Control.Monad.Ether.Reader.Class+import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)
+ src/Control/Monad/Ether/Reader/Class.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | See "Control.Monad.Reader.Class".++module Control.Monad.Ether.Reader.Class+ ( MonadReader(..)+ , asks+ ) where++import Data.Proxy (Proxy(Proxy))+import Control.Monad.Trans (lift)++import Control.Monad.Trans.Ether.Writer (WriterT, mapWriterT)+import Control.Monad.Trans.Ether.Except (ExceptT, mapExceptT)+import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)+import qualified Control.Monad.Trans.Ether.Reader as R+import qualified Control.Monad.Trans.Ether.State.Lazy as S.L+import qualified Control.Monad.Trans.Ether.State.Strict as S.S++-- for mtl instances+import qualified Control.Monad.Trans.Cont as Trans (ContT , liftLocal)+import qualified Control.Monad.Trans.Except as Trans (ExceptT , mapExceptT)+import qualified Control.Monad.Trans.Identity as Trans (IdentityT, mapIdentityT)+import qualified Control.Monad.Trans.List as Trans (ListT , mapListT)+import qualified Control.Monad.Trans.Maybe as Trans (MaybeT , mapMaybeT)+import qualified Control.Monad.Trans.Reader as Trans (ReaderT , mapReaderT)+import qualified Control.Monad.Trans.State.Lazy as Trans.Lazy (StateT , mapStateT)+import qualified Control.Monad.Trans.State.Strict as Trans.Strict (StateT , mapStateT)+import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)+import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)++-- | 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 = 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 {-# OVERLAPPING #-} Monad m => MonadReader tag r (ReaderT tag r m) where+ ask = R.ask+ local = R.local+ reader = R.reader++instance MonadReader tag r m => MonadReader tag r (ReaderT tag' r' m) where+ ask t = lift (ask t)+ local t = mapReaderT Proxy . local t++-- Instances for other tagged transformers++instance (Monoid w, MonadReader tag r m) => MonadReader tag r (WriterT tag' w m) where+ ask t = lift (ask t)+ local t = mapWriterT Proxy . local t++instance (MonadReader tag r m) => MonadReader tag r (S.L.StateT tag' s m) where+ ask t = lift (ask t)+ local t = S.L.mapStateT Proxy . local t++instance (MonadReader tag r m) => MonadReader tag r (S.S.StateT tag' s m) where+ ask t = lift (ask t)+ local t = S.S.mapStateT Proxy . local t++instance (MonadReader tag r m) => MonadReader tag r (ExceptT tag' e m) where+ ask t = lift (ask t)+ local t = mapExceptT Proxy . local t++-- Instances for mtl transformers++instance MonadReader tag r m => MonadReader tag r (Trans.ContT r' m) where+ ask t = lift (ask t)+ local t = Trans.liftLocal (ask t) (local t)++instance MonadReader tag r m => MonadReader tag r (Trans.ExceptT e m) where+ ask t = lift (ask t)+ local t = Trans.mapExceptT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.IdentityT m) where+ ask t = lift (ask t)+ local t = Trans.mapIdentityT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.ListT m) where+ ask t = lift (ask t)+ local t = Trans.mapListT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.MaybeT m) where+ ask t = lift (ask t)+ local t = Trans.mapMaybeT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.ReaderT r' m) where+ ask t = lift (ask t)+ local t = Trans.mapReaderT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.Lazy.StateT s m) where+ ask t = lift (ask t)+ local t = Trans.Lazy.mapStateT . local t++instance MonadReader tag r m => MonadReader tag r (Trans.Strict.StateT s m) where+ ask t = lift (ask t)+ local t = Trans.Strict.mapStateT . local t++instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Lazy.WriterT w m) where+ ask t = lift (ask t)+ local t = Trans.Lazy.mapWriterT . local t++instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Strict.WriterT w m) where+ ask t = lift (ask t)+ local t = Trans.Strict.mapWriterT . local t
+ src/Control/Monad/Ether/State.hs view
@@ -0,0 +1,8 @@++-- | See "Control.Monad.State".++module Control.Monad.Ether.State+ ( module Control.Monad.Ether.State.Lazy+ ) where++import Control.Monad.Ether.State.Lazy
+ src/Control/Monad/Ether/State/Class.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | See "Control.Monad.State.Class".++module Control.Monad.Ether.State.Class+ ( MonadState(..)+ , modify+ , gets+ ) where++import Control.Monad.Trans (lift)++import Control.Monad.Trans.Ether.Reader (ReaderT)+import Control.Monad.Trans.Ether.Writer (WriterT)+import Control.Monad.Trans.Ether.Except (ExceptT)+import qualified Control.Monad.Trans.Ether.State.Lazy as S.L+import qualified Control.Monad.Trans.Ether.State.Strict as S.S++-- for mtl instances+import qualified Control.Monad.Trans.Cont as Trans (ContT)+import qualified Control.Monad.Trans.Except as Trans (ExceptT)+import qualified Control.Monad.Trans.Identity as Trans (IdentityT)+import qualified Control.Monad.Trans.List as Trans (ListT)+import qualified Control.Monad.Trans.Maybe as Trans (MaybeT)+import qualified Control.Monad.Trans.Reader as Trans (ReaderT)+import qualified Control.Monad.Trans.State.Lazy as Trans.Lazy (StateT)+import qualified Control.Monad.Trans.State.Strict as Trans.Strict (StateT)+import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT)+import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT)++-- | 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 = fmap f (get t)++instance {-# OVERLAPPING #-} Monad m => MonadState tag s (S.L.StateT tag s m) where+ get = S.L.get+ put = S.L.put+ state = S.L.state++instance MonadState tag s m => MonadState tag s (S.L.StateT tag' s' m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance {-# OVERLAPPING #-} Monad m => MonadState tag s (S.S.StateT tag s m) where+ get = S.S.get+ put = S.S.put+ state = S.S.state++instance MonadState tag s m => MonadState tag s (S.S.StateT tag' s' m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++-- Instances for other tagged transformers++instance (MonadState tag s m) => MonadState tag s (ReaderT tag' r m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance (Monoid w, MonadState tag s m) => MonadState tag s (WriterT tag' w m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance (MonadState tag s m) => MonadState tag s (ExceptT tag' e m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++-- Instances for mtl transformers++instance MonadState tag s m => MonadState tag s (Trans.ContT r m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.ExceptT e m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.IdentityT m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.ListT m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.MaybeT m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.ReaderT r m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.Lazy.StateT s' m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance MonadState tag s m => MonadState tag s (Trans.Strict.StateT s' m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Lazy.WriterT w m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t++instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Strict.WriterT w m) where+ get t = lift (get t)+ put t = lift . put t+ state t = lift . state t
+ src/Control/Monad/Ether/State/Lazy.hs view
@@ -0,0 +1,25 @@++-- | 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+ , mapStateT+ ) where++import Control.Monad.Ether.State.Class+import Control.Monad.Trans.Ether.State.Lazy hiding (state, get, put)
+ src/Control/Monad/Ether/State/Strict.hs view
@@ -0,0 +1,25 @@++-- | 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+ , mapStateT+ ) where++import Control.Monad.Ether.State.Class+import Control.Monad.Trans.Ether.State.Strict hiding (state, get, put)
+ src/Control/Monad/Ether/Writer.hs view
@@ -0,0 +1,23 @@++-- | 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+ , mapWriterT+ ) where++import Control.Monad.Ether.Writer.Class+import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)
+ src/Control/Monad/Ether/Writer/Class.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | See "Control.Monad.Writer.Class".++module Control.Monad.Ether.Writer.Class+ ( MonadWriter(..)+ , listens+ , censor+ ) where++import Data.Proxy (Proxy(Proxy))+import Control.Monad.Trans (lift)++import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)+import qualified Control.Monad.Trans.Ether.Reader as R+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.Ether.Except as E+import qualified Control.Monad.Trans.Ether.Writer as W+import qualified Control.Ether.Util as Util++-- for mtl instances+import qualified Control.Monad.Trans.Except as Trans.E+import qualified Control.Monad.Trans.Identity as Trans.I+import qualified Control.Monad.Trans.Maybe as Trans.M+import qualified Control.Monad.Trans.Reader as Trans.R+import qualified Control.Monad.Trans.State.Lazy as Trans.S.Lazy+import qualified Control.Monad.Trans.State.Strict as Trans.S.Strict+import qualified Control.Monad.Trans.Writer.Lazy as Trans.W.Lazy++-- | 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 {-# OVERLAPPING #-} (Monoid w, Monad m) => MonadWriter tag w (WriterT tag w m) where+ writer = W.writer+ tell = W.tell+ listen = W.listen+ pass = W.pass++instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (WriterT tag' w' m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = W.liftListen Proxy (listen t)+ pass t = W.liftPass Proxy (pass t)++-- Instances for other tagged transformers++instance (MonadWriter tag w m) => MonadWriter tag w (R.ReaderT tag' r m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = R.mapReaderT Proxy (listen t)+ pass t = R.mapReaderT Proxy (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (E.ExceptT tag' e m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = E.liftListen Proxy (listen t)+ pass t = E.liftPass Proxy (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (S.L.StateT tag' e m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = S.L.liftListen Proxy (listen t)+ pass t = S.L.liftPass Proxy (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (S.S.StateT tag' e m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = S.S.liftListen Proxy (listen t)+ pass t = S.S.liftPass Proxy (pass t)++-- Instances for mtl transformers++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.E.ExceptT e m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.E.liftListen (listen t)+ pass t = Trans.E.liftPass (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.I.IdentityT m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.I.mapIdentityT (listen t)+ pass t = Trans.I.mapIdentityT (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.M.MaybeT m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.M.liftListen (listen t)+ pass t = Trans.M.liftPass (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.R.ReaderT r m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.R.mapReaderT (listen t)+ pass t = Trans.R.mapReaderT (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Lazy.StateT s m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.S.Lazy.liftListen (listen t)+ pass t = Trans.S.Lazy.liftPass (pass t)++instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Strict.StateT s m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Trans.S.Strict.liftListen (listen t)+ pass t = Trans.S.Strict.liftPass (pass t)++instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (Trans.W.Lazy.WriterT w' m) where+ writer t = lift . writer t+ tell t = lift . tell t+ listen t = Util.liftListen_WriterT (listen t)+ pass t = Util.liftPass_WriterT (pass t)
+ src/Control/Monad/Trans/Ether/Except.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# 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+ , mapExceptT+ -- * Exception operations+ , throw+ , catch+ -- * Lifting other operations+ , liftCallCC+ , liftListen+ , liftPass+ , liftCatch+ ) where++import Data.Proxy (Proxy(Proxy))+import Data.Functor.Identity (Identity(..))+import Data.Coerce (coerce)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Ether.Tagged (Taggable(..), Tagged(..))+import qualified Control.Ether.Util as Util+import GHC.Generics (Generic)+import qualified Control.Newtype as NT++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.Except as Trans++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+++-- | 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 t = Trans.runExcept . untagged t++-- | The exception monad transformer.+--+-- The 'return' function returns a normal value, while '>>=' exits on+-- the first exception.++newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)+ deriving ( Generic+ , Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadTrans, MonadIO )++instance NT.Newtype (ExceptT tag e m a)++instance Taggable (ExceptT tag e m) where+ type Tag (ExceptT tag e m) = 'Just tag+ type Inner (ExceptT tag e m) = 'Just m++instance Tagged (ExceptT tag e m) tag where+ type Untagged (ExceptT tag e m) = Trans.ExceptT e m++-- | Constructor for computations in the exception monad transformer.+exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a+exceptT t = tagged t . 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 t = Trans.runExceptT . untagged t++-- | Transforms the computation inside an 'ExceptT'.+--+-- * @'runExceptT' tag ('mapExceptT' tag f m) = f ('runExceptT' tag m)@+mapExceptT+ :: proxy tag+ -> (m (Either e a) -> n (Either e' b))+ -> ExceptT tag e m a+ -> ExceptT tag e' n b+mapExceptT t f m = tagged t $ Trans.mapExceptT f (coerce m)++-- | Is used within a monadic computation to begin exception processing.+throw :: Monad m => proxy tag -> e -> ExceptT tag e m a+throw t = tagged t . 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 t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)++-- | Lift a @callCC@ operation to the new monad.+liftCallCC :: proxy tag -> Sig.CallCC m (Either e a) (Either e b) -> Sig.CallCC (ExceptT tag e m) a b+liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)++-- | Lift a @listen@ operation to the new monad.+liftListen :: Monad m => proxy tag -> Sig.Listen w m (Either e a) -> Sig.Listen w (ExceptT tag e m) a+liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)++-- | Lift a @pass@ operation to the new monad.+liftPass :: Monad m => proxy tag -> Sig.Pass w m (Either e a) -> Sig.Pass w (ExceptT tag e m) a+liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: proxy tag -> Sig.Catch e m (Either e' a) -> Sig.Catch e (ExceptT tag e' m) a+liftCatch t catchE m h = tagged t $ Util.liftCatch_ExceptT catchE (coerce m) (coerce h)++instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where+ callCC = liftCallCC Proxy Class.callCC++instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where+ ask = lift Class.ask+ local = mapExceptT Proxy . Class.local+ reader = lift . Class.reader++instance Class.MonadState s m => Class.MonadState s (ExceptT tag e m) where+ get = lift Class.get+ put = lift . Class.put+ state = lift . Class.state++instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where+ writer = lift . Class.writer+ tell = lift . Class.tell+ listen = liftListen Proxy Class.listen+ pass = liftPass Proxy Class.pass++instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where+ throwError = lift . Class.throwError+ catchError = liftCatch Proxy Class.catchError
+ src/Control/Monad/Trans/Ether/Reader.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# 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+ , mapReaderT+ , withReaderT+ -- * Reader operations+ , ask+ , local+ -- * Lifting other operations+ , liftCatch+ , liftCallCC+ ) where++import Data.Proxy (Proxy(Proxy))+import Data.Functor.Identity (Identity(..))+import Data.Coerce (coerce)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Ether.Tagged (Taggable(..), Tagged(..))+import GHC.Generics (Generic)+import qualified Control.Newtype as NT++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.Reader as Trans++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++-- | 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.+newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)+ deriving ( Generic+ , Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadTrans, MonadIO )++instance NT.Newtype (ReaderT tag r m a)++instance Taggable (ReaderT tag r m) where+ type Tag (ReaderT tag r m) = 'Just tag+ type Inner (ReaderT tag r m) = 'Just m++instance Tagged (ReaderT tag r m) tag where+ type Untagged (ReaderT tag r m) = Trans.ReaderT r m++-- | Constructor for computations in the reader monad transformer.+readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a+readerT t = tagged t . 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 t = tagged t . Trans.reader++-- | Runs a 'ReaderT' with the given environment+-- and returns the vinal value.+runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a+runReaderT t = Trans.runReaderT . untagged t++-- | Runs a 'ReaderT' with the given environment+-- and returns the vinal value.+runReader :: proxy tag -> Reader tag r a -> r -> a+runReader t = Trans.runReader . untagged t++-- | Transform the computation inside a 'ReaderT'.+--+-- * @'runReaderT' tag ('mapReaderT' tag f m) = f . 'runReaderT' tag m@+mapReaderT :: proxy tag -> (m a -> n b) -> ReaderT tag r m a -> ReaderT tag r n b+mapReaderT t f m = tagged t $ Trans.mapReaderT f (coerce m)++-- | Execute a computation in a modified environment+-- (a more general version of 'local').+--+-- * @'runReaderT' tag ('withReaderT' tag f m) = 'runReaderT' tag m . f@+withReaderT+ :: 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+withReaderT t f m = tagged t $ Trans.withReaderT f (coerce m)++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (ReaderT tag r m) a+liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)++-- | Lift a @callCC@ operation to the new monad.+liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b+liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)++-- | Fetch the value of the environment.+ask :: Monad m => proxy tag -> ReaderT tag r m r+ask t = tagged t 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 = withReaderT++-- Instances for mtl classes++instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where+ callCC = liftCallCC Proxy Class.callCC++instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where+ ask = lift Class.ask+ local = mapReaderT Proxy . Class.local+ reader = lift . Class.reader++instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where+ get = lift Class.get+ put = lift . Class.put+ state = lift . Class.state++instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where+ writer = lift . Class.writer+ tell = lift . Class.tell+ listen = mapReaderT Proxy Class.listen+ pass = mapReaderT Proxy Class.pass++instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where+ throwError = lift . Class.throwError+ catchError = liftCatch Proxy Class.catchError
+ src/Control/Monad/Trans/Ether/State.hs view
@@ -0,0 +1,8 @@++-- | 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
+ src/Control/Monad/Trans/Ether/State/Lazy.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# 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+ , mapStateT+ -- * State operations+ , get+ , put+ -- * Litfing other operations+ , liftCatch+ , liftCallCC'+ , liftListen+ , liftPass+ ) where++import Data.Proxy (Proxy(Proxy))+import Data.Functor.Identity (Identity(..))+import Data.Coerce (coerce)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Ether.Tagged (Taggable(..), Tagged(..))+import GHC.Generics (Generic)+import qualified Control.Newtype as NT++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.State.Lazy as Trans++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+++-- | 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.+newtype StateT tag s m a = StateT (Trans.StateT s m a)+ deriving ( Generic+ , Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadTrans, MonadIO )++instance NT.Newtype (StateT tag s m a)++instance Taggable (StateT tag s m) where+ type Tag (StateT tag s m) = 'Just tag+ type Inner (StateT tag s m) = 'Just m++instance Tagged (StateT tag s m) tag where+ type Untagged (StateT tag s m) = Trans.StateT s m++-- | Constructor for computations in the state monad transformer.+stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a+stateT t = tagged t . 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 t = tagged t . 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 t = Trans.runStateT . untagged t++-- | 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 t = Trans.evalStateT . untagged t++-- | 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 t = Trans.execStateT . untagged t++-- | 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 t = Trans.runState . untagged t++-- | 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 t = Trans.evalState . untagged t++-- | 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 t = Trans.execState . untagged t++-- | Transform the computation inside a 'StateT'.+--+-- * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@+mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b+mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)++-- | Fetch the current value of the state within the monad.+get :: Monad m => proxy tag -> StateT tag s m s+get t = tagged t Trans.get++-- | Set the value of the state within the monad.+put :: Monad m => proxy tag -> s -> StateT tag s m ()+put t = tagged t . Trans.put++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a+liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)++-- | Lift a @listen@ operation to the new monad.+liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a+liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)++-- | In-situ lifting of a @callCC@ operation to the new monad.+-- This version uses the current state on entering the continuation.+-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").+liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b+liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)++-- | Lift a @pass@ operation to the new monad.+liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a+liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)++-- Instances for mtl classes++instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where+ callCC = liftCallCC' Proxy Class.callCC++instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where+ ask = lift Class.ask+ local = mapStateT Proxy . Class.local+ reader = lift . Class.reader++instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where+ get = lift Class.get+ put = lift . Class.put+ state = lift . Class.state++instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where+ writer = lift . Class.writer+ tell = lift . Class.tell+ listen = liftListen Proxy Class.listen+ pass = liftPass Proxy Class.pass++instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where+ throwError = lift . Class.throwError+ catchError = liftCatch Proxy Class.catchError
+ src/Control/Monad/Trans/Ether/State/Strict.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# 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+ , mapStateT+ -- * State operations+ , get+ , put+ -- * Litfing other operations+ , liftCatch+ , liftCallCC'+ , liftListen+ , liftPass+ ) where++import Data.Proxy (Proxy(Proxy))+import Data.Functor.Identity (Identity(..))+import Data.Coerce (coerce)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Ether.Tagged (Taggable(..), Tagged(..))+import GHC.Generics (Generic)+import qualified Control.Newtype as NT++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.State.Strict as Trans++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+++-- | 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.+newtype StateT tag s m a = StateT (Trans.StateT s m a)+ deriving ( Generic+ , Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadTrans, MonadIO )++instance NT.Newtype (StateT tag s m a)++instance Taggable (StateT tag s m) where+ type Tag (StateT tag s m) = 'Just tag+ type Inner (StateT tag s m) = 'Just m++instance Tagged (StateT tag s m) tag where+ type Untagged (StateT tag s m) = Trans.StateT s m++-- | Constructor for computations in the state monad transformer.+stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a+stateT t = tagged t . 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 t = tagged t . 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 t = Trans.runStateT . untagged t++-- | 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 t = Trans.evalStateT . untagged t++-- | 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 t = Trans.execStateT . untagged t++-- | 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 t = Trans.runState . untagged t++-- | 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 t = Trans.evalState . untagged t++-- | 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 t = Trans.execState . untagged t++-- | Transform the computation inside a 'StateT'.+--+-- * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@+mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b+mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)++-- | Fetch the current value of the state within the monad.+get :: Monad m => proxy tag -> StateT tag s m s+get t = tagged t Trans.get++-- | Set the value of the state within the monad.+put :: Monad m => proxy tag -> s -> StateT tag s m ()+put t = tagged t . Trans.put++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a+liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)++-- | Lift a @listen@ operation to the new monad.+liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a+liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)++-- | In-situ lifting of a @callCC@ operation to the new monad.+-- This version uses the current state on entering the continuation.+-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").+liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b+liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)++-- | Lift a @pass@ operation to the new monad.+liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a+liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)++-- Instances for mtl classes++instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where+ callCC = liftCallCC' Proxy Class.callCC++instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where+ ask = lift Class.ask+ local = mapStateT Proxy . Class.local+ reader = lift . Class.reader++instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where+ get = lift Class.get+ put = lift . Class.put+ state = lift . Class.state++instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where+ writer = lift . Class.writer+ tell = lift . Class.tell+ listen = liftListen Proxy Class.listen+ pass = liftPass Proxy Class.pass++instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where+ throwError = lift . Class.throwError+ catchError = liftCatch Proxy Class.catchError
+ src/Control/Monad/Trans/Ether/Writer.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# 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+ , mapWriterT+ -- * Writer operations+ , tell+ , listen+ , pass+ -- * Lifting other operations+ , liftCallCC+ , liftCatch+ , liftListen+ , liftPass+ ) where++import Data.Proxy (Proxy(Proxy))+import Data.Functor.Identity (Identity(..))+import Data.Coerce (coerce)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Fix (MonadFix)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Ether.Tagged (Taggable(..), Tagged(..))+import qualified Control.Ether.Util as Util+import GHC.Generics (Generic)+import qualified Control.Newtype as NT++import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Trans.Writer.Lazy as Trans++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++-- | 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'.+newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)+ deriving ( Generic+ , Functor, Applicative, Alternative, Monad, MonadPlus+ , MonadFix, MonadTrans, MonadIO )++instance NT.Newtype (WriterT tag w m a)++instance Taggable (WriterT tag w m) where+ type Tag (WriterT tag w m) = 'Just tag+ type Inner (WriterT tag w m) = 'Just m++instance Tagged (WriterT tag w m) tag where+ type Untagged (WriterT tag w m) = Trans.WriterT w m++-- | Constructor for computations in the writer monad transformer.+writerT :: proxy tag -> m (a, w) -> WriterT tag w m a+writerT t = tagged t . 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 t = tagged t . 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 t = Trans.runWriterT . untagged t++-- | Runs a 'Writer' and returns both the normal value+-- and the final accumulator.+runWriter :: proxy tag -> Writer tag w a -> (a, w)+runWriter t = Trans.runWriter . untagged t++-- | 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 t = Trans.execWriterT . untagged t++-- | Runs a 'Writer' and returns the final accumulator,+-- discarding the normal value.+execWriter :: proxy tag -> Writer tag w a -> w+execWriter t = Trans.execWriter . untagged t++-- | Transform the computation inside a 'WriterT'.+--+-- * @'runWriterT' tag ('mapWriterT' tag f m) = f ('runWriterT' tag m)@+mapWriterT :: proxy tag -> (m (a, w) -> n (b, w')) -> WriterT tag w m a -> WriterT tag w' n b+mapWriterT t f m = tagged t $ Trans.mapWriterT f (coerce m)++-- | 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 :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)+listen t m = tagged t $ Trans.listen (coerce m)++-- | Executes an action which returns a value and a function, and returns the+-- value, applying the function to the accumulator.+pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a+pass t m = tagged t $ Trans.pass (coerce m)++-- | Lift a @catchE@ operation to the new monad.+liftCatch :: proxy tag -> Sig.Catch e m (a, w) -> Sig.Catch e (WriterT tag w m) a+liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)++-- | Lift a @callCC@ operation to the new monad.+liftCallCC :: Monoid w => proxy tag -> Sig.CallCC m (a, w) (b, w) -> Sig.CallCC (WriterT tag w m) a b+liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)++-- | Lift a @listen@ operation to the new monad.+liftListen :: Monad m => proxy tag -> Sig.Listen w' m (a, w) -> Sig.Listen w' (WriterT tag w m) a+liftListen t f m = tagged t $ Util.liftListen_WriterT f (coerce m)++-- | Lift a @pass@ operation to the new monad.+liftPass :: Monad m => proxy tag -> Sig.Pass w' m (a, w) -> Sig.Pass w' (WriterT tag w m) a+liftPass t f m = tagged t $ Util.liftPass_WriterT f (coerce m)++instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where+ callCC = liftCallCC Proxy Class.callCC++instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where+ ask = lift Class.ask+ local = mapWriterT Proxy . Class.local+ reader = lift . Class.reader++instance (Monoid w, Class.MonadState s m) => Class.MonadState s (WriterT tag w m) where+ get = lift Class.get+ put = lift . Class.put+ state = lift . Class.state++instance (Monoid w, Class.MonadWriter w' m) => Class.MonadWriter w' (WriterT tag w m) where+ writer = lift . Class.writer+ tell = lift . Class.tell+ listen = liftListen Proxy Class.listen+ pass = liftPass Proxy Class.pass++instance (Monoid w, Class.MonadError e m) => Class.MonadError e (WriterT tag w m) where+ throwError = lift . Class.throwError+ catchError = liftCatch Proxy Class.catchError
+ test/Regression.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}+module Main where++import Data.Functor.Identity+import Data.Monoid+import Data.Foldable+import Control.Ether.Tagged+import Control.Ether.TH+import Control.Ether.Wrapped+import Control.Monad.Ether.Reader+import Control.Monad.Ether.State+import Control.Monad.Ether.Writer+import Control.Monad.Ether.Implicit.Except.TH+import qualified Control.Monad.Ether.Implicit.Reader as I+import qualified Control.Monad.Ether.Implicit.State as I+import qualified Control.Monad.Ether.Implicit.Except as I+import qualified Control.Monad.Reader as T+import qualified Control.Monad.Writer as T+import qualified Control.Monad.State as T++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Function++ethereal "R1" "r1"+ethereal "R2" "r2"+ethereal "S1" "s1"+ethereal "Foo" "foo"+ethereal "Bar" "bar"++main :: IO ()+main = defaultMain suite++suite :: TestTree+suite = testGroup "Ether"+ [ testGroup "ReaderT"+ [ testProperty "layered sum (local left)" layeredLocalLeft+ , testProperty "layered sum (local right)" layeredLocalRight+ ]+ ]++layeredLocalLeft, layeredLocalRight+ :: Fun (Int, Integer) Integer+ -> Fun Integer Integer+ -> Int -> Integer -> Property++layeredLocalLeft k f a1 a2 = property (direct == run indirect)+ where+ run = flip (runReader r1) a1 . flip (runReaderT r2) a2+ (direct, indirect) = layeredLocalCore' k f a1 a2++layeredLocalRight k f a1 a2 = property (direct == run indirect)+ where+ run = flip (runReader r2) a2 . flip (runReaderT r1) a1+ (direct, indirect) = layeredLocalCore' k f a1 a2++layeredLocalCore+ :: (MonadReader R1 r1 m, MonadReader R2 r2 m)+ => (r2 -> r2) -> (r1 -> r2 -> a) -> m a+layeredLocalCore f g = do+ n <- ask r1+ m <- local r2 f (ask r2)+ return (g n m)++layeredLocalCore'+ :: (MonadReader R1 Int m, MonadReader R2 Integer m)+ => Fun (Int, Integer) Integer+ -> Fun Integer Integer+ -> Int -> Integer -> (Integer, m Integer)+layeredLocalCore' k f a1 a2 = (direct, indirect)+ where+ direct = apply k (fromIntegral a1, apply f a2)+ indirect = layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))++implicitCore :: (I.MonadReader Int m, I.MonadReader Bool m) => m String+implicitCore = I.local (succ :: Int -> Int) $ do+ n :: Int <- I.ask+ b <- I.local not I.ask+ return (if b then "" else show n)++wrapCore+ :: ( T.MonadReader Int m+ , T.MonadState Int m+ ) => m Int+wrapCore = do+ b <- T.get+ a <- T.ask+ T.put (a + b)+ return (a * b)++wrapCore'+ :: ( MonadReader S1 Int m+ , MonadState S1 Int m+ , MonadReader R1 Int m+ ) => m Int+wrapCore' = do+ a <- ethered s1 wrapCore+ c <- ask r1+ return (a + c)++wrapCore'' :: Int -> (Int, Int)+wrapCore'' a = runReader r1 (runStateT s1 (runReaderT s1 wrapCore' a) a) (-1)++-- Should not compile with `ensureUniqueTags`+uniqueTagsCore :: IO ()+uniqueTagsCore = flip (runReaderT r1) (1 :: Int)+ . flip (runReaderT r1) (True :: Bool)+ . flip (runReaderT r1) (2 :: Int)+ . flip (runReaderT r1) (3 :: Integer)+ {- . ensureUniqueTags -}+ $ do+ a :: Integer <- ask r1+ b :: Int <- ask r1+ c :: Bool <- ask r1+ T.liftIO $ do+ print a+ print b+ print c++stateCore :: ( MonadState S1 Int m+ , MonadReader R1 Int m+ , UniqueTags m ) => m ()+stateCore = do+ a <- ask r1+ n <- get s1+ put s1 (n * a)+ modify s1 (subtract 1)++recurseCore :: (Num a, Ord a) => (I.MonadReader a m, I.MonadState Int m) => m a+recurseCore = do+ a <- I.ask+ if (a <= 0)+ then do+ I.put (0 :: Int)+ return 1+ else do+ I.modify (succ :: Int -> Int)+ b <- I.runReaderT recurseCore (a - 1)+ I.modify (succ :: Int -> Int)+ return (a * b)++factorial :: (Num a, Ord a) => a -> (a, Int)+factorial a = I.runState (I.runReaderT recurseCore a) (0 :: Int)++factorial' :: Int -> (Int, Int)+factorial' a = factorial (a :: Int)++data DivideByZero = DivideByZero+ deriving (Show)+data NegativeLog a = NegativeLog a+ deriving (Show)++exceptCore+ :: ( Floating a, Ord a+ , I.MonadExcept DivideByZero m+ , I.MonadExcept (NegativeLog a) m+ ) => a -> a -> m a+exceptCore a b = do+ T.when (b == 0) (I.throw DivideByZero)+ let d = a /b+ T.when (d < 0) (I.throw (NegativeLog d))+ return (log d)++try0 :: m a -> m a+try0 = $(try 0)++try1 :: Functor m => I.ExceptT e m a -> (e -> a) -> m a+try1 = $(try 1)++try2 :: Functor m => I.ExceptT e1 (I.ExceptT e2 m) a -> (e1 -> a) -> (e2 -> a) -> m a+try2 = $(try 2)++try3 :: Functor m => I.ExceptT e1 (I.ExceptT e2 (I.ExceptT e3 m)) a -> (e1 -> a) -> (e2 -> a) -> (e3 -> a) -> m a+try3 = $(try 3)++exceptCore' :: Double -> Double -> String+exceptCore' a b = runIdentity $ do+ $(try 2)+ (show <$> exceptCore a b)+ (\(NegativeLog (x::Double)) -> "nl: " ++ show x)+ (\DivideByZero -> "dz")++summatorCore+ :: ( Num a+ , T.MonadWriter (Sum a) m+ , MonadWriter Foo (Sum a) m+ ) => [a] -> m ()+summatorCore xs = do+ for_ xs $ \x -> do+ T.tell (Sum x)+ tell foo (Sum 1)++summatorCore' :: Num a => [a] -> (Sum a, Sum a)+summatorCore' = runWriter foo . T.execWriterT . summatorCore++wrapState_f :: T.MonadState Int m => m String+wrapState_f = fmap show T.get++wrapState_g :: T.MonadState Bool m => m String+wrapState_g = fmap show T.get++wrapState_useboth+ :: ( MonadState Foo Int m+ , MonadState Bar Bool m+ ) => m String+wrapState_useboth = do+ a <- ethered foo wrapState_f+ b <- ethered bar wrapState_g+ return (a ++ b)++wrapStateCore :: Int -> Bool -> String+wrapStateCore int bool = evalState foo (evalStateT bar wrapState_useboth bool) int++wrapStateBad1_g :: MonadState Foo Int m => m ()+wrapStateBad1_g = modify foo (*100)++wrapStateBad1_useboth :: MonadState Foo Int m => m String+wrapStateBad1_useboth = do+ wrapStateBad1_g+ ethered foo wrapState_f++wrapStateBad1 :: Int -> String+wrapStateBad1 = evalState foo wrapStateBad1_useboth++wrapStateBad2+ :: ( T.MonadState Int m+ , MonadState Foo Int m+ ) => m Int+wrapStateBad2 = do+ modify foo (*100)+ T.get++wrapStateBad2Core :: Int -> Int+wrapStateBad2Core = evalState foo (ensureUniqueTags $ ethered foo wrapStateBad2)