constrained-monads (empty) → 0.1.0.0
raw patch · 13 files changed
+2706/−0 lines, 13 filesdep +QuickCheckdep +basedep +constrained-monadssetup-changed
Dependencies added: QuickCheck, base, constrained-monads, containers, doctest, transformers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- constrained-monads.cabal +53/−0
- src/Control/Monad/Constrained.hs +1207/−0
- src/Control/Monad/Constrained/Cont.hs +68/−0
- src/Control/Monad/Constrained/Error.hs +100/−0
- src/Control/Monad/Constrained/IO.hs +61/−0
- src/Control/Monad/Constrained/IntSet.hs +200/−0
- src/Control/Monad/Constrained/Reader.hs +129/−0
- src/Control/Monad/Constrained/State.hs +114/−0
- src/Control/Monad/Constrained/Trans.hs +72/−0
- src/Control/Monad/Constrained/Writer.hs +361/−0
- test/Spec.hs +318/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Donnacha Oisín Kidney++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ constrained-monads.cabal view
@@ -0,0 +1,53 @@+name: constrained-monads+version: 0.1.0.0+synopsis: Typeclasses and instances for monads with constraints. +description: A library for monads with constraints over the types they contain. This allows set, etc to conform to the monad class. It is structured as a prelude replacement: everything that doesn't conflict with the new definitions of 'Functor', 'Monad', etc is reexported.+ +homepage: https://github.com/oisdk/constrained-monads#readme+license: MIT+license-file: LICENSE+author: Donnacha Oisín Kidney+maintainer: mail@doisinkidney.com+copyright: 2016 Donnacha Oisín Kidney+category: Control+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Control.Monad.Constrained+ , Control.Monad.Constrained.Trans+ , Control.Monad.Constrained.State+ , Control.Monad.Constrained.Reader+ , Control.Monad.Constrained.Error+ , Control.Monad.Constrained.Writer+ , Control.Monad.Constrained.IO+ , Control.Monad.Constrained.Cont+ , Control.Monad.Constrained.IntSet+ build-depends: base >= 4.9 && < 5+ , containers >= 0.5+ , transformers >= 0.5+ default-language: Haskell2010+ ghc-options: -Wall++test-suite constrained-monads-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base >= 4.9 && < 5+ , constrained-monads >= 0.1+ , doctest >= 0.11+ , QuickCheck >= 2.8+ , containers >= 0.5+ , transformers >= 0.5+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N+ -Wall+ default-language: Haskell2010++++source-repository head+ type: git+ location: https://github.com/oisdk/constrained-monads
+ src/Control/Monad/Constrained.hs view
@@ -0,0 +1,1207 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | A module for constrained monads. This module is intended to be imported+-- with the @-XRebindableSyntax@ extension turned on: everything from the+-- "Prelude" (that doesn't conflict with the new 'Functor', 'Applicative', etc) is+-- reexported, so these type classes can be used the same way that the "Prelude"+-- classes are used.+module Control.Monad.Constrained+ (+ -- * Basic Classes+ Functor(..)+ ,Applicative(..)+ ,Monad(..)+ ,Alternative(..)+ ,Traversable(..)+ ,+ -- * Horrible type-level stuff+ Vect(..)+ ,AppVect(..)+ ,liftAP+ ,liftAM+ ,+ -- * Useful functions+ guard+ ,ensure+ ,(<**>)+ ,(<$>)+ ,(=<<)+ ,(<=<)+ ,(>=>)+ ,foldM+ ,traverse_+ ,sequenceA+ ,sequenceA_+ ,mapAccumL+ ,replicateM+ ,void+ ,forever+ ,for_+ ,+ -- * Syntax+ ifThenElse+ ,fail+ ,(>>)+ ,return+ ,module RestPrelude)+ where++import GHC.Exts++import Prelude as RestPrelude hiding (Applicative (..),+ Functor (..),+ Monad (..),+ Traversable (..),+ (<$>), (=<<))++import qualified Control.Applicative+import qualified Prelude++import Data.Functor.Identity (Identity (..))++import Data.IntMap.Strict (IntMap)+import Data.Map.Strict (Map)+import Data.Sequence (Seq)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Tree (Tree(..))++import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.Maybe (MaybeT (..))+import Control.Monad.Trans.Reader (ReaderT (..), mapReaderT)+import Control.Monad.Trans.State (StateT (..))+import qualified Control.Monad.Trans.State.Strict as Strict (StateT (..))+import Control.Monad.Trans.State.Strict (state, runState)++import Control.Arrow (first)+import Data.Tuple (swap)++--------------------------------------------------------------------------------+-- Type-level shenanigans+--------------------------------------------------------------------------------++-- | A heterogeneous list, for storing the arguments to 'liftA'. (There /has/ to+-- be a better way to do this).+infixr 5 :-+data Vect xs where+ Nil :: Vect '[]+ (:-) :: x -> Vect xs -> Vect (x ': xs)++-- | Another heterogeneous list, for storing the arguments to 'liftA', wrapped+-- in their applicatives.+infixr 5 :*+data AppVect f xs where+ NilA :: AppVect f '[]+ (:*) :: f x -> AppVect f xs -> AppVect f (x ': xs)++--------------------------------------------------------------------------------+-- Standard classes+--------------------------------------------------------------------------------++-- | This is the same class as 'Prelude.Functor' from the Prelude. Most of the+-- functions here are simply rewritten versions of those, with one difference:+-- types can indicate /which/ types they can contain. This allows+-- 'Data.Set.Set' to be made into a monad, as well as some other exotic types.+-- (but, to be fair, 'Data.Set.Set' is kind of the poster child for this+-- technique).+--+-- The way that types indicate what they can contain is with the 'Suitable'+-- associated type.+--+-- The default implementation is for types which conform to the "Prelude"'s+-- 'Prelude.Functor'. The way to make a standard 'Prelude.Functor' conform+-- is by indicating that it has no constraints. For instance, for @[]@:+--+-- @instance 'Functor' [] where+-- type 'Suitable' [] a = ()+-- fmap = map+-- (<$) = (Prelude.<$)@+--+-- Monomorphic types can also conform, using GADT aliases. For instance,+-- if you create an alias for 'Data.IntSet.IntSet' of kind @* -> *@:+--+-- @data IntSet a where+-- IntSet :: IntSet.'Data.IntSet.IntSet' -> IntSet 'Int'@+--+-- It can be made to conform to 'Functor' like so:+--+-- @instance 'Functor' IntSet where+-- type 'Suitable' IntSet a = a ~ 'Int'+-- 'fmap' f (IntSet xs) = IntSet (IntSet.'Data.IntSet.map' f xs)+-- x '<$' xs = if 'null' xs then 'empty' else 'pure' x@+--+-- It can also be made conform to 'Foldable', etc. This type is provided in+-- "Control.Monad.Constrained.IntSet".+class Functor f where+ {-# MINIMAL fmap #-}+ -- | Indicate which types can be contained by 'f'. For instance,+ -- 'Data.Set.Set' conforms like so:+ --+ -- @instance 'Functor' 'Set' where+ -- type 'Suitable' 'Set' a = 'Ord' a+ -- 'fmap' = 'Set.map'@+ type Suitable f a :: Constraint++ -- | Maps a function over a functor+ fmap+ :: Suitable f b+ => (a -> b) -> f a -> f b++ -- | Replace all values in the input with a default value.+ infixl 4 <$+ (<$) :: Suitable f a => a -> f b -> f a+ (<$) = fmap . const+ {-# INLINE (<$) #-}++-- | A functor with application.+--+-- This class is slightly different (although equivalent) to the class+-- provided in the Prelude. This is to facilitate the lifting of functions+-- to arbitrary numbers of arguments.+--+-- A minimal complete definition must include implementations of 'liftA'+-- functions satisfying the following laws:+--+-- [/identity/]+--+-- @'pure' 'id' '<*>' v = v@+--+-- [/composition/]+--+-- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@+--+-- [/homomorphism/]+--+-- @'pure' f '<*>' 'pure' x = 'pure' (f x)@+--+-- [/interchange/]+--+-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@+--+-- The other methods have the following default definitions, which may+-- be overridden with equivalent specialized implementations:+--+-- * @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@+--+-- * @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@+--+-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy+--+-- * @'fmap' f x = 'pure' f '<*>' x@+--+-- If @f@ is also a 'Monad', it should satisfy+--+-- * @'pure' = 'return'@+--+-- * @('<*>') = 'ap'@+--+-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws).+class Functor f =>+ Applicative f where+ {-# MINIMAL liftA #-}++ -- | Lift a value.+ pure+ :: Suitable f a+ => a -> f a+ pure x = liftA (\Nil -> x) NilA+ {-# INLINE pure #-}++ infixl 4 <*>++ -- | Sequential application.+ (<*>)+ :: Suitable f b+ => f (a -> b) -> f a -> f b+ fs <*> xs = liftA (\(f :- x :- Nil) -> f x) (fs :* xs :* NilA)+ {-# INLINE (<*>) #-}++ infixl 4 *>+ -- | Sequence actions, discarding the value of the first argument.+ (*>)+ :: Suitable f b+ => f a -> f b -> f b+ (*>) = liftA2 (const id)+ {-# INLINE (*>) #-}++ infixl 4 <*+ -- | Sequence actions, discarding the value of the second argument.+ (<*)+ :: Suitable f a+ => f a -> f b -> f a+ (<*) = liftA2 const+ {-# INLINE (<*) #-}+ -- | The shenanigans introduced by this function are to account for the fact+ -- that you can't (I don't think) write an arbitrary lift function on+ -- non-monadic applicatives that have constrained types. For instance, if+ -- the only present functions are:+ --+ -- @'pure' :: 'Suitable' f a => a -> f b+ --'fmap' :: 'Suitable' f b => (a -> b) -> f a -> f b+ --('<*>') :: 'Suitable' f b => f (a -> b) -> f a -> f b@+ --+ -- I can't see a way to define:+ --+ -- @'liftA2' :: 'Suitable' f c => (a -> b -> c) -> f a -> f b -> f c@+ --+ -- Of course, if:+ --+ -- @('>>=') :: 'Suitable' f b => f a -> (a -> f b) -> f b@+ --+ -- is available, 'liftA2' could be defined as:+ --+ -- @'liftA2' f xs ys = do+ -- x <- xs+ -- y <- ys+ -- 'pure' (f x)@+ --+ -- But now we can't define the 'liftA' functions for things which are+ -- 'Applicative' but not 'Monad' (square matrices,+ -- 'Control.Applicative.ZipList's, etc). Also, some types have a more+ -- efficient @('<*>')@ than @('>>=')@ (see, for instance, the+ -- <https://simonmar.github.io/posts/2015-10-20-Fun-With-Haxl-1.html Haxl>+ -- monad).+ --+ -- The one missing piece is @-XApplicativeDo@: I can't figure out a way+ -- to get do-notation to desugar to using the 'liftA' functions, rather+ -- than @('<*>')@.+ --+ -- It would also be preferable to avoid the two intermediate structures+ -- ('Vect', 'AppVect', etc). Ideally GHC would optimize them away, but+ -- it seems unlikely.+ --+ -- Utility definitions of this function are provided: if your 'Applicative'+ -- is a @Prelude.'Prelude.Applicative'@, 'liftA' can be defined in terms of+ -- @('<*>')@. 'liftAP' does exactly this.+ --+ -- Alternatively, if your applicative is a 'Monad', 'liftA' can be defined+ -- in terms of @('>>=')@, which is what 'liftAM' does.+ liftA+ :: Suitable f b+ => (Vect xs -> b) -> AppVect f xs -> f b++ liftA2+ :: Suitable f c+ => (a -> b -> c) -> f a -> f b -> f c+ liftA2 f xs ys =+ liftA+ (\(x :- y :- Nil) ->+ f x y)+ (xs :* ys :* NilA)+ liftA3+ :: Suitable f d+ => (a -> b -> c -> d) -> f a -> f b -> f c -> f d+ liftA3 f xs ys zs =+ liftA+ (\(x :- y :- z :- Nil) ->+ f x y z)+ (xs :* ys :* zs :* NilA)+ liftA4+ :: Suitable f e+ => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e+ liftA4 f ws xs ys zs =+ liftA+ (\(w :- x :- y :- z :- Nil) ->+ f w x y z)+ (ws :* xs :* ys :* zs :* NilA)+ liftA5+ :: Suitable f g+ => (a -> b -> c -> d -> e -> g)+ -> f a+ -> f b+ -> f c+ -> f d+ -> f e+ -> f g+ liftA5 f vs ws xs ys zs =+ liftA+ (\(v :- w :- x :- y :- z :- Nil) ->+ f v w x y z)+ (vs :* ws :* xs :* ys :* zs :* NilA)++ liftA6+ :: Suitable f h+ => (a -> b -> c -> d -> e -> g -> h)+ -> f a+ -> f b+ -> f c+ -> f d+ -> f e+ -> f g+ -> f h+ liftA6 f us vs ws xs ys zs =+ liftA+ (\(u :- v :- w :- x :- y :- z :- Nil) ->+ f u v w x y z)+ (us :* vs :* ws :* xs :* ys :* zs :* NilA)++ liftA7+ :: Suitable f i+ => (a -> b -> c -> d -> e -> g -> h -> i)+ -> f a+ -> f b+ -> f c+ -> f d+ -> f e+ -> f g+ -> f h+ -> f i+ liftA7 f ts us vs ws xs ys zs =+ liftA+ (\(t :- u :- v :- w :- x :- y :- z :- Nil) ->+ f t u v w x y z)+ (ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)++ liftA8+ :: Suitable f j+ => (a -> b -> c -> d -> e -> g -> h -> i -> j)+ -> f a+ -> f b+ -> f c+ -> f d+ -> f e+ -> f g+ -> f h+ -> f i+ -> f j+ liftA8 f ss ts us vs ws xs ys zs =+ liftA+ (\(s :- t :- u :- v :- w :- x :- y :- z :- Nil) ->+ f s t u v w x y z)+ (ss :* ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)++ liftA9+ :: Suitable f k+ => (a -> b -> c -> d -> e -> g -> h -> i -> j -> k)+ -> f a+ -> f b+ -> f c+ -> f d+ -> f e+ -> f g+ -> f h+ -> f i+ -> f j+ -> f k+ liftA9 f rs ss ts us vs ws xs ys zs =+ liftA+ (\(r :- s :- t :- u :- v :- w :- x :- y :- z :- Nil) ->+ f r s t u v w x y z)+ (rs :* ss :* ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)++-- | A variant of '<*>' with the arguments reversed.+(<**>) :: (Applicative f, Suitable f b) => f a -> f (a -> b) -> f b+(<**>) = liftA2 (flip ($))++-- | A definition of 'liftA' which uses the "Prelude"'s @('Prelude.<*>')@.+liftAP :: (Prelude.Applicative f) => (Vect xs -> b) -> (AppVect f xs -> f b)+liftAP f NilA = Prelude.pure (f Nil)+liftAP f (x :* NilA) = Prelude.fmap (f . (:-Nil)) x+liftAP f (x :* xs) = ((f .) . (:-)) Prelude.<$> x Prelude.<*> liftAP id xs++-- | A definition of 'liftA' which uses 's @('>>=')@.+liftAM :: (Monad f, Suitable f b) => (Vect xs -> b) -> (AppVect f xs -> f b)+liftAM f NilA = pure (f Nil)+liftAM f (x :* NilA) = fmap (f . (:-Nil)) x+liftAM f (x :* xs) = x >>= \y -> liftAM (f . (y:-)) xs+{- | The 'Monad' class defines the basic operations over a /monad/,+a concept from a branch of mathematics known as /category theory/.+From the perspective of a Haskell programmer, however, it is best to+think of a monad as an /abstract datatype/ of actions.+Haskell's @do@ expressions provide a convenient syntax for writing+monadic expressions.++Instances of 'Monad' should satisfy the following laws:++* @'return' a '>>=' k = k a@+* @m '>>=' 'return' = m@+* @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@++Furthermore, the 'Monad' and 'Applicative' operations should relate as follows:++* @'pure' = 'return'@+* @('<*>') = 'ap'@++The above laws imply:++* @'fmap' f xs = xs '>>=' 'return' . f@+* @('>>') = ('*>')@++and that 'pure' and ('<*>') satisfy the applicative functor laws.++The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'+defined in the ""Prelude"" satisfy these laws.+-}+class Applicative f =>+ Monad f where+ infixl 1 >>=+ -- | Sequentially compose two actions, passing any value produced+ -- by the first as an argument to the second.+ (>>=)+ :: Suitable f b+ => f a -> (a -> f b) -> f b+-- | A monoid on applicative functors.+--+-- If defined, 'some' and 'many' should be the least solutions+-- of the equations:+--+-- * @some v = (:) '<$>' v '<*>' many v@+--+-- * @many v = some v '<|>' 'pure' []@+class Applicative f =>+ Alternative f where+ {-# MINIMAL empty, (<|>) #-}+ -- | The identity of '<|>'+ empty :: Suitable f a => f a+ infixl 3 <|>+ -- | An associative binary operation+ (<|>)+ :: Suitable f a+ => f a -> f a -> f a+ -- | One or more.+ some :: Suitable f [a] => f a -> f [a]+ some v = some_v+ where+ many_v = some_v <|> pure []+ some_v = liftA2 (:) v many_v++ -- | Zero or more.+ many :: Suitable f [a] => f a -> f [a]+ many v = many_v+ where+ many_v = some_v <|> pure []+ some_v = liftA2 (:) v many_v++-- | Functors representing data structures that can be traversed from+-- left to right.+--+-- A definition of 'traverse' must satisfy the following laws:+--+-- [/naturality/]+-- @t . 'traverse' f = 'traverse' (t . f)@+-- for every applicative transformation @t@+--+-- [/identity/]+-- @'traverse' Identity = Identity@+--+-- [/composition/]+-- @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@+--+-- A definition of 'sequenceA' must satisfy the following laws:+--+-- [/naturality/]+-- @t . 'sequenceA' = 'sequenceA' . 'fmap' t@+-- for every applicative transformation @t@+--+-- [/identity/]+-- @'sequenceA' . 'fmap' Identity = Identity@+--+-- [/composition/]+-- @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@+--+-- where an /applicative transformation/ is a function+--+-- @t :: (Applicative f, Applicative g) => f a -> g a@+--+-- preserving the 'Applicative' operations, i.e.+--+-- * @t ('pure' x) = 'pure' x@+--+-- * @t (x '<*>' y) = t x '<*>' t y@+--+-- and the identity functor @Identity@ and composition of functors @Compose@+-- are defined as+--+-- > newtype Identity a = Identity a+-- >+-- > instance Functor Identity where+-- > fmap f (Identity x) = Identity (f x)+-- >+-- > instance Applicative Identity where+-- > pure x = Identity x+-- > Identity f <*> Identity x = Identity (f x)+-- >+-- > newtype Compose f g a = Compose (f (g a))+-- >+-- > instance (Functor f, Functor g) => Functor (Compose f g) where+-- > fmap f (Compose x) = Compose (fmap (fmap f) x)+-- >+-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where+-- > pure x = Compose (pure (pure x))+-- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)+--+-- (The naturality law is implied by parametricity.)+--+-- Instances are similar to 'Functor', e.g. given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Traversable Tree where+-- > traverse f Empty = pure Empty+-- > traverse f (Leaf x) = Leaf <$> f x+-- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r+--+-- This is suitable even for abstract types, as the laws for '<*>'+-- imply a form of associativity.+--+-- The superclass instances should satisfy the following:+--+-- * In the 'Functor' instance, 'fmap' should be equivalent to traversal+-- with the identity applicative functor ('fmapDefault').+--+-- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be+-- equivalent to traversal with a constant applicative functor+-- ('foldMapDefault').+--+class (Foldable t, Functor t) =>+ Traversable t where+ -- | Map each element of a structure to an action, evaluate these actions+ -- from left to right, and collect the results. For a version that ignores+ -- the results see 'traverse_'.+ traverse+ :: (Suitable t b, Applicative f, Suitable f (t b))+ => (a -> f b) -> t a -> f (t b)+++--------------------------------------------------------------------------------+-- useful functions+--------------------------------------------------------------------------------++infixl 4 <$>+-- | An infix synonym for 'fmap'.+--+-- The name of this operator is an allusion to '$'.+-- Note the similarities between their types:+--+-- > ($) :: (a -> b) -> a -> b+-- > (<$>) :: Functor f => (a -> b) -> f a -> f b+--+-- Whereas '$' is function application, '<$>' is function+-- application lifted over a 'Functor'.+--+-- ==== __Examples__+--+-- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show':+--+-- >>> show <$> Nothing+-- Nothing+-- >>> show <$> Just 3+-- Just "3"+--+-- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@+-- 'String' using 'show':+--+-- >>> show <$> Left 17+-- Left 17+-- >>> show <$> Right 17+-- Right "17"+--+-- Double each element of a list:+--+-- >>> (*2) <$> [1,2,3]+-- [2,4,6]+--+-- Apply 'even' to the second element of a pair:+--+-- >>> even <$> (2,2)+-- (2,True)+--+(<$>) :: (Functor f, Suitable f b) => (a -> b) -> f a -> f b+(<$>) = fmap++infixr 1 =<<, <=<+-- | A flipped version of '>>='+(=<<) :: (Monad f, Suitable f b) => (a -> f b) -> f a -> f b+(=<<) = flip (>>=)++-- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped.+--+-- Note how this operator resembles function composition @('.')@:+--+-- > (.) :: (b -> c) -> (a -> b) -> a -> c+-- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c+(<=<) :: (Monad f, Suitable f c) => (b -> f c) -> (a -> f b) -> a -> f c+(f <=< g) x = f =<< g x++infixl 1 >=>++-- | Left-to-right Kleisli composition of monads.+(>=>) :: (Monad f, Suitable f c) => (a -> f b) -> (b -> f c) -> a -> f c+(f >=> g) x = f x >>= g++-- | @'forever' act@ repeats the action infinitely.+forever :: (Applicative f, Suitable f b) => f a -> f b+{-# INLINE forever #-}+forever a = let a' = a *> a' in a'++-- | Monadic fold over the elements of a structure,+-- associating to the left, i.e. from left to right.+foldM :: (Foldable t, Monad m, Suitable m b) => (b -> a -> m b) -> b -> t a -> m b+foldM f z0 xs = foldr f' pure xs z0+ where f' x k z = f z x >>= k++-- | 'for_' is 'traverse_' with its arguments flipped. For a version+-- that doesn't ignore the results see 'Data.Traversable.for'.+--+-- >>> for_ [1..4] print+-- 1+-- 2+-- 3+-- 4+for_ :: (Foldable t, Applicative f, Suitable f ()) => t a -> (a -> f b) -> f ()+{-# INLINE for_ #-}+for_ = flip traverse_++-- | Map each element of a structure to an action, evaluate these+-- actions from left to right, and ignore the results. For a version+-- that doesn't ignore the results see 'traverse'.+traverse_ :: (Applicative f, Foldable t, Suitable f ()) => (a -> f b) -> t a -> f ()+traverse_ f = foldr (\e a -> f e *> a) (pure ())++-- | Evaluate each action in the structure from left to right, and+-- ignore the results. For a version that doesn't ignore the results+-- see 'Data.Traversable.sequenceA'.+sequenceA_ :: (Foldable t, Applicative f, Suitable f ()) => t (f a) -> f ()+sequenceA_ = foldr (*>) (pure ())++-- | @'guard' b@ is @'pure' ()@ if @b@ is 'True',+-- and 'empty' if @b@ is 'False'.+guard :: (Alternative f, Suitable f ()) => Bool -> f ()+guard True = pure ()+guard False = empty++-- | @'ensure' b x@ is @x@ if @b@ is 'True',+-- and 'empty' if @b@ is 'False'.+ensure :: (Alternative f, Suitable f a) => Bool -> f a -> f a+ensure True x = x+ensure False _ = empty++-- | Evaluate each action in the structure from left to right, and+-- and collect the results. For a version that ignores the results+-- see 'sequenceA_'.+sequenceA+ :: (Applicative f, Suitable t a, Suitable f (t a), Traversable t)+ => t (f a) -> f (t a)+sequenceA = traverse id++-- |The 'mapAccumL' function behaves like a combination of 'fmap'+-- and 'foldl'; it applies a function to each element of a structure,+-- passing an accumulating parameter from left to right, and returning+-- a final value of this accumulator together with the new structure.+mapAccumL :: (Traversable t, Suitable t c) => (a -> b -> (a, c)) -> a -> t b -> (a, t c)+mapAccumL f s t = swap $ runState (traverse (state . (swap .: flip f)) t) s where+ (.:) = (.).(.)++-- | @'replicateM' n act@ performs the action @n@ times,+-- gathering the results.+replicateM :: (Applicative m, Suitable m [a]) => Int -> m a -> m [a]+{-# INLINEABLE replicateM #-}+{-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-}+{-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-}+replicateM cnt0 f =+ loop cnt0+ where+ loop cnt+ | cnt <= 0 = pure []+ | otherwise = liftA2 (:) f (loop (cnt - 1))++-- | @'void' value@ discards or ignores the result of evaluation, such+-- as the return value of an 'System.IO.IO' action.+--+-- ==== __Examples__+--+-- Replace the contents of a @'Maybe' 'Int'@ with unit:+--+-- >>> void Nothing+-- Nothing+-- >>> void (Just 3)+-- Just ()+--+-- Replace the contents of an @'Either' 'Int' 'Int'@ with unit,+-- resulting in an @'Either' 'Int' '()'@:+--+-- >>> void (Left 8675309)+-- Left 8675309+-- >>> void (Right 8675309)+-- Right ()+--+-- Replace every element of a list with unit:+--+-- >>> void [1,2,3]+-- [(),(),()]+--+-- Replace the second element of a pair with unit:+--+-- >>> void (1,2)+-- (1,())+--+-- Discard the result of an 'System.IO.IO' action:+--+-- >>> traverse print [1,2]+-- 1+-- 2+-- [(),()]+-- >>> void $ traverse print [1,2]+-- 1+-- 2+void :: (Functor f, Suitable f ()) => f a -> f ()+void = (<$) ()++--------------------------------------------------------------------------------+-- syntax+--------------------------------------------------------------------------------++-- | Function to which the @if ... then ... else@ syntax desugars to+ifThenElse :: Bool -> a -> a -> a+ifThenElse True t _ = t+ifThenElse False _ f = f++-- | Called on a failed pattern match in a monadic bind. To be avoided.+fail :: String -> a+fail = error++-- | Sequence two actions, discarding the result of the first. Alias for+-- @('*>')@.+(>>)+ :: (Applicative f, Suitable f b)+ => f a -> f b -> f b+(>>) = (*>)++-- | Alias for 'pure'.+return+ :: (Applicative f, Suitable f a)+ => a -> f a+return = pure++--------------------------------------------------------------------------------+-- instances+--------------------------------------------------------------------------------++instance Functor [] where+ type Suitable [] a = ()+ fmap = map+ (<$) = (Prelude.<$)++instance Applicative [] where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Alternative [] where+ empty = []+ (<|>) = (++)++instance Monad [] where+ (>>=) = (Prelude.>>=)++instance Traversable [] where+ traverse f = foldr (liftA2 (:) . f) (pure [])++instance Functor Maybe where+ type Suitable Maybe a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Maybe where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Alternative Maybe where+ empty = Control.Applicative.empty+ (<|>) = (Control.Applicative.<|>)++instance Monad Maybe where+ (>>=) = (Prelude.>>=)++instance Traversable Maybe where+ traverse _ Nothing = pure Nothing+ traverse f (Just x) = fmap Just (f x)++instance Functor IO where+ type Suitable IO a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative IO where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Alternative IO where+ empty = Control.Applicative.empty+ (<|>) = (Control.Applicative.<|>)++instance Monad IO where+ (>>=) = (Prelude.>>=)++instance Functor Identity where+ type Suitable Identity a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Identity where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monad Identity where+ (>>=) = (Prelude.>>=)++instance Traversable Identity where+ traverse f (Identity x) = fmap Identity (f x)++instance Functor (Either e) where+ type Suitable (Either e) a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative (Either a) where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monad (Either a) where+ (>>=) = (Prelude.>>=)++instance Traversable (Either a) where+ traverse f = either (pure . Left) (fmap Right . f)++instance Functor Set where+ type Suitable Set a = Ord a+ fmap = Set.map+ x <$ xs = if null xs then Set.empty else Set.singleton x++instance Applicative Set where+ pure = Set.singleton+ fs <*> xs = foldMap (`Set.map` xs) fs+ xs *> ys = if null xs then Set.empty else ys+ xs <* ys = if null ys then Set.empty else xs+ liftA = liftAM++instance Monad Set where+ (>>=) = flip foldMap++instance Alternative Set where+ empty = Set.empty+ (<|>) = Set.union++instance Functor (Map a) where+ type Suitable (Map a) b = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Functor ((,) a) where+ type Suitable ((,) a) b = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Monoid a => Applicative ((,) a) where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monoid a => Monad ((,) a) where+ (>>=) = (Prelude.>>=)++instance Traversable ((,) a) where+ traverse f (x,y) = fmap ((,) x) (f y)++instance Functor IntMap where+ type Suitable IntMap a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Functor Seq where+ type Suitable Seq a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Seq where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Alternative Seq where+ empty = Control.Applicative.empty+ (<|>) = (Control.Applicative.<|>)++instance Monad Seq where+ (>>=) = (Prelude.>>=)++instance Functor Tree where+ type Suitable Tree a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Tree where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monad Tree where+ (>>=) = (Prelude.>>=)++instance Functor ((->) a) where+ type Suitable ((->) a) b = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative ((->) a) where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monad ((->) a) where+ (>>=) = (Prelude.>>=)++instance Functor (ContT r m) where+ type Suitable (ContT r m) a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative (ContT r m) where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Monad (ContT r m) where+ (>>=) = (Prelude.>>=)++instance Functor Control.Applicative.ZipList where+ type Suitable Control.Applicative.ZipList a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Control.Applicative.ZipList where+ liftA = liftAP+ (<*>) = (Prelude.<*>)+ (*>) = (Prelude.*>)+ (<*) = (Prelude.<*)+ pure = Prelude.pure++instance Functor m => Functor (Strict.StateT s m) where+ type Suitable (Strict.StateT s m) a = Suitable m (a, s)+ fmap f m = Strict.StateT $ \ s ->+ (\ (!a, !s') -> (f a, s')) <$> Strict.runStateT m s+ {-# INLINE fmap #-}+ x <$ xs = Strict.StateT ((fmap.first) (const x) . Strict.runStateT xs)++instance Monad m =>+ Applicative (Strict.StateT s m) where+ pure a =+ Strict.StateT $+ \(!s) ->+ pure (a, s)+ {-# INLINE pure #-}+ Strict.StateT mf <*> Strict.StateT mx =+ Strict.StateT $+ \s -> do+ (f,s') <- mf s+ (x,s'') <- mx s'+ pure (f x, s'')+ Strict.StateT xs *> Strict.StateT ys =+ Strict.StateT $+ \(!s) -> do+ (_,s') <- xs s+ ys s'+ Strict.StateT xs <* Strict.StateT ys =+ Strict.StateT $+ \(!s) -> do+ (x,s') <- xs s+ (_,s'') <- ys s'+ pure (x,s'')+ liftA = liftAM++instance (Monad m, Alternative m) => Alternative (Strict.StateT s m) where+ empty = Strict.StateT (const empty)+ {-# INLINE empty #-}+ Strict.StateT m <|> Strict.StateT n = Strict.StateT $ \ s -> m s <|> n s+ {-# INLINE (<|>) #-}++instance (Monad m) => Monad (Strict.StateT s m) where+ m >>= k = Strict.StateT $ \ s -> do+ (a, s') <- Strict.runStateT m s+ Strict.runStateT (k a) s'+ {-# INLINE (>>=) #-}++instance Functor m => Functor (StateT s m) where+ type Suitable (StateT s m) a = Suitable m (a, s)+ fmap f m = StateT $ \ s ->+ (\ ~(a, s') -> (f a, s')) <$> runStateT m s+ {-# INLINE fmap #-}+ x <$ StateT xs = StateT ((fmap.first) (const x) . xs)++instance (Monad m) =>+ Applicative (StateT s m) where+ pure a =+ StateT $+ \s ->+ pure (a, s)+ {-# INLINE pure #-}+ StateT mf <*> StateT mx =+ StateT $+ \s -> do+ ~(f,s') <- mf s+ ~(x,s'') <- mx s'+ pure (f x, s'')+ StateT xs *> StateT ys =+ StateT $+ \s -> do+ ~(_,s') <- xs s+ ys s'+ StateT xs <* StateT ys =+ StateT $+ \s -> do+ ~(x,s') <- xs s+ ~(_,s'') <- ys s'+ pure (x,s'')+ liftA = liftAM++instance (Monad m, Alternative m) => Alternative (StateT s m) where+ empty = StateT (const empty)+ {-# INLINE empty #-}+ StateT m <|> StateT n = StateT $ \ s -> m s <|> n s+ {-# INLINE (<|>) #-}++instance (Monad m) => Monad (StateT s m) where+ m >>= k = StateT $ \ s -> do+ ~(a, s') <- runStateT m s+ runStateT (k a) s'+ {-# INLINE (>>=) #-}++instance (Functor m) => Functor (ReaderT r m) where+ type Suitable (ReaderT r m) a = Suitable m a+ fmap f = mapReaderT (fmap f)+ {-# INLINE fmap #-}+ x <$ ReaderT xs = ReaderT (\r -> x <$ xs r)++instance (Applicative m) => Applicative (ReaderT r m) where+ pure = liftReaderT . pure+ {-# INLINE pure #-}+ f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r+ {-# INLINE (<*>) #-}+ liftA f ys = ReaderT $ \r -> liftA f (tr r ys) where+ tr :: Functor m => r -> AppVect (ReaderT r m) xs -> AppVect m xs+ tr _ NilA = NilA+ tr r (xs :* NilA) = runReaderT xs r :* NilA+ tr r (x :* xs) = runReaderT x r :* tr r xs+ ReaderT xs *> ReaderT ys = ReaderT (\c -> xs c *> ys c)+ ReaderT xs <* ReaderT ys = ReaderT (\c -> xs c <* ys c)++instance (Alternative m) => Alternative (ReaderT r m) where+ empty = liftReaderT empty+ {-# INLINE empty #-}+ m <|> n = ReaderT $ \ r -> runReaderT m r <|> runReaderT n r+ {-# INLINE (<|>) #-}++instance (Monad m) => Monad (ReaderT r m) where+ m >>= k = ReaderT $ \ r -> do+ a <- runReaderT m r+ runReaderT (k a) r+ {-# INLINE (>>=) #-}++liftReaderT :: m a -> ReaderT r m a+liftReaderT m = ReaderT (const m)+{-# INLINE liftReaderT #-}++instance Functor m => Functor (MaybeT m) where+ type Suitable (MaybeT m) a = (Suitable m (Maybe a), Suitable m a)+ fmap f (MaybeT xs) = MaybeT ((fmap.fmap) f xs)+ x <$ MaybeT xs = MaybeT (fmap (x<$) xs)++instance Monad m => Applicative (MaybeT m) where+ pure x = MaybeT (pure (Just x))+ MaybeT fs <*> MaybeT xs = MaybeT (liftA2 (<*>) fs xs)+ liftA = liftAM+ MaybeT xs *> MaybeT ys = MaybeT (xs *> ys)+ MaybeT xs <* MaybeT ys = MaybeT (xs <* ys)++instance Monad m => Monad (MaybeT m) where+ MaybeT x >>= f = MaybeT (x >>= maybe (pure Nothing) (runMaybeT . f))++instance Monad m =>+ Alternative (MaybeT m) where+ empty = MaybeT (pure Nothing)+ MaybeT x <|> MaybeT y = MaybeT (x >>= maybe y (pure . Just))++instance Functor m =>+ Functor (ExceptT e m) where+ type Suitable (ExceptT e m) a = Suitable m (Either e a)+ fmap f (ExceptT xs) = ExceptT ((fmap . fmap) f xs)+ x <$ ExceptT xs = ExceptT (fmap (x <$) xs)++instance Monad m =>+ Applicative (ExceptT e m) where+ pure x = ExceptT (pure (Right x))+ ExceptT fs <*> ExceptT xs = ExceptT (liftA2 (<*>) fs xs)+ liftA = liftAM+ ExceptT xs *> ExceptT ys = ExceptT (xs *> ys)+ ExceptT xs <* ExceptT ys = ExceptT (xs <* ys)++instance Monad m => Monad (ExceptT e m) where+ ExceptT xs >>= f = ExceptT (xs >>= either (pure . Left) (runExceptT . f))++instance (Monad m, Monoid e) => Alternative (ExceptT e m) where+ empty = ExceptT (pure (Left mempty))+ ExceptT xs <|> ExceptT ys = ExceptT (xs >>= either (const ys) (pure . Right))++instance Functor m =>+ Functor (IdentityT m) where+ type Suitable (IdentityT m) a = Suitable m a+ fmap =+ (coerce :: ((a -> b) -> f a -> f b) -> (a -> b) -> IdentityT f a -> IdentityT f b)+ fmap+ (<$) =+ (coerce :: (a -> f b -> f a) -> a -> IdentityT f b -> IdentityT f a)+ (<$)++instance Applicative m =>+ Applicative (IdentityT m) where+ pure = (coerce :: (a -> f a) -> a -> IdentityT f a) pure+ (<*>) =+ (coerce :: (f (a -> b) -> f a -> f b) -> IdentityT f (a -> b) -> IdentityT f a -> IdentityT f b)+ (<*>)+ liftA f =+ (coerce :: (AppVect f xs -> f b) -> (AppVect (IdentityT f) xs -> IdentityT f b))+ (liftA f)+ IdentityT xs *> IdentityT ys = IdentityT (xs *> ys)+ IdentityT xs <* IdentityT ys = IdentityT (xs <* ys)++instance Monad m =>+ Monad (IdentityT m) where+ (>>=) =+ (coerce :: (f a -> (a -> f b) -> f b) -> IdentityT f a -> (a -> IdentityT f b) -> IdentityT f b)+ (>>=)
+ src/Control/Monad/Constrained/Cont.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE RebindableSyntax #-}++-- | This module is a duplication of the Control.Monad.Cont module, from the\+-- mtl.+module Control.Monad.Constrained.Cont+ (MonadCont(..)+ ,ContT(..)+ ,cont+ ,mapContT+ ,withContT+ ,runCont+ ,mapCont+ ,withCont)where++import Control.Monad.Constrained++import qualified Control.Monad.Trans.Cont as Cont+import Control.Monad.Trans.Cont hiding (callCC)++import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.Except as Except++-- | A class for monads which can embed continuations.+class Monad m => MonadCont m where+ {- | @callCC@ (call-with-current-continuation)+ calls a function with the current continuation as its argument.+ Provides an escape continuation mechanism for use with Continuation monads.+ Escape continuations allow to abort the current computation and return+ a value immediately.+ They achieve a similar effect to 'Control.Monad.Error.throwError'+ and 'Control.Monad.Error.catchError'+ within an 'Control.Monad.Error.Error' monad.+ Advantage of this function over calling @return@ is that it makes+ the continuation explicit,+ allowing more flexibility and better control+ (see examples in "Control.Monad.Cont").++ The standard idiom used with @callCC@ is to provide a lambda-expression+ to name the continuation. Then calling the named continuation anywhere+ within its scope will escape from the computation,+ even if it is many layers deep within nested computations.+ -}+ callCC :: ((a -> m b) -> m a) -> m a++instance MonadCont (ContT r m) where+ callCC = Cont.callCC++instance MonadCont m => MonadCont (Maybe.MaybeT m) where+ callCC = Maybe.liftCallCC callCC++instance MonadCont m => MonadCont (Reader.ReaderT r m) where+ callCC = Reader.liftCallCC callCC++instance MonadCont m => MonadCont (State.Lazy.StateT s m) where+ callCC = State.Lazy.liftCallCC callCC++instance MonadCont m => MonadCont (State.Strict.StateT s m) where+ callCC = State.Strict.liftCallCC callCC++instance MonadCont m => MonadCont (Identity.IdentityT m) where+ callCC = Identity.liftCallCC callCC++instance MonadCont m => MonadCont (Except.ExceptT e m) where+ callCC = Except.liftCallCC callCC
+ src/Control/Monad/Constrained/Error.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module is a duplication of the Control.Monad.Error module from the+-- mtl, for constrained monads.+module Control.Monad.Constrained.Error+ (MonadError(..)+ ,ExceptT(..)+ ,Except)+ where++import GHC.Exts++import Control.Monad.Constrained+import Control.Monad.Constrained.Trans++import Control.Monad.Trans.Except hiding (catchE)++import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict++-- | A class for monads which can error out.+class Monad m =>+ MonadError e m | m -> e where+ type SuitableError m a :: Constraint+ -- | Raise an error.+ throwError :: SuitableError m a => e -> m a+ {- |+ A handler function to handle previous errors and return to normal execution.+ A common idiom is:++ > do { action1; action2; action3 } `catchError` handler++ where the @action@ functions can call 'throwError'.+ Note that @handler@ and the do-block must have the same return type.+ -}+ catchError :: SuitableError m a => m a -> (e -> m a) -> m a++instance MonadError e (Either e) where+ type SuitableError (Either e) a = ()+ throwError = Left+ catchError (Left x) f = f x+ catchError r _ = r++instance Monad m => MonadError e (ExceptT e m) where+ type SuitableError (ExceptT e m) a = Suitable m (Either e a)+ throwError = ExceptT . pure . Left+ catchError = catchE++catchE+ :: (Monad m, Suitable m (Either e' a))+ => ExceptT e m a+ -> (e -> ExceptT e' m a)+ -> ExceptT e' m a+catchE m h =+ ExceptT $+ do a <- runExceptT m+ case a of+ Left l -> runExceptT (h l)+ Right r -> return (Right r)+{-# INLINE catchE #-}++instance MonadError e m => MonadError e (Identity.IdentityT m) where+ type SuitableError (Identity.IdentityT m) a = SuitableError m a+ throwError = lift . throwError+ catchError = Identity.liftCatch catchError++instance MonadError e m =>+ MonadError e (Maybe.MaybeT m) where+ type SuitableError (Maybe.MaybeT m) a+ = (SuitableError m a+ ,SuitableError m (Maybe a)+ ,Suitable m (Maybe a))+ throwError = lift . throwError+ catchError = Maybe.liftCatch catchError++instance MonadError e m =>+ MonadError e (Reader.ReaderT r m) where+ type SuitableError (Reader.ReaderT r m) a = SuitableError m a+ throwError = lift . throwError+ catchError = Reader.liftCatch catchError++instance MonadError e m => MonadError e (State.Lazy.StateT s m) where+ type SuitableError (State.Lazy.StateT s m) a+ = (Suitable m (a,s), SuitableError m (a,s), SuitableError m a)+ throwError = lift . throwError+ catchError = State.Lazy.liftCatch catchError++instance MonadError e m => MonadError e (State.Strict.StateT s m) where+ type SuitableError (State.Strict.StateT s m) a+ = (Suitable m (a,s), SuitableError m (a,s), SuitableError m a)+ throwError = lift . throwError+ catchError = State.Strict.liftCatch catchError
+ src/Control/Monad/Constrained/IO.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module is a duplication of the "Control.Monad.IO.Class" module, for+-- constrained monads.+module Control.Monad.Constrained.IO+ (MonadIO(..))+ where++import Control.Monad.Constrained+import Control.Monad.Constrained.Trans++import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Cont+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State.Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy++import GHC.Exts++-- | A class for monads which can have IO actions lifted into them.+class Monad m =>+ MonadIO m where+ type SuitableIO m a :: Constraint+ liftIO :: SuitableIO m a => IO a -> m a++instance MonadIO IO where+ type SuitableIO IO a = ()+ liftIO = id++instance MonadIO m =>+ MonadIO (IdentityT m) where+ type SuitableIO (IdentityT m) a = SuitableIO m a+ liftIO = lift . liftIO++instance MonadIO m =>+ MonadIO (MaybeT m) where+ type SuitableIO (MaybeT m) a = (Suitable m (Maybe a), SuitableIO m a)+ liftIO = lift . liftIO++instance MonadIO m =>+ MonadIO (ContT r m) where+ type SuitableIO (ContT r m) a = (Suitable m r, SuitableIO m a)+ liftIO = lift . liftIO++instance MonadIO m =>+ MonadIO (ReaderT r m) where+ type SuitableIO (ReaderT r m) a = SuitableIO m a+ liftIO = lift . liftIO++instance MonadIO m =>+ MonadIO (StateT s m) where+ type SuitableIO (StateT s m) a = (SuitableIO m a, Suitable m (a, s))+ liftIO = lift . liftIO++instance MonadIO m =>+ MonadIO (Lazy.StateT s m) where+ type SuitableIO (Lazy.StateT s m) a = (SuitableIO m a, Suitable m (a, s))+ liftIO = lift . liftIO
+ src/Control/Monad/Constrained/IntSet.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}++-- | This module creates an 'IntSet' type with a phantom type variable, allowing+-- it to conform to 'Functor', 'Foldable', etc. Other than that, it's a+-- duplication of the "Data.IntSet" module.+module Control.Monad.Constrained.IntSet+ (IntSet+ ,(\\)+ ,lookupLT+ ,lookupLE+ ,lookupGT+ ,lookupGE+ ,insert+ ,delete+ ,difference+ ,intersection+ ,filter+ ,partition+ ,split+ ,maxView+ ,minView)+ where++import Control.Monad.Constrained hiding (filter)++import qualified Data.IntSet as IntSet++import Data.Foldable (Foldable (..))+import Data.Functor.Classes+import Data.Semigroup++import Control.Arrow (first)+import GHC.Exts++-- | This type is a wrapper around 'Data.IntSet.IntSet', with a phantom type+-- variable which must always be 'Int'. This allows it to conform to 'Functor',+-- 'Foldable', 'Applicative', 'Monad', etc.+data IntSet a where+ IntSet :: IntSet.IntSet -> IntSet Int++instance Foldable IntSet where+ foldr f b (IntSet xs) = IntSet.foldr f b xs+ foldl f b (IntSet xs) = IntSet.foldl f b xs+ foldr' f b (IntSet xs) = IntSet.foldr' f b xs+ foldl' f b (IntSet xs) = IntSet.foldl' f b xs+ null (IntSet xs) = IntSet.null xs+ length (IntSet xs) = IntSet.size xs+ minimum (IntSet xs) = IntSet.findMin xs+ maximum (IntSet xs) = IntSet.findMax xs+ elem x (IntSet xs) = IntSet.member x xs++instance Functor IntSet where+ type Suitable IntSet a = a ~ Int+ fmap f (IntSet xs) = IntSet (IntSet.map f xs)+ x <$ IntSet xs =+ IntSet+ (if IntSet.null xs+ then IntSet.empty+ else IntSet.singleton x)++instance Semigroup (IntSet a) where+ IntSet xs <> IntSet ys = IntSet (IntSet.union xs ys)++instance a ~ Int => Monoid (IntSet a) where+ mempty = IntSet IntSet.empty+ mappend = (<>)++instance Applicative IntSet where+ pure x = IntSet (IntSet.singleton x)+ xs *> ys =+ if null xs+ then mempty+ else ys+ xs <* ys =+ if null ys+ then mempty+ else xs+ liftA = liftAM++instance Alternative IntSet where+ empty = mempty+ (<|>) = mappend++instance Monad IntSet where+ (>>=) = flip foldMap++instance a ~ Int => IsList (IntSet a) where+ type Item (IntSet a) = a+ fromList = IntSet . IntSet.fromList+ toList = foldr (:) []++infixl 9 \\+-- | /O(n+m)/. See 'difference'.+(\\) :: IntSet a -> IntSet a -> IntSet a+IntSet xs \\ IntSet ys = IntSet (xs IntSet.\\ ys)++-- | /O(log n)/. Find largest element smaller than the given one.+--+-- > lookupLT 3 (fromList [3, 5]) == Nothing+-- > lookupLT 5 (fromList [3, 5]) == Just 3+lookupLT :: a -> IntSet a -> Maybe a+lookupLT x (IntSet xs) = IntSet.lookupLT x xs++-- | /O(log n)/. Find smallest element greater than the given one.+--+-- > lookupGT 4 (fromList [3, 5]) == Just 5+-- > lookupGT 5 (fromList [3, 5]) == Nothing+lookupGT :: a -> IntSet a -> Maybe a+lookupGT x (IntSet xs) = IntSet.lookupGT x xs++-- | /O(log n)/. Find largest element smaller or equal to the given one.+--+-- > lookupLE 2 (fromList [3, 5]) == Nothing+-- > lookupLE 4 (fromList [3, 5]) == Just 3+-- > lookupLE 5 (fromList [3, 5]) == Just 5+lookupLE :: a -> IntSet a -> Maybe a+lookupLE x (IntSet xs) = IntSet.lookupLE x xs++-- | /O(log n)/. Find smallest element greater or equal to the given one.+--+-- > lookupGE 3 (fromList [3, 5]) == Just 3+-- > lookupGE 4 (fromList [3, 5]) == Just 5+-- > lookupGE 6 (fromList [3, 5]) == Nothing+lookupGE :: a -> IntSet a -> Maybe a+lookupGE x (IntSet xs) = IntSet.lookupGE x xs++-- | /O(min(n,W))/. Add a value to the set. There is no left- or right bias for+-- IntSets.+insert :: a -> IntSet a -> IntSet a+insert x (IntSet xs) = IntSet (IntSet.insert x xs)++-- | /O(min(n,W))/. Delete a value in the set. Returns the+-- original set when the value was not present.+delete :: a -> IntSet a -> IntSet a+delete x (IntSet xs) = IntSet (IntSet.delete x xs)++-- | /O(n+m)/. Difference between two sets.+difference :: IntSet a -> IntSet a -> IntSet a+difference (IntSet xs) (IntSet ys) = IntSet (IntSet.difference xs ys)++-- | /O(n+m)/. The intersection of two sets.+intersection :: IntSet a -> IntSet a -> IntSet a+intersection (IntSet xs) (IntSet ys) = IntSet (IntSet.intersection xs ys)++-- | /O(n)/. Filter all elements that satisfy some predicate.+filter :: (a -> Bool) -> IntSet a -> IntSet a+filter p (IntSet xs) = IntSet (IntSet.filter p xs)++-- | /O(n)/. partition the set according to some predicate.+partition :: (a -> Bool) -> IntSet a -> (IntSet a, IntSet a)+partition p (IntSet xs) =+ let (ys,zs) = IntSet.partition p xs+ in (IntSet ys, IntSet zs)++-- | /O(min(n,W))/. The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+--+-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])+split :: a -> IntSet a -> (IntSet a, IntSet a)+split x (IntSet xs) =+ let (ys,zs) = IntSet.split x xs+ in (IntSet ys, IntSet zs)++-- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+maxView :: IntSet a -> Maybe (a, IntSet a)+maxView (IntSet xs) = (fmap.fmap) IntSet (IntSet.maxView xs)++-- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+minView :: IntSet a -> Maybe (a, IntSet a)+minView (IntSet xs) = (fmap.fmap) IntSet (IntSet.minView xs)++instance Show1 IntSet where+ liftShowsPrec _ _ d (IntSet xs) = showsPrec d xs++instance Show a =>+ Show (IntSet a) where+ showsPrec = showsPrec1++instance a ~ Int =>+ Read (IntSet a) where+ readsPrec n = (fmap . first) IntSet . readsPrec n++instance Eq1 IntSet where+ liftEq _ (IntSet xs) (IntSet ys) = xs == ys++instance Eq a =>+ Eq (IntSet a) where+ (==) = eq1++instance Ord1 IntSet where+ liftCompare _ (IntSet xs) (IntSet ys) = compare xs ys++instance Ord a =>+ Ord (IntSet a) where+ compare = compare1
+ src/Control/Monad/Constrained/Reader.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}++-- | This module duplicates the Control.Monad.Reader module from the mtl, for+-- constrained monads.+module Control.Monad.Constrained.Reader+ (MonadReader(..)+ ,ReaderT(..)+ ,Reader+ )where++import GHC.Exts++import Control.Monad.Constrained+import Control.Monad.Constrained.Trans++import Control.Monad.Trans.Reader hiding (reader, ask, local)++import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict+import qualified Control.Monad.Trans.Cont as Cont+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.Except as Except++-- | A class for reader monads.+class Monad m =>+ MonadReader r m | m -> r where+ type ReaderSuitable m a :: Constraint+ {-# MINIMAL reader , local #-}+ -- | Retrieves the environment+ ask+ :: (ReaderSuitable m r)+ => m r+ ask = reader id+ -- | Executes a computation in a modified environment.+ local+ :: (ReaderSuitable m a, ReaderSuitable m r)+ => (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+ :: (ReaderSuitable m r, ReaderSuitable m a)+ => (r -> a) -- ^ The selector function to apply to the environment.+ -> m a++instance MonadReader r ((->) r) where+ type ReaderSuitable ((->) r) a = ()+ ask = id+ local f m = m . f+ reader = id++instance Monad m => MonadReader r (ReaderT r m) where+ type ReaderSuitable (ReaderT r m) a = Suitable m a+ ask = ReaderT pure+ local = local+ reader f = ReaderT (pure . f)++instance MonadReader r' m =>+ MonadReader r' (Cont.ContT r m) where+ type ReaderSuitable (Cont.ContT r m) a+ = (ReaderSuitable m a, Suitable m r, ReaderSuitable m r)+ ask = lift ask+ local = liftLocal ask local+ reader = lift . reader++liftLocal+ :: (Monad m, Suitable m r)+ => m r'+ -> ((r' -> r') -> m r -> m r)+ -> (r' -> r')+ -> Cont.ContT r m a+ -> Cont.ContT r m a+liftLocal ask' local' f m =+ Cont.ContT $+ \c -> do+ r <- ask'+ local' f (Cont.runContT m (local' (const r) . c))++instance MonadReader r m => MonadReader r (Except.ExceptT e m) where+ type ReaderSuitable (Except.ExceptT e m) a+ = (ReaderSuitable m a+ ,Suitable m (Either e a)+ ,ReaderSuitable m (Either e a))+ ask = lift ask+ local = Except.mapExceptT . local+ reader = lift . reader++instance MonadReader r m => MonadReader r (Identity.IdentityT m) where+ type ReaderSuitable (Identity.IdentityT m) a = ReaderSuitable m a+ ask = lift ask+ local = Identity.mapIdentityT . local+ reader = lift . reader++instance MonadReader r m =>+ MonadReader r (Maybe.MaybeT m) where+ type ReaderSuitable (Maybe.MaybeT m) a+ = (ReaderSuitable m a+ ,ReaderSuitable m (Maybe a)+ ,Suitable m (Maybe a))+ ask = lift ask+ local = Maybe.mapMaybeT . local+ reader = lift . reader++instance MonadReader r m =>+ MonadReader r (State.Lazy.StateT s m) where+ type ReaderSuitable (State.Lazy.StateT s m) a+ = (ReaderSuitable m a+ ,ReaderSuitable m (a,s)+ ,Suitable m (a,s))+ ask = lift ask+ local = State.Lazy.mapStateT . local+ reader = lift . reader++instance MonadReader r m =>+ MonadReader r (State.Strict.StateT s m) where+ type ReaderSuitable (State.Strict.StateT s m) a+ = (ReaderSuitable m a+ ,ReaderSuitable m (a,s)+ ,Suitable m (a,s))+ ask = lift ask+ local = State.Strict.mapStateT . local+ reader = lift . reader
+ src/Control/Monad/Constrained/State.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module duplicates the Control.Monad.State module from mtl for monads+-- with constraints.+module Control.Monad.Constrained.State+ (MonadState(..)+ ,StateT(..)+ ,gets+ ,modify+ ,modify'+ )where++import GHC.Exts++import Control.Monad.Constrained+import Control.Monad.Constrained.Trans++import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import Control.Monad.Trans.State.Strict hiding (state, get, modify, gets, modify')++import qualified Control.Monad.Trans.Cont as Cont+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.Except as Except++-- | A class for monads with state.+class Monad m =>+ MonadState s m | m -> s where+ {-# MINIMAL state #-}+ type StateSuitable m a :: Constraint+ -- | Return the state from the internals of the monad.+ get+ :: (StateSuitable m s)+ => m s+ get =+ state+ (\s ->+ (s, s))+ -- | Replace the state inside the monad.+ put+ :: (StateSuitable m (), StateSuitable m s)+ => s -> m ()+ put s = state (const ((), s))+ -- | Embed a simple state action in the monad.+ state+ :: (StateSuitable m a, StateSuitable m s)+ => (s -> (a, s)) -> m a++-- | Get the state, while applying a transformation function.+gets+ :: (StateSuitable m s, MonadState s m, Suitable m b)+ => (s -> b) -> m b+gets f = fmap f get++-- | Modify the state.+modify+ :: (StateSuitable m (), StateSuitable m s, MonadState s m)+ => (s -> s) -> m ()+modify f =+ state+ (\s ->+ ((), f s))++-- | Modify the state, strictly in the new state.+modify'+ :: (StateSuitable m (), StateSuitable m s, MonadState s m)+ => (s -> s) -> m ()+modify' f =+ state+ (\s ->+ let s' = f s+ in s' `seq` ((), s'))++instance Monad m => MonadState s (StateT s m) where+ type StateSuitable (StateT s m) a = Suitable m (a, s)+ state f = StateT (pure . f)++instance Monad m => MonadState s (State.Lazy.StateT s m) where+ type StateSuitable (State.Lazy.StateT s m) a = Suitable m (a, s)+ state f = State.Lazy.StateT (pure . f)++instance (MonadState s m, Suitable m r) => MonadState s (Cont.ContT r m) where+ type StateSuitable (Cont.ContT r m) a = StateSuitable m a+ state = lift . state++instance MonadState s m =>+ MonadState s (Maybe.MaybeT m) where+ type StateSuitable (Maybe.MaybeT m) a+ = (Suitable m (Maybe a), StateSuitable m a)+ state = lift . state++instance MonadState s m =>+ MonadState s (Identity.IdentityT m) where+ type StateSuitable (Identity.IdentityT m) a = StateSuitable m a+ state = lift . state++instance MonadState s m =>+ MonadState s (Reader.ReaderT r m) where+ type StateSuitable (Reader.ReaderT r m) a = StateSuitable m a+ state = lift . state++instance MonadState s m =>+ MonadState s (Except.ExceptT e m) where+ type StateSuitable (Except.ExceptT e m) a+ = (Suitable m (Either e a), StateSuitable m a)+ state = lift . state
+ src/Control/Monad/Constrained/Trans.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module duplicates the "Control.Monad.Trans.Class" module for+-- constrained monads.+module Control.Monad.Constrained.Trans+ (MonadTrans(..))+ where++import Control.Monad.Constrained++import Control.Monad.Trans.Cont (ContT (..))+import Control.Monad.Trans.Except (ExceptT (..))+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.Maybe (MaybeT (..))+import Control.Monad.Trans.Reader (ReaderT (..))+import Control.Monad.Trans.State.Lazy as Lazy (StateT (..))+import Control.Monad.Trans.State.Strict as Strict (StateT (..))++import GHC.Exts++-- | A class for monad transformers with constraints. See+-- "Control.Monad.Trans.Class" for full documentation on the class without+-- constraints.+class MonadTrans t where+ -- | A type for monads that are liftable into the outer monad. For instance,+ -- since 'StateT' is defined like so:+ --+ -- @newtype 'StateT' s m a = 'StateT' { 'runStateT' :: s -> m (a, s) }@+ --+ -- the underlying monad needs not to be able to hold @a@, but @(a, s)@.+ type SuitableLift (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *) :: Constraint+ -- | Lift a monad into an outer monad.+ lift+ :: (Monad m, SuitableLift t m a)+ => m a -> t m a++instance MonadTrans (ContT r) where+ type SuitableLift (ContT r) m a = Suitable m r+ lift m = ContT (m >>=)+ {-# INLINE lift #-}++instance MonadTrans (ReaderT r) where+ type SuitableLift (ReaderT r) m a = ()+ lift m = ReaderT (const m)+ {-# INLINE lift #-}++instance MonadTrans (Strict.StateT r) where+ type SuitableLift (Strict.StateT r) m a = Suitable m (a,r)+ lift m = Strict.StateT (\s -> fmap (flip (,) s) m)+ {-# INLINE lift #-}++instance MonadTrans (Lazy.StateT r) where+ type SuitableLift (Lazy.StateT r) m a = Suitable m (a,r)+ lift m = Lazy.StateT (\s -> fmap (flip (,) s) m)+ {-# INLINE lift #-}++instance MonadTrans IdentityT where+ type SuitableLift IdentityT m a = ()+ lift = IdentityT+ {-# INLINE lift #-}++instance MonadTrans MaybeT where+ type SuitableLift MaybeT m a = Suitable m (Maybe a)+ lift = MaybeT . fmap Just+ {-# INLINE lift #-}++instance MonadTrans (ExceptT e) where+ type SuitableLift (ExceptT e) m a = Suitable m (Either e a)+ lift = ExceptT . fmap Right+ {-# INLINE lift #-}
+ src/Control/Monad/Constrained/Writer.hs view
@@ -0,0 +1,361 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++-- | This module duplicates the Control.Monad.Writer module from the mtl, for+-- constrained monads. It also provides a non-leaky writer monad.+module Control.Monad.Constrained.Writer+ (MonadWriter(..)+ ,WriterT+ ,pattern WriterT+ ,Writer+ ,runWriterT+ ,execWriterT+ ,execWriter+ ,runWriter+ ,listen+ ,pass+ ,evalWriterT+ ,evalWriter+ )where++import GHC.Exts++import Control.Monad.Constrained+import Control.Monad.Constrained.Trans++import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.Except as Except++import Control.Monad.Constrained.State+import Control.Monad.Constrained.Error+import Control.Monad.Constrained.Reader++import Data.Functor.Identity+import Data.Functor.Classes++-- | A class for monads with logging ability.+class (Monoid w, Monad m) => MonadWriter w m | m -> w where+ type WriterSuitable m a :: Constraint+ -- | Embed a simple writer action.+ writer :: WriterSuitable m a => (a,w) -> m a+ -- | Log some output.+ tell :: WriterSuitable m () => w -> m ()+ -- | This is equivalent to the 'Control.Monad.Trans.Writer.Lazy.listen'+ -- function, except it is church encoded, to make the constraints a little+ -- easier to manage.+ listenC :: WriterSuitable m b => (a -> w -> b) -> m a -> m b+ -- | This is equivalent to the 'Control.Monad.Trans.Writer.Lazy.pass'+ -- function, except it is church encoded, to make the constraints a little+ -- easier to manage.+ passC :: WriterSuitable m a => (a -> w -> w) -> m a -> m a++instance MonadWriter w m =>+ MonadWriter w (Except.ExceptT e m) where+ type WriterSuitable (Except.ExceptT e m) a+ = (WriterSuitable m a+ ,WriterSuitable m (Either e a)+ ,Suitable m (Either e a))+ writer = lift . writer+ tell = lift . tell+ listenC f = (Except.mapExceptT . listenC . flip) (fmap . flip f)+ passC = Except.mapExceptT . passC . either (const id)++-- | @'listen' m@ is an action that executes the action @m@ and adds+-- its output to the value of the computation.+listen+ :: (MonadWriter w m, WriterSuitable m (a, w))+ => m a -> m (a, w)+listen = listenC (,)++-- | @'pass' m@ is an action that executes the action @m@, which+-- returns a value and a function, and returns the value, applying+-- the function to the output.+pass+ :: (MonadWriter w m, Suitable m a, WriterSuitable m (a, w -> w))+ => m (a, w -> w) -> m a+pass = fmap fst . passC snd++instance MonadWriter w m =>+ MonadWriter w (State.Lazy.StateT s m) where+ type WriterSuitable (State.Lazy.StateT s m) a+ = (WriterSuitable m a+ ,WriterSuitable m (a, s)+ ,Suitable m (a, s))+ writer = lift . writer+ tell = lift . tell+ listenC f m =+ State.Lazy.StateT+ (listenC+ (\ ~(a,s') w ->+ (f a w, s')) .+ State.Lazy.runStateT m)+ passC c m = State.Lazy.StateT (passC (c . fst) . State.Lazy.runStateT m)++instance MonadWriter w m =>+ MonadWriter w (State.Strict.StateT s m) where+ type WriterSuitable (State.Strict.StateT s m) a+ = (WriterSuitable m a+ ,WriterSuitable m (a, s)+ ,Suitable m (a, s))+ writer = lift . writer+ tell = lift . tell+ listenC f m =+ State.Strict.StateT+ (listenC+ (\ (a,s') w ->+ (f a w, s')) .+ State.Strict.runStateT m)+ passC c m = State.Strict.StateT (passC (c . fst) . State.Strict.runStateT m)++instance MonadWriter w m =>+ MonadWriter w (Identity.IdentityT m) where+ type WriterSuitable (Identity.IdentityT m) a = WriterSuitable m a+ writer = lift . writer+ tell = lift . tell+ listenC f = Identity.mapIdentityT (listenC f)+ passC f = Identity.mapIdentityT (passC f)++instance MonadWriter w m => MonadWriter w (Maybe.MaybeT m) where+ type WriterSuitable (Maybe.MaybeT m) a+ = (WriterSuitable m a+ ,WriterSuitable m (Maybe a)+ ,Suitable m (Maybe a))+ writer = lift . writer+ tell = lift . tell+ listenC f = (Maybe.mapMaybeT . listenC . flip) (fmap . flip f)+ passC = Maybe.mapMaybeT . passC . maybe id++instance MonadWriter w m => MonadWriter w (Reader.ReaderT r m) where+ type WriterSuitable (Reader.ReaderT r m) a = WriterSuitable m a+ writer = lift . writer+ tell = lift . tell+ listenC f = Reader.mapReaderT (listenC f)+ passC f = Reader.mapReaderT (passC f)++-- | A monad transformer similar to 'Control.Monad.Writer.Strict.WriterT', except+-- that it does not leak space. It is implemented using a state monad, so that+-- `mappend` is tail recursive. See+-- <https://mail.haskell.org/pipermail/libraries/2013-March/019528.html this>+-- email to the Haskell libraries committee for more information.+--+-- Wherever possible, coercions are used to eliminate any overhead from the+-- newtype wrapper.+newtype WriterT s m a =+ WriterT_ { unWriterT :: State.Strict.StateT s m a }++instance Functor m => Functor (WriterT s m) where+ type Suitable (WriterT s m) a = Suitable m (a,s)+ fmap f (WriterT_ x) = WriterT_ (fmap f x)+ x <$ WriterT_ xs = WriterT_ (x <$ xs)++instance Monad m =>+ Applicative (WriterT s m) where+ pure x = WriterT_ (pure x)+ WriterT_ fs <*> WriterT_ xs = WriterT_ (fs <*> xs)+ WriterT_ xs *> WriterT_ ys = WriterT_ (xs *> ys)+ WriterT_ xs <* WriterT_ ys = WriterT_ (xs <* ys)+ liftA = liftAM++instance Monad m => Monad (WriterT s m) where+ WriterT_ xs >>= f = WriterT_ (xs >>= (unWriterT . f))++-- first_ :: (Functor f, Suitable f (b, c)) => (a -> f b) -> (a, c) -> f (b, c)+-- first_ f (x,y) = fmap (flip (,) y) (f x)++-- | Run a writer computation in the underlying monad.+runWriterT+ :: Monoid s+ => WriterT s m a -> m (a, s)+runWriterT =+ (coerce :: (State.Strict.StateT s m a -> m (a, s)) -> WriterT s m a -> m (a, s))+ (`State.Strict.runStateT` mempty)++-- | This pattern gives the newtype wrapper around 'StateT' the same interface+-- as 'Control.Monad.Writer.Strict.WriterT'. Unfortunately, GHC currently warns+-- that a function is incomplete wherever this pattern is used. This issue+-- should be solved in a future version of GHC, when the+-- <https://ghc.haskell.org/trac/ghc/ticket/8779 COMPLETE> pragma is+-- implemented.+pattern WriterT :: (Functor m, Monoid s, Suitable m (a, s)) =>+ m (a, s) -> WriterT s m a++pattern WriterT x <- (runWriterT -> x)+ where WriterT y+ = WriterT_ (State.Strict.StateT (\ s -> (fmap.fmap) (mappend s) y))++-- | A type synonym for the plain (non-transformer) version of 'WriterT'. This+-- can be used as if it were defined as:+--+-- > newtype Writer w a = Writer { runWriter :: (a, w) }+type Writer s = WriterT s Identity++-- | Run a writer computation.+--+-- >>> runWriter $ traverse (\x -> writer (show x, [x])) [1..5]+-- (["1","2","3","4","5"],[1,2,3,4,5])+runWriter+ :: Monoid s+ => Writer s a -> (a, s)+runWriter =+ (coerce+ :: (WriterT s Identity a -> Identity (a, s))+ -> (WriterT s Identity a -> (a, s))+ ) runWriterT++{-# INLINE runWriter #-}++instance (Monoid s, Monad m) =>+ MonadWriter s (WriterT s m) where+ type WriterSuitable (WriterT s m) a = Suitable m (a, s)+ tell s = WriterT (pure ((), s))+ writer (x,s) = WriterT (pure (x, s))+ {-# INLINE writer #-}+ listenC f (WriterT_ xs) =+ WriterT_+ (State.Strict.StateT+ (fmap+ (\(x,s') ->+ (f x s', s')) .+ State.Strict.runStateT xs))+ {-# INLINE listenC #-}+ passC f (WriterT_ xs) =+ WriterT_+ (State.Strict.StateT+ (fmap+ (\(x,s') ->+ (x, f x s')) . State.Strict.runStateT xs))+ {-# INLINE passC #-}++instance MonadTrans (WriterT w) where+ type SuitableLift (WriterT w) m a = Suitable m (a, w)+ lift xs = WriterT_ . State.Strict.StateT $ (\s -> fmap (flip (,) s) xs)++instance MonadState s m =>+ MonadState s (WriterT w m) where+ type StateSuitable (WriterT w m) a = (StateSuitable m a, Suitable m (a, w))+ get = lift get+ put = lift . put+ state = lift . state++instance MonadError e m =>+ MonadError e (WriterT w m) where+ type SuitableError (WriterT w m) a = SuitableError m (a, w)+ throwError e = WriterT_ . State.Strict.StateT $ const (throwError e)+ catchError (WriterT_ xs) f =+ WriterT_ (State.Strict.liftCatch catchError xs (unWriterT . f))++instance MonadReader r m =>+ MonadReader r (WriterT w m) where+ type ReaderSuitable (WriterT w m) a+ = (ReaderSuitable m a+ ,Suitable m (a, w)+ ,ReaderSuitable m (a, w))+ ask = WriterT_ ask+ reader x = WriterT_ (reader x)+ local f (WriterT_ xs) = WriterT_ (local f xs)++-- | Run a writer computation in the underlying monad, and return its result.+evalWriterT+ :: (Monad m, Monoid s, Suitable m a)+ => WriterT s m a -> m a+evalWriterT = fmap fst . runWriterT++{-# INLINE evalWriterT #-}++-- | Run a writer computation in the underlying monad, and collect its output.+execWriterT+ :: (Monad m, Monoid s, Suitable m s)+ => WriterT s m a -> m s+execWriterT = fmap snd . runWriterT++{-# INLINE execWriterT #-}++-- | Run a writer computation, and return its result.+evalWriter+ :: Monoid s+ => Writer s a -> a+evalWriter = fst . runWriter++{-# INLINE evalWriter #-}++-- | Run a writer computation, and collect its output.+execWriter+ :: Monoid s+ => Writer s a -> s+execWriter = snd . runWriter++{-# INLINE execWriter #-}++instance (Foldable m, Monoid w) =>+ Foldable (WriterT w m) where+ foldMap f =+ foldMap+ (\(x,_) ->+ f x) .+ runWriterT++-- instance (Traversable m, Monoid w) =>+-- Traversable (WriterT w m) where+-- traverse f x = WriterT <$> (traverse . first_) f (runWriterT x)++instance (Eq1 m, Eq w, Monoid w) =>+ Eq1 (WriterT w m) where+ liftEq eq x y =+ liftEq+ (\(xx,xy) (yx,yy) ->+ eq xx yx && xy == yy)+ (runWriterT x)+ (runWriterT y)++instance (Ord1 m, Ord w, Monoid w) =>+ Ord1 (WriterT w m) where+ liftCompare cmp x y =+ liftCompare+ (\(xx,xy) (yx,yy) ->+ cmp xx yx `mappend` compare xy yy)+ (runWriterT x)+ (runWriterT y)++-- instance (Read w, Read1 m, Monoid w, Functor m) =>+-- Read1 (WriterT w m) where+-- liftReadsPrec rp rl =+-- readsData $ readsUnaryWith (liftReadsPrec rp' rl') "WriterT" WriterT_+-- where+-- rp' = liftReadsPrec2 rp rl readsPrec readList+-- rl' = liftReadList2 rp rl readsPrec readList++instance (Show w, Show1 m, Monoid w) =>+ Show1 (WriterT w m) where+ liftShowsPrec sp sl d m =+ showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d (runWriterT m)+ where+ sp' = liftShowsPrec2 sp sl showsPrec showList+ sl' = liftShowList2 sp sl showsPrec showList++instance (Eq w, Eq1 m, Eq a, Monoid w) =>+ Eq (WriterT w m a) where+ (==) = eq1++instance (Ord w, Ord1 m, Ord a, Monoid w) =>+ Ord (WriterT w m a) where+ compare = compare1++-- instance (Read w, Read1 m, Read a, Monoid w, Functor m) =>+-- Read (WriterT w m a) where+-- readsPrec = readsPrec1++instance (Show w, Show1 m, Show a, Monoid w) =>+ Show (WriterT w m a) where+ showsPrec = showsPrec1
+ test/Spec.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Control.Monad.Constrained+import qualified Prelude++import Test.DocTest+import Test.QuickCheck++import Data.Proxy++import qualified Control.Applicative++import Data.Set (Set)+import Control.Monad.Constrained.IntSet (IntSet)++import GHC.Exts (fromList)+import Data.Functor.Classes++import Control.Monad.Trans.Reader (ReaderT(..), Reader)+import Control.Monad.Trans.State.Strict (StateT(..), State)+import Data.Functor.Identity++instance Functor Gen where+ type Suitable Gen a = ()+ fmap = Prelude.fmap+ (<$) = (Prelude.<$)++instance Applicative Gen where+ liftA = liftAP++instance Monad Gen where+ (>>=) = (Prelude.>>=)++instance a ~ Int => Arbitrary (IntSet a) where+ arbitrary = fmap fromList arbitrary++fmapIsSame+ :: (Functor f, Prelude.Functor f, Suitable f b, Eq (f b), Show (f b))+ => Blind (a -> b) -> f a -> Property+fmapIsSame (Blind f) x = label "fmap is same" $ fmap f x === Prelude.fmap f x++replaceIsSame+ :: (Functor f, Prelude.Functor f, Suitable f a, Eq (f a), Show (f a))+ => f b -> a -> Property+replaceIsSame xs x = label "replace is same" $ (x <$ xs) === (x Prelude.<$ xs)++pureIsSame+ :: (Applicative f+ ,Prelude.Applicative f+ ,Suitable f a+ ,Eq (f a)+ ,Show (f a))+ => Proxy f -> a -> Property+pureIsSame (_ :: Proxy f) (x :: a) = label "pure is same" $ (pure x :: f a) === Prelude.pure x++seqRightIsSame+ :: (Applicative f+ ,Prelude.Applicative f+ ,Suitable f b+ ,Eq (f b)+ ,Show (f b))+ => f a -> f b -> Property+seqRightIsSame xs ys = label "*> is same" $ (xs *> ys) === (xs Prelude.*> ys)++seqLeftIsSame+ :: (Applicative f+ ,Prelude.Applicative f+ ,Suitable f b+ ,Eq (f b)+ ,Show (f b))+ => f b -> f a -> Property+seqLeftIsSame xs ys = label "<* is same" $ (xs <* ys) === (xs Prelude.<* ys)++applyIsSame+ :: (Applicative f+ ,Prelude.Applicative f+ ,Suitable f b+ ,Eq (f b)+ ,Show (f b))+ => Blind (f (a -> b)) -> f a -> Property+applyIsSame (Blind fs) xs = label "<*> is same" $ (fs <*> xs) === (fs Prelude.<*> xs)++liftA2IsSame+ :: (Applicative f+ ,Prelude.Applicative f+ ,Suitable f c+ ,Eq (f c)+ ,Show (f c))+ => Blind (a -> b -> c) -> f a -> f b -> Property+liftA2IsSame (Blind f) xs ys =+ label "liftA2 is same" $+ liftA2 f xs ys === Control.Applicative.liftA2 f xs ys++bindIsSame+ :: (Monad f, Prelude.Monad f, Suitable f b, Show (f b), Eq (f b))+ => f a -> Blind (a -> f b) -> Property+bindIsSame xs (Blind f) =+ label ">>= is same" $ (xs >>= f) === (xs Prelude.>>= f)++checkSame+ :: (Monad f+ ,Prelude.Monad f+ ,Show (f b)+ ,Show (f c)+ ,CoArbitrary c+ ,Arbitrary (f c)+ ,Arbitrary (f a)+ ,Arbitrary (f (b -> a))+ ,CoArbitrary b+ ,Arbitrary a+ ,Arbitrary (f b)+ ,Suitable f a+ ,Eq (f a)+ ,Show (f a)+ ,Show a)+ => Proxy f -> Proxy a -> Proxy b -> Proxy c -> IO ()+checkSame (_ :: Proxy f) (_ :: Proxy a) (_ :: Proxy b) (_ :: Proxy c) = do+ quickCheck (fmapIsSame @ f @ a @ b)+ quickCheck (replaceIsSame @ f @ a @ b)+ quickCheck (pureIsSame (Proxy :: Proxy f) :: a -> Property)+ quickCheck (seqRightIsSame @ f @ a @ b)+ quickCheck (seqLeftIsSame @ f @ a @ b)+ quickCheck (applyIsSame @ f @ a @ b)+ quickCheck (liftA2IsSame @ f @ a @ b @ c)+ quickCheck (bindIsSame @ f @ a @ b)++checkConstrained+ :: (Show (f a)+ ,Arbitrary (f a)+ ,Suitable f a+ ,Eq (f a)+ ,Show (f c)+ ,CoArbitrary c+ ,CoArbitrary b+ ,Arbitrary a+ ,Arbitrary (f c)+ ,Suitable f b+ ,Show (f b)+ ,Arbitrary (f b)+ ,Show a+ ,CoArbitrary a+ ,Eq (f b)+ ,Monad f+ ,Arbitrary b)+ => Proxy f -> Proxy a -> Proxy b -> Proxy c -> IO ()+checkConstrained (_ :: Proxy f) (_ :: Proxy a) (_ :: Proxy b) (_ :: Proxy c) = do+ quickCheck (fmapLaw @ f @ a)+ quickCheck (fmapCompLaw @ f @ a @ b @ c)+ quickCheck (seqRightLaw @ f @ a @ b)+ quickCheck (seqLeftLaw @ f @ a @ b)+ quickCheck (monadLawOne @ f @ a @ b)+ quickCheck (monadLawTwo @ f @ a)+ quickCheck (monadLawThree @ f @ a @ b @ c)++checkUnConstrained+ :: (Show (f a)+ ,Arbitrary (f a)+ ,Suitable f a+ ,Suitable f ((a -> b) -> (c -> a) -> c -> b)+ ,Arbitrary (f (a -> b))+ ,Arbitrary (f (c -> a))+ ,Suitable f ((c -> a) -> c -> b)+ ,Suitable f (c -> b)+ ,Suitable f (a -> b)+ ,Suitable f ((a -> b) -> b)+ ,Eq (f a)+ ,Show (f c)+ ,CoArbitrary c+ ,CoArbitrary b+ ,Arbitrary a+ ,Arbitrary (f c)+ ,Suitable f b+ ,Show (f b)+ ,Arbitrary (f b)+ ,Show a+ ,CoArbitrary a+ ,Eq (f b)+ ,Monad f+ ,Suitable f (a -> a)+ ,Arbitrary b)+ => Proxy f -> Proxy a -> Proxy b -> Proxy c -> IO ()+checkUnConstrained (pf :: Proxy f) (pa :: Proxy a) (pb :: Proxy b) (pc :: Proxy c) = do+ checkConstrained pf pa pb pc+ quickCheck (appIdLaw @ f @ a)+ quickCheck (appCompLaw @ f @ a @ b @ c)+ quickCheck (homomorphismLaw (Proxy :: Proxy f) :: Blind (a -> b) -> a -> Property)+ quickCheck (interchangeLaw @ f @ a @ b)+++{-# ANN fmapLaw "HLint: ignore Functor law" #-}+fmapLaw+ :: (Functor f, Suitable f a, Eq (f a), Show (f a))+ => f a -> Property+fmapLaw xs = label "fmap law" $ fmap id xs === xs++{-# ANN fmapCompLaw "HLint: ignore Functor law" #-}+fmapCompLaw+ :: (Functor f, Suitable f c, Eq (f c), Show (f c), Suitable f b)+ => Blind (b -> c) -> Blind (a -> b) -> f a -> Property+fmapCompLaw (Blind f) (Blind g) xs =+ label "fmap comp law" $ fmap (f . g) xs === (fmap f . fmap g) xs++seqRightLaw+ :: (Applicative f, Suitable f b, Eq (f b), Show (f b))+ => f a -> f b -> Property+seqRightLaw xs ys = label "*> law" $ (xs *> ys) === (liftA2 (const id) xs ys)++seqLeftLaw+ :: (Applicative f, Suitable f a, Eq (f a), Show (f a))+ => f a -> f b -> Property+seqLeftLaw xs ys = label "<* law" $ (xs <* ys) === (liftA2 const xs ys)++appIdLaw+ :: (Applicative f, Suitable f a, Suitable f (a -> a), Eq (f a), Show (f a))+ => f a -> Property+appIdLaw xs = label "app id law" $ (pure id <*> xs) === xs++appCompLaw+ :: (Applicative f+ ,Suitable f ((b -> c) -> (a -> b) -> a -> c)+ ,Suitable f ((a -> b) -> a -> c)+ ,Suitable f (a -> c)+ ,Suitable f c+ ,Suitable f b+ ,Eq (f c)+ ,Show (f c))+ => Blind (f (b -> c)) -> Blind (f (a -> b)) -> f a -> Property+appCompLaw (Blind u) (Blind v) w+ = label "app comp law" $ (pure (.) <*> u <*> v <*> w) === (u <*> (v <*> w))++homomorphismLaw+ :: (Suitable f (a -> b)+ ,Suitable f b+ ,Suitable f a+ ,Applicative f+ ,Eq (f b)+ ,Show (f b))+ => Proxy f -> Blind (a -> b) -> a -> Property+homomorphismLaw (_ :: Proxy f) (Blind (f :: a -> b)) x+ = label "homomorphism law" $ (pure f <*> pure x) === (pure (f x) :: f b)++interchangeLaw+ :: (Applicative f+ ,Suitable f a+ ,Suitable f b+ ,Suitable f ((a -> b) -> b)+ ,Eq (f b)+ ,Show (f b))+ => Blind (f (a -> b)) -> a -> Property+interchangeLaw (Blind u) y = label "interchange law" $ (u <*> pure y) === (pure ($y) <*> u)++monadLawOne+ :: (Monad f, Suitable f a, Suitable f b, Show (f b), Eq (f b))+ => Blind (a -> f b) -> a -> Property+monadLawOne (Blind k) a = label "monad law one" $ (pure a >>= k) === k a++monadLawTwo+ :: (Monad f, Suitable f a, Eq (f a), Show (f a))+ => f a -> Property+monadLawTwo xs = label "monad law two" $ (xs >>= pure) === xs++monadLawThree+ :: (Monad f, Suitable f c, Eq (f c), Suitable f b, Show (f c))+ => f a -> Blind (a -> f b) -> Blind (b -> f c) -> Property+monadLawThree m (Blind k) (Blind h) =+ label "monad law three" $ (m >>= (k >=> h)) === ((m >>= k) >>= h)++instance (Enum a, Bounded a, Eq1 m, Eq b) => Eq (ReaderT a m b) where+ ReaderT fs == ReaderT gs = all (\x -> eq1 (fs x) (gs x)) [minBound..maxBound]++instance (CoArbitrary a, Arbitrary (m b)) => Arbitrary (ReaderT a m b) where+ arbitrary = fmap ReaderT arbitrary++instance (CoArbitrary a, Arbitrary (m (b,a))) => Arbitrary (StateT a m b) where+ arbitrary = fmap StateT arbitrary++instance (Enum a, Bounded a, Eq (m (b,a))) => Eq (StateT a m b) where+ StateT fs == StateT gs = all (\x -> (fs x) == (gs x)) [minBound..maxBound]++instance (Enum a, Show a, Show (m b), Bounded a) => Show (ReaderT a m b) where+ show (ReaderT xs) = show (map ((,) <*> xs) [minBound..maxBound])++instance (Enum a, Show a, Show (m (b,a)), Bounded a) => Show (StateT a m b) where+ show (StateT xs) = show (map ((,) <*> xs) [minBound..maxBound])++instance Arbitrary a => Arbitrary (Identity a) where+ arbitrary = fmap Identity arbitrary++main :: IO ()+main = do+ putStrLn "[]"+ checkSame (Proxy @ [] ) (Proxy @ Integer) (Proxy @ Word) (Proxy @ Int)+ checkUnConstrained (Proxy @ [] ) (Proxy @ Integer) (Proxy @ Word) (Proxy @ Int)+ putStrLn "Set"+ checkConstrained (Proxy @ Set) (Proxy @ Integer) (Proxy @ Word) (Proxy @ Int)+ putStrLn "IntSet"+ checkConstrained (Proxy @ IntSet) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ putStrLn "Reader Bool"+ checkUnConstrained (Proxy @ (Reader Bool)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ checkSame (Proxy @ (Reader Bool)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ putStrLn "ReaderT Bool Maybe"+ checkUnConstrained (Proxy @ (ReaderT Bool Maybe)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ checkSame (Proxy @ (ReaderT Bool Maybe)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ putStrLn "State Bool"+ checkUnConstrained (Proxy @ (State Bool)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ checkSame (Proxy @ (State Bool)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ putStrLn "StateT Bool Maybe"+ checkUnConstrained (Proxy @ (StateT Bool Maybe)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)+ checkSame (Proxy @ (StateT Bool Maybe)) (Proxy @ Int ) (Proxy @ Int ) (Proxy @ Int)++ doctest [ "-isrc", "src/" ]