deepcontrol 0.1.0.0 → 0.2.0.0

raw patch · 15 files changed

+1844/−87 lines, 15 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• DeepControl/Applicative.hs +159/−44
• DeepControl/Arrow.hs +3/−3
• DeepControl/Commutative.hs +12/−12
• DeepControl/Monad.hs +1/−2
• DeepControl/Monad/Except.hs +132/−0
• DeepControl/Monad/List.hs +63/−0
• DeepControl/Monad/Maybe.hs +58/−0
• DeepControl/Monad/RWS.hs +207/−4
• DeepControl/Monad/Reader.hs +126/−4
• DeepControl/Monad/State.hs +168/−2
• DeepControl/Monad/Writer.hs +167/−9
• DeepControl/MonadTrans.hs +396/−0
• README.md +329/−0
• deepcontrol.cabal +19/−6
• test/UnitTest_Applicative.hs +4/−1

@@ -1,7 +1,7 @@ {-| Module      : DeepControl.Applicative Description : Enable deep level Applicative style programming.-Copyright   : KONISHI Yohuske 2015+Copyright   : (C) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com Stability   : experimental@@ -9,7 +9,7 @@  This module enables you to program in applicative style for more __deeper__ level than the usual 'Control.Applicative' module expresses. You would soon realize exactly what __/more deeper level/__ means by reading the example codes in order, which are attached on the functions below.-Note: all braket-cover notation for Level-4 and Level-5 is not written yet.+Note: all the braket-cover notation for Level-4 and Level-5 haven't been written yet. -} module DeepControl.Applicative (     module Control.Applicative,@@ -33,6 +33,10 @@     (|$>>), (<<$|), (|*>>), (<<*|),     -- ** braket-cover notation     (|**), (**|), (|-*), (|*-), (-*|), (*-|),+    -- ** sequnce notation+    (*>>), (<<*), +    -- ** sequnce-cover notation+    (*->), (<*-), (-*>), (<-*),      -- * Level-3     -- ** cover notation@@ -43,18 +47,27 @@     (|***), (***|),     (|-**), (|*-*), (|**-), (|--*), (|-*-), (|*--),     (-**|), (*-*|), (**-|), (--*|), (-*-|), (*--|),+    -- ** sequnce notation+    (*>>>), (<<<*),+    -- ** sequnce-cover notation+    (*-->), (-*->), (--*>), (**->), (*-*>), (-**>),+    (<*--), (<-*-), (<--*), (<**-), (<*-*), (<-**),      -- * Level-4     -- ** cover notation     (****:),      -- ** bra-ket notation     (|$>>>>), (<<<<$|), (|*>>>>), (<<<<*|),+    -- ** sequnce notation+    (*>>>>), (<<<<*),      -- * Level-5     -- ** cover notation     (*****:),      -- ** bra-ket notation     (|$>>>>>), (<<<<<$|), (|*>>>>>), (<<<<<*|),+    -- ** sequnce notation+    (*>>>>>), (<<<<<*),      ) where  @@ -64,6 +77,7 @@ -- Level-0 functions  infixl 4  |>, <|+ -- | Alias for @'$'@.  --  -- >>> (1+) |> 2@@ -88,12 +102,14 @@ -- ----------------------------------------------------------------------------- -- Level-1 functions -infixl 5  *:+infixl 6  *:+ -- | Alias for @'pure'@. (*:) :: (Applicative f) => a -> f a (*:) = pure  infixl 4 |$>+ -- | Alias for @'<$>'@. -- -- >>> (1+) |$> [2] @@ -102,6 +118,7 @@ (|$>) = (<$>)  infixl 3  <$|, |*>, <*|, |*, *|+ -- | The auguments-flipped function for @'|$>'@. -- -- >>> [1] <$| (+2) @@ -140,7 +157,7 @@ (<*|) :: Applicative f => f a -> f (a -> b) -> f b (<*|) = flip (|*>) --- | Combination consisted of ket @'|*>'@ and cover @'*:'@, defined as @f |* x = f |*> ((*:) x)@.+-- | Combination consisted of ket @'|*>'@ and cover @'*:'@, defined as @f |* x = f |*> (*:) x@. -- -- >>> [(1+)] |* 2 -- [3]@@ -152,7 +169,7 @@ -- >>> Just 1 <$|(,)|* 2  -- Just (1,2) (|*) :: Applicative f => f (a -> b) -> a -> f b-f |* x = f |*> ((*:) x)+f |* x = f |*> (*:) x  -- | The auguments-flipped function for @'|*'@.  --@@ -165,28 +182,26 @@ --  -- >>> 1 *|Just (,)|* 2 -- Just (1,2)--- (*|) :: Applicative f => a -> f (a -> b) -> f b (*|) = flip (|*)  -- ----------------------------------------------------------------------------- -- Level-2 functions -infixl 5  **:-infixl 5  -*, *-+infixl 6  **:+infixl 6  -*, *- -- | Combination consisted of cover @'*:'@ twice, defined as @(**:) = (*:) . (*:)@. (**:) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a) (**:) = (*:) . (*:)- -- | Combination consisted of cover @'*:'@ and ket @'|$>'@, defined as @(-*) = ((*:)|$>)@. (-*) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 a) (-*) = ((*:)|$>) --(*-) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 a) -- | Alias for @'*:'@. +(*-) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 a) (*-) = (*:)  infixl 4  |$>>+ -- | Combination consisted of cover @'|$>'@ twice, defined as @(|$>>) = (|$>) . (|$>)@. -- -- >>> (+1) |$>> [[2]]@@ -197,6 +212,7 @@ infixl 3  <<$|, |*>>, <<*| infixl 3  |**, **| infixl 3  |-*, |*-, -*|, *-|+ -- | The auguments-flipped function for @'|$>>'@ -- -- >>> [[2]] <<$| (+1)@@ -215,25 +231,25 @@ -- >>> [[1]] <<$|(+)|*>> [[2]] <<$|(-)|*>> [[3]] -- [[0]] ----- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right (Just 2), Right (Just 3)]) :: Either () (Maybe Int)+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right (Just 2), Right (Just 3)] :: Either () (Maybe Int) -- Right (Just 6)--- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right Nothing, Right (Just 3)]) :: Either () (Maybe Int)+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right Nothing, Right (Just 3)] :: Either () (Maybe Int) -- Right Nothing--- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right Nothing, Left ()])+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right Nothing, Left ()] -- Left () (|*>>) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f1 (f2 a) -> f1 (f2 b) (|*>>) = liftA2 (|*>) --- | The auguments-flipped function for @'|*>>'@.+-- | The lifted function of @'<*|'@, defined as @(<<*|) = liftA2 (<*|)@. (<<*|) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 (a -> b)) -> f1 (f2 b)-(<<*|) = flip (|*>>)+(<<*|) = liftA2 (<*|) --- | Combination consisted of ket @'|*>>'@ and cover @'**:'@, defined as @f |** x = f |*>> ((**:) x)@.+-- | Combination consisted of ket @'|*>>'@ and cover @'**:'@, defined as @f |** x = f |*>> (**:) x@. -- -- >>> [Just 1] <<$|(+)|** 2 -- [Just 3] (|**) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> a -> f1 (f2 b)-f |** x = f |*>> ((**:) x)+f |** x = f |*>> (**:) x  -- | The auguments-flipped function for @'|**'@. --@@ -247,19 +263,19 @@ (**|) :: (Applicative f1, Applicative f2) => a -> f1 (f2 (a -> b)) -> f1 (f2 b) (**|)  = flip (|**) --- | Combination consisted of ket @'|*>>'@ and cover @'-*'@, defined as @f |-* x = f |*>> ((-*) x)@.+-- | Combination consisted of ket @'|*>>'@ and cover @'-*'@, defined as @f |-* x = f |*>> (-*) x@. -- -- >>> [Just 1] <<$|(+)|-* [2] -- [Just 3] (|-*) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f1 a -> f1 (f2 b)-f |-* x = f |*>> ((-*) x)+f |-* x = f |*>> (-*) x --- | Combination consisted of ket @'|*>>'@ and cover @'*-'@, defined as @f |-* x = f |*>> ((*-) x)@.+-- | Combination consisted of ket @'|*>>'@ and cover @'*-'@, defined as @f |*- x = f |*>> (*-) x@. -- -- >>> [Just 1] <<$|(+)|*- Just 2  -- [Just 3] (|*-) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f2 a -> f1 (f2 b)-f |*- x = f |*>> ((*-) x)+f |*- x = f |*>> (*-) x  -- | The auguments-flipped function for @'|-*'@. --@@ -267,6 +283,7 @@ -- [Just 3] (-*|) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 (a -> b)) -> f1 (f2 b) (-*|) = flip (|-*)+ -- | The auguments-flipped function for @'|*-'@. -- -- >>> Just 1 *-|(+)|$>> [Just 2]@@ -281,22 +298,97 @@ -- [Just 3,Just (-1),Just 2,Nothing] -- >>> [0,1] -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2 -- [Just 2,Just 3,Just (-2),Just (-1),Just 0,Just 2,Nothing,Nothing]+--+-- >>> print 1 -*|return [\_ _ -> 3]|-* print 2+-- 1+-- 2+-- [3] (*-|) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 (a -> b)) -> f1 (f2 b) (*-|) = flip (|*-) -{--infixl 3  <<*, *>>+infixl 5  <<*, *>>+infixl 5  *->, <*-, -*>, <-*++-- | The lifted function of @'*>'@, defined as @liftA2 (*>)@.+{- +--+-- >>> ((*:)|$> print 1) *>> return [2]+-- 1+-- [2]+-} (*>>) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 b) (*>>) = liftA2 (*>)++-- | The lifted function of @'<*'@, defined as @liftA2 (<*)@.+{-+--+-- >>> return [2] <<* ((*:)|$> print 1)+-- 1+-- [2]+-- >>> ((*:)|$> print 1) *>> return [3] <<* ((*:)|$> print 2)+-- 1+-- 2+-- [3]+-} (<<*) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 a) (<<*) = liftA2 (<*)++-- | Combination consisted of sequence @'*>>'@ and cover @'*:'@, defined as:+--+-- a *-> x = (*:) a *>> x+{-+--+-- >>> [1] *-> return [2] +-- [2] -}+(*->) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 b) -> f1 (f2 b)+a *-> x = (*:) a *>> x +-- | Combination consisted of sequence @'<<*'@ and cover @'*:'@, defined as:+--+-- x <*- a = x <<* (*:) a+{-+--+-- >>> return [2] <*- [1] +-- [2]+-}+(<*-) :: (Applicative f1, Applicative f2) => f1 (f2 b) -> f2 a -> f1 (f2 b)+x <*- a = x <<* (*:) a++-- | Combination consisted of sequence @'*>>'@ and cover @'-*'@, defined as:+--+-- a -*> x = (-*) a *>> x+--+{-+--+-- >>> print [1] -*> return [2]+-- [1]+-- [2]+-}+(-*>) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 b) -> f1 (f2 b)+a -*> x = (-*) a *>> x++-- | Combination consisted of sequence @'<<*'@ and cover @'-*'@, defined as:+--+-- x <-* a = x <<* (-*) a+{-+--+-- >>> return [2] <-* print [1]+-- [1]+-- [2]+-- >>> print [1] -*> return [3] <-* print [2]+-- [1]+-- [2]+-- [3]+-}+(<-*) :: (Applicative f1, Applicative f2) => f1 (f2 b) -> f1 a -> f1 (f2 b)+x <-* a = x <<* (-*) a+ -- ----------------------------------------------------------------------------- -- Level-3 functions -infixl 5  ***:-infixl 5  -**, *-*, **-, --*, -*-, *--+infixl 6  ***:+infixl 6  -**, *-*, **-, --*, -*-, *-- (***:) :: (Applicative f1, Applicative f2, Applicative f3) => a -> f1 (f2 (f3 a)) (***:) = (*:) . (**:) (-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 a))@@ -328,22 +420,22 @@ (<<<*|) = flip (|*>>>)  (|***) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> a -> f1 (f2 (f3 b))-f |*** x = f |*>>> ((***:) x)+f |*** x = f |*>>> (***:) x (***|) :: (Applicative f1, Applicative f2, Applicative f3) => a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b)) (***|)  = flip (|***)  (|-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 a -> f1 (f2 (f3 b))-f |-** x = f |*>>> ((-**) x)+f |-** x = f |*>>> (-**) x (|*-*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f2 a -> f1 (f2 (f3 b))-f |*-* x = f |*>>> ((*-*) x)+f |*-* x = f |*>>> (*-*) x (|**-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f3 a -> f1 (f2 (f3 b))-f |**- x = f |*>>> ((**-) x)+f |**- x = f |*>>> (**-) x (|--*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 (f2 a) -> f1 (f2 (f3 b))-f |--* x = f |*>>> ((--*) x)+f |--* x = f |*>>> (--*) x (|*--) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f2 (f3 a) -> f1 (f2 (f3 b))-f |*-- x = f |*>>> ((*--) x)+f |*-- x = f |*>>> (*--) x (|-*-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 (f3 a) -> f1 (f2 (f3 b))-f |-*- x = f |*>>> ((-*-) x)+f |-*- x = f |*>>> (-*-) x  (-**|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b)) (-**|) = flip (|-**)@@ -358,18 +450,44 @@ (-*-|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f3 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b)) (-*-|) = flip (|-*-) -{--infixl 3  <<<*, *>>>+infixl 5  <<<*, *>>> (*>>>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b)) (*>>>) = liftA2 (*>>) (<<<*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 a)) (<<<*) = liftA2 (<<*)--} +infixl 5  *-->, -*->, --*>, **->, *-*>, -**>+(*-->) :: (Applicative f1, Applicative f2, Applicative f3) => f2 (f3 a) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a *--> x = (*--) a *>>> x+(-*->) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f3 a) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a -*-> x = (-*-) a *>>> x+(--*>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 a) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a --*> x = (--*) a *>>> x+(**->) :: (Applicative f1, Applicative f2, Applicative f3) => f3 a -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a **-> x = (**-) a *>>> x+(*-*>) :: (Applicative f1, Applicative f2, Applicative f3) => f2 a -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a *-*> x = (*-*) a *>>> x+(-**>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))+a -**> x = (-**) a *>>> x++infixl 5  <*--, <-*-, <--*, <**-, <*-*, <-**+(<*--) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f2 (f3 a) -> f1 (f2 (f3 b))+x <*-- a = x <<<* (*--) a+(<-*-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f1 (f3 a) -> f1 (f2 (f3 b))+x <-*- a = x <<<* (-*-) a+(<--*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f1 (f2 a) -> f1 (f2 (f3 b))+x <--* a = x <<<* (--*) a+(<**-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f3 a -> f1 (f2 (f3 b))+x <**- a = x <<<* (**-) a +(<*-*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f2 a -> f1 (f2 (f3 b))+x <*-* a = x <<<* (*-*) a+(<-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f1 a -> f1 (f2 (f3 b))+x <-** a = x <<<* (-**) a+ -- ----------------------------------------------------------------------------- -- Level-4 functions -infixl 5  ****:+infixl 6  ****: (****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => a -> f1 (f2 (f3 (f4 a))) (****:) = (***:) . (*:) @@ -385,18 +503,16 @@ (<<<<*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) (<<<<*|) = flip (|*>>>>) -{--infixl 3  <<<<*, *>>>>+infixl 5  <<<<*, *>>>> (*>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) (*>>>>) = liftA2 (*>>>) (<<<<*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 a))) (<<<<*) = liftA2 (<<<*)--}  -- ----------------------------------------------------------------------------- -- Level-5 functions -infixl 5  *****:+infixl 6  *****: (*****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => a -> f1 (f2 (f3 (f4 (f5 a)))) (*****:) = (*:) . (****:) @@ -412,10 +528,9 @@ (<<<<<*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) (<<<<<*|) = flip (|*>>>>>) -{--infixl 3  <<<<<*, *>>>>>+infixl 5  <<<<<*, *>>>>> (*>>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) (*>>>>>) = liftA2 (*>>>>) (<<<<<*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 a)))) (<<<<<*) = liftA2 (<<<<*)--}+

@@ -1,14 +1,14 @@ {-|-Module      : DeepControl.Commutative+Module      : DeepControl.Arrow Description : Enable deep level Arrow programming.-Copyright   : KONISHI Yohuske 2015,+Copyright   : (c) Ross Paterson 2002,+              (C) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com Stability   : experimental Portability : ---  -}-{-# LANGUAGE Arrows #-} module DeepControl.Arrow (     module Control.Arrow,     

@@ -1,8 +1,8 @@ {-| Module      : DeepControl.Commutative-Description : Commutative Functor, Applicative, Monad.-Copyright   : KONISHI Yohuske 2015,-              Conor McBride and Ross Paterson 2005+Description : Commutative Functor.+Copyright   : Conor McBride and Ross Paterson 2005,+              (C) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com Stability   : experimental@@ -16,8 +16,8 @@     -- * The 'Commutative' class     Commutative(..),     -- * Utility functions-    commuteMap,-    commuteFor,+    cmap,+    cfor,     -- * General definitions for superclass methods     fmapDefault,     foldMapDefault,@@ -36,11 +36,11 @@   commute :: Applicative f => c (f a) -> f (c a)  -- | Do @fmap f@ then commute, the same for @'Data.Traversable.traverse'@.-commuteMap :: (Applicative f, Commutative c) => (a -> f b) -> c a -> f (c b)-commuteMap f = commute . (f |$>)--- | The auguments-flipped function for @'commuteMap'@, the same for @'Data.Traversable.for'@.-commuteFor :: (Applicative f, Commutative c) => c a -> (a -> f b) -> f (c b)-commuteFor = flip commuteMap+cmap :: (Applicative f, Commutative c) => (a -> f b) -> c a -> f (c b)+cmap f = commute . (f |$>)+-- | The auguments-flipped function for @'cmap'@, the same for @'Data.Traversable.for'@.+cfor :: (Applicative f, Commutative c) => c a -> (a -> f b) -> f (c b)+cfor = flip cmap  instance Commutative Maybe where     commute (Just fa) = Just |$> fa@@ -69,12 +69,12 @@ --   instance, provided that 'commute' is defined. (Using --   `fmapDefault` with a `Commutative` instance will result in infinite recursion.) fmapDefault :: Commutative t => (a -> b) -> t a -> t b-fmapDefault f = getId . commuteMap (Id . f)+fmapDefault f = getId . cmap (Id . f)  -- | This function may be used as a value for `Data.Foldable.foldMap` --   in a `Foldable` instance. foldMapDefault :: (Commutative t, Monoid m) => (a -> m) -> t a -> m-foldMapDefault f = getConst . commuteMap (Const . f)+foldMapDefault f = getConst . cmap (Const . f)  -- local instances newtype Id a = Id { getId :: a }

@@ -1,7 +1,7 @@ {-| Module      : DeepControl.Monad Description : Enable deep level Monad programming.-Copyright   : KONISHI Yohuske 2015+Copyright   : (C) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com Stability   : experimental@@ -276,7 +276,6 @@ f >====> g = \x -> f x >>>>== g (>>>>~) :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >>>>~ k = m >>>>== \_ -> k-  instance Monad4 Maybe where     mmmmv >>>>== f = 

@@ -0,0 +1,132 @@+{-|+Module      : DeepControl.Monad.Except+Description : +Copyright   : (C) 2013 Ross Paterson,+              (C) 2015 KONISHI Yohsuke +License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for Except Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of ExceptT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadReader`, `DeepControl.Monad.MonadWriter` or `DeepControl.Monad.MonadState`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-}+{-# LANGUAGE +        DeriveFunctor,+        GeneralizedNewtypeDeriving,+        FlexibleInstances,+        FunctionalDependencies+ #-}+module DeepControl.Monad.Except (+    -- * Classes+    Error(..),+    MonadError(..),++    -- * Level-0+    Except(..), mapExcept, withExcept, +    -- * Level-1+    ExceptT(..), mapExceptT, withExceptT, ++    ) where ++import DeepControl.Applicative+import DeepControl.Monad+import DeepControl.MonadTrans+import DeepControl.Commutative++import Control.Monad.Except (MonadError(..))+import Control.Monad.Signatures+import Data.Monoid++class Error a where+    noMsg  :: a+    noMsg    = strMsg ""+    strMsg :: String -> a+    strMsg _ = noMsg++----------------------------------------------------------------------+-- Level-0++newtype Except e a = Except { runExcept :: Either e a }+  deriving (Show, Functor, Applicative, Monad, MonadError e) ++{- +TODO: 例えば newdata SomeType = ReaderT2 r IO (Except e) a とした場合、 MonadError e SomeType　のインスタンスが作れない（catchError がどうしても作れない）+　　　なので Except の Monadx は作ってもあまり意味がない。++>newtype Eval a = Eval { unEval :: RWST2 Env [String] Int IO (Except ExpError) a }+>  deriving (Functor, Applicative, Monad, MonadIO)+>+>class (Monad2 m2) => MonadError2 e m2 | m2 -> e where+>  throwError2 :: (Monad m1) => e -> m1 (m2 a)+>  catchError2 :: (Monad m1) => m1 (m2 a) -> (e -> m1 (m2 a)) -> m1 (m2 a)+>+>instance MonadError2 e Except where+>  throwError2     = (*:) . throwError+>  catchError2 x h = +>        x >>= \x' -> +>        case x' of+>          Right v -> (*:) x'+>          Left e  -> catchError e h+>+>instance MonadError ExpError Eval where+>    throwError     = Eval . trans2 . throwError2+>    catchError x f = 作れない++instance Monad2 (Except e) where+    m >>== f = (Except |$>) $ (runExcept |$> m) >>== runExcept |$>> f+instance Monad3 (Except e) where+    m >>>== f = (Except |$>>) $ (runExcept |$>> m) >>>== runExcept |$>>> f+instance Monad4 (Except e) where+    m >>>>== f = (Except |$>>>) $ (runExcept |$>>> m) >>>>== runExcept |$>>>> f+instance Monad5 (Except e) where+    m >>>>>== f = (Except |$>>>>) $ (runExcept |$>>>> m) >>>>>== runExcept |$>>>>> f+-}++instance Commutative (Except e) where+    commute (Except x) = Except |$> commute x++mapExcept :: (Either e a -> Either e' b) -> Except e a -> Except e' b+mapExcept f = Except . f . runExcept++withExcept :: (e -> e') -> Except e a -> Except e' a+withExcept f = mapExcept $ either (Left . f) Right++----------------------------------------------------------------------+-- Level-1++newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) }++instance (Functor m) => Functor (ExceptT e m) where+    fmap f = \(ExceptT mv) -> ExceptT $ f |$>> mv+instance (Monad m) => Applicative (ExceptT e m) where+    pure a = ExceptT $ (*:) (Right a)+    (<*>)  = ap+instance (Monad m) => Monad (ExceptT e m) where+    return = pure+    m >>= f = ExceptT $ runExceptT m >>== \v -> runExceptT (f v)++instance (Monad m, Error e) => MonadError e (ExceptT e m) where+    throwError = ExceptT . (*:) . Left+    m `catchError` h = ExceptT $ do+        a <- runExceptT m+        case a of+            Left  l -> runExceptT (h l)+            Right r -> (*:) (Right r)++instance MonadTrans (ExceptT e) where+    trans = ExceptT . (-*)+instance (MonadIO m) => MonadIO (ExceptT e m) where+    liftIO = trans . liftIO++mapExceptT :: (m (Either e a) -> n (Either e' b)) -> ExceptT e m a -> ExceptT e' n b+mapExceptT f = ExceptT . f . runExceptT++withExceptT :: Functor m => (e -> e') -> ExceptT e m a -> ExceptT e' m a+withExceptT f = mapExceptT $ fmap $ either (Left . f) Right++

@@ -0,0 +1,63 @@+{-|+Module      : DeepControl.Monad.List+Description : +Copyright   : (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology, 2001,+              (C) 2015 KONISHI Yohsuke +License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for List Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of ListT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadReader`, `DeepControl.Monad.MonadWriter` or `DeepControl.Monad.MonadState`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-}+module DeepControl.Monad.List (++    -- * Level-1+    ListT(..), mapListT, liftCallCC, liftCatch++    ) where ++import DeepControl.Applicative+import DeepControl.Monad+import DeepControl.MonadTrans++import Control.Monad.Signatures++----------------------------------------------------------------------+-- Level-1++newtype ListT m a = ListT { runListT :: m [a] }++instance (Functor m) => Functor (ListT m) where+    fmap f mv = ListT $ f |$>> runListT mv+instance (Applicative m) => Applicative (ListT m) where+    pure = ListT . (**:)+    f <*> v = ListT $ runListT f |*>> runListT v+instance (Monad m) => Monad (ListT m) where+    return = pure+    mv >>= f = ListT $ +        runListT mv >>== \v ->+        runListT (f v)++instance MonadTrans ListT where+    trans = ListT . (-*)+instance (MonadIO m) => MonadIO (ListT m) where+    liftIO = trans . liftIO++mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b+mapListT f = ListT . f . runListT++liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b+liftCallCC callCC f = ListT $+    callCC $ \c ->+    runListT $ (\a -> ListT $ c [a]) >- f++liftCatch :: Catch e m [a] -> Catch e (ListT m) a+liftCatch catchE m h = ListT $ runListT m `catchE` \e -> runListT (h e)+

@@ -0,0 +1,58 @@+{-|+Module      : DeepControl.Monad.Maybe+Description : +Copyright   : (c) 2007 Yitzak Gale, Eric Kidd,+              (C) 2015 KONISHI Yohsuke+License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for Maybe Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of MaybeT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadReader`, `DeepControl.Monad.MonadWriter` or `DeepControl.Monad.MonadState`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-}+module DeepControl.Monad.Maybe (++    -- * Level-1+    MaybeT(..), mapMaybeT, liftCatch,++    ) where ++import DeepControl.Applicative+import DeepControl.Monad+import DeepControl.MonadTrans+import DeepControl.Commutative++import Control.Monad.Signatures++----------------------------------------------------------------------+-- Level-1++newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }++instance (Functor m) => Functor (MaybeT m) where+    fmap f mv = MaybeT $ f |$>> runMaybeT mv+instance (Monad m) => Applicative (MaybeT m) where+    pure = MaybeT . (**:)+    f <*> v = MaybeT $ runMaybeT f |*>> runMaybeT v+instance (Monad m) => Monad (MaybeT m) where+    return = pure+    mv >>= f = MaybeT $ +        runMaybeT mv >>== \v -> +        runMaybeT (f v)++instance MonadTrans MaybeT where+    trans = MaybeT . (-*) +instance (MonadIO m) => MonadIO (MaybeT m) where+    liftIO = trans . liftIO++mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b+mapMaybeT f = MaybeT . f . runMaybeT++liftCatch :: Catch e m (Maybe a) -> Catch e (MaybeT m) a+liftCatch catchE m h = MaybeT $ runMaybeT m `catchE` \e -> runMaybeT (h e)+

@@ -1,21 +1,49 @@+{-|+Module      : DeepControl.Monad.RWS+Description : +Copyright   : (C) 2015 KONISHI Yohsuke,+              (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology, 2001+License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for RWS Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of RWSTx, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadError`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-} {-# LANGUAGE MultiParamTypeClasses,               FlexibleInstances #-} module DeepControl.Monad.RWS (     MonadReader(..), MonadWriter(..), MonadState(..), -    RWS(..), rws, evalRWS, execRWS, +    -- * Level-0+    RWS(..), rws, evalRWS, execRWS, mapRWS, withRWS,+    -- * Level-1+    RWST(..), rwsT, evalRWST, execRWST, mapRWST, withRWST, liftCatch,+    -- * Level-2+    RWST2(..), rwsT2, evalRWST2, execRWST2, mapRWST2, withRWST2, +    -- * Level-3+    RWST3(..), rwsT3, evalRWST3, execRWST3, mapRWST3, withRWST3,       ) where   import DeepControl.Applicative import DeepControl.Monad+import DeepControl.MonadTrans  import Control.Monad.Reader (MonadReader(..)) import Control.Monad.Writer (MonadWriter(..)) import Control.Monad.State (MonadState(..))+import Control.Monad.Signatures+import Data.Monoid  ------------------------------------------------------------------------- RWS+-- Level-0  newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } @@ -26,11 +54,11 @@     pure a = RWS $ \_ s -> (a, s, mempty)     (<*>)  = ap instance (Monoid w) => Monad (RWS r w s) where-    return  = (*:)+    return = pure     m >>= k = RWS $ \r s ->          runRWS m r s >- \(a, s', w) ->         runRWS (k a) r s' >- \(b, s'',w') ->-        (b, s'', w `mappend` w')+        (b, s'', w <> w') instance (Monoid w) => MonadReader r (RWS r w s) where     ask       = RWS $ \r s -> (r, s, mempty)     local f m = RWS $ \r s -> runRWS m (f r) s@@ -57,5 +85,180 @@ execRWS m r s =     runRWS m r s >- \(_, s', w) ->     (s', w)+mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b+mapRWS f m = RWS $ \r s -> f (runRWS m r s)+withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a+withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s) +----------------------------------------------------------------------+-- Level-1++newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }++instance (Functor m) => Functor (RWST r w s m) where+    fmap f m = RWST $ \r s ->+        (\(a, s', w) -> (f a, s', w)) |$> runRWST m r s+instance (Monoid w, Monad m) => Applicative (RWST r w s m) where+    pure a = RWST $ \_ s -> (*:) (a, s, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m) => Monad (RWST r w s m) where+    return = pure+    m >>= k = RWST $ \r s -> +        runRWST m r s >>= \(a, s', w) ->+        runRWST (k a) r s' >>= \(b, s'',w') ->+        (*:) (b, s'', w <> w')+instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where+    ask       = RWST $ \r s -> (*:) (r, s, mempty)+    local f m = RWST $ \r s -> runRWST m (f r) s+instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where+    writer (a, w) = RWST $ \_ s -> (*:) (a, s, w)+    tell w        = RWST $ \_ s -> (*:) ((), s, w)+    listen m      = RWST $ \r s -> +        runRWST m r s >>= \(a, s', w) ->+        (*:) ((a, w), s', w)+    pass m        = RWST $ \r s ->+        runRWST m r s >>= \((a, f), s', w) ->+        (*:) (a, s', f w)+instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where+    get   = RWST $ \_ s -> (*:) (s, s, mempty)+    put s = RWST $ \_ _ -> (*:) ((), s, mempty)++instance (Monoid w) => MonadTrans (RWST r w s) where+    trans m = RWST $ \r s -> +        m >>= \a ->+        (*:) (a, s, mempty)+instance (Monoid w, MonadIO m, Monad m) => MonadIO (RWST r w s m) where+    liftIO = trans . liftIO++rwsT :: (Monad m) => (r -> s -> (a, s, w)) -> RWST r w s m a+rwsT = RWST . (--*)+evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w)+evalRWST m r s =+    runRWST m r s >>= \(a, _, w) ->+    (*:) (a, w)+execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w)+execRWST m r s =+    runRWST m r s >>= \(_, s', w) ->+    (*:) (s', w)++mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b+mapRWST f m = RWST $ \r s -> f (runRWST m r s)+withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a+withRWST f m = RWST $ \r s -> uncurry (runRWST m) (f r s)++liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a+liftCatch catchE m h =+    RWST $ \r s -> runRWST m r s `catchE` \e -> runRWST (h e) r s++----------------------------------------------------------------------+-- Level-2++newtype RWST2 r w s m1 m2 a = RWST2 { runRWST2 :: r -> s -> m1 (m2 (a, s, w)) }++instance (Functor m1, Functor m2) => Functor (RWST2 r w s m1 m2) where+    fmap f m = RWST2 $ \r s ->+        (\(a, s', w) -> (f a, s', w)) |$>> runRWST2 m r s+instance (Monoid w, Monad m1, Monad2 m2) => Applicative (RWST2 r w s m1 m2) where+    pure a = RWST2 $ \_ s -> (**:) (a, s, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m1, Monad2 m2) => Monad (RWST2 r w s m1 m2) where+    return = pure+    m >>= k = RWST2 $ \r s -> +        runRWST2 m r s >>== \(a, s', w) ->+        runRWST2 (k a) r s' >>== \(b, s'',w') ->+        (**:) (b, s'', w <> w')+instance (Monoid w, Monad m1, Monad2 m2) => MonadReader r (RWST2 r w s m1 m2) where+    ask       = RWST2 $ \r s -> (**:) (r, s, mempty)+    local f m = RWST2 $ \r s -> runRWST2 m (f r) s+instance (Monoid w, Monad m1, Monad2 m2) => MonadWriter w (RWST2 r w s m1 m2) where+    writer (a, w) = RWST2 $ \_ s -> (**:) (a, s, w)+    tell w        = RWST2 $ \_ s -> (**:) ((),s,w)+    listen m      = RWST2 $ \r s -> +        runRWST2 m r s >>== \(a, s', w) ->+        (**:) ((a, w), s', w)+    pass m        = RWST2 $ \r s ->+        runRWST2 m r s >>== \((a, f), s', w) ->+        (**:) (a, s', f w)+instance (Monoid w, Monad m1, Monad2 m2) => MonadState s (RWST2 r w s m1 m2) where+    get   = RWST2 $ \_ s -> (**:) (s, s, mempty)+    put s = RWST2 $ \_ _ -> (**:) ((), s, mempty)++instance (Monoid w) => MonadTrans2 (RWST2 r w s) where+    trans2 m = RWST2 $ \r s -> +        m >>== \a ->+        (**:) (a, s, mempty)+instance (Monoid w, MonadIO m1, Monad m1, Monad2 m2) => MonadIO (RWST2 r w s m1 m2) where+    liftIO = trans2 . (-*) . liftIO++rwsT2 :: (Monad m1, Monad2 m2) => (r -> s -> (a, s, w)) -> RWST2 r w s m1 m2 a+rwsT2 = RWST2 . ((**:)|$>>)+evalRWST2 :: (Monad m1, Monad2 m2) => RWST2 r w s m1 m2 a -> r -> s -> m1 (m2 (a, w))+evalRWST2 m r s =+    runRWST2 m r s >>== \(a, _, w) ->+    (**:) (a, w)+execRWST2 :: (Monad m1, Monad2 m2) => RWST2 r w s m1 m2 a -> r -> s -> m1 (m2 (s, w))+execRWST2 m r s =+    runRWST2 m r s >>== \(_, s', w) ->+    (**:) (s', w)++mapRWST2 :: (m1 (m2 (a, s, w)) -> n1 (n2 (b, s, w'))) -> RWST2 r w s m1 m2 a -> RWST2 r w' s n1 n2 b+mapRWST2 f m = RWST2 $ \r s -> f (runRWST2 m r s)+withRWST2 :: (r' -> s -> (r, s)) -> RWST2 r w s m1 m2 a -> RWST2 r' w s m1 m2 a+withRWST2 f m = RWST2 $ \r s -> uncurry (runRWST2 m) (f r s)++----------------------------------------------------------------------+-- Level-3++newtype RWST3 r w s m1 m2 m3 a = RWST3 { runRWST3 :: r -> s -> m1 (m2 (m3 (a, s, w))) }++instance (Functor m1, Functor m2, Functor m3) => Functor (RWST3 r w s m1 m2 m3) where+    fmap f m = RWST3 $ \r s ->+        (\(a, s', w) -> (f a, s', w)) |$>>> runRWST3 m r s+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => Applicative (RWST3 r w s m1 m2 m3) where+    pure a = RWST3 $ \_ s -> (***:) (a, s, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => Monad (RWST3 r w s m1 m2 m3) where+    return = pure+    m >>= k = RWST3 $ \r s -> +        runRWST3 m r s >>>== \(a, s', w) ->+        runRWST3 (k a) r s' >>>== \(b, s'',w') ->+        (***:) (b, s'', w <> w')+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => MonadReader r (RWST3 r w s m1 m2 m3) where+    ask       = RWST3 $ \r s -> (***:) (r, s, mempty)+    local f m = RWST3 $ \r s -> runRWST3 m (f r) s+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => MonadWriter w (RWST3 r w s m1 m2 m3) where+    writer (a, w) = RWST3 $ \_ s -> (***:) (a, s, w)+    tell w        = RWST3 $ \_ s -> (***:) ((), s, w)+    listen m      = RWST3 $ \r s -> +        runRWST3 m r s >>>== \(a, s', w) ->+        (***:) ((a, w), s', w)+    pass m        = RWST3 $ \r s ->+        runRWST3 m r s >>>== \((a, f), s', w) ->+        (***:) (a, s', f w)+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => MonadState s (RWST3 r w s m1 m2 m3) where+    get   = RWST3 $ \_ s -> (***:) (s, s, mempty)+    put s = RWST3 $ \_ _ -> (***:) ((), s, mempty)++instance (Monoid w) => MonadTrans3 (RWST3 r w s) where+    trans3 m = RWST3 $ \r s -> +        m >>>== \a ->+        (***:) (a, s, mempty)+instance (Monoid w, MonadIO m1, Monad m1, Monad2 m2, Monad3 m3) => MonadIO (RWST3 r w s m1 m2 m3) where+    liftIO = trans3 . (-**) . liftIO++rwsT3 :: (Monad m1, Monad2 m2, Monad3 m3) => (r -> s -> (a, s, w)) -> RWST3 r w s m1 m2 m3 a+rwsT3 = RWST3 . ((***:)|$>>)+evalRWST3 :: (Monad m1, Monad2 m2, Monad3 m3) => RWST3 r w s m1 m2 m3 a -> r -> s -> m1 (m2 (m3 (a, w)))+evalRWST3 m r s =+    runRWST3 m r s >>>== \(a, _, w) ->+    (***:) (a, w)+execRWST3 :: (Monad m1, Monad2 m2, Monad3 m3) => RWST3 r w s m1 m2 m3 a -> r -> s -> m1 (m2 (m3 (s, w)))+execRWST3 m r s =+    runRWST3 m r s >>>== \(_, s', w) ->+    (***:) (s', w)++mapRWST3 :: (m1 (m2 (m3 (a, s, w))) -> n1 (n2 (n3 (b, s, w')))) -> RWST3 r w s m1 m2 m3 a -> RWST3 r w' s n1 n2 n3 b+mapRWST3 f m = RWST3 $ \r s -> f (runRWST3 m r s)+withRWST3 :: (r' -> s -> (r, s)) -> RWST3 r w s m1 m2 m3 a -> RWST3 r' w s m1 m2 m3 a+withRWST3 f m = RWST3 $ \r s -> uncurry (runRWST3 m) (f r s) 

@@ -1,23 +1,52 @@+{-|+Module      : DeepControl.Monad.Reader+Description : +Copyright   : (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology 2001,+              (c) Jeff Newbern 2003-2007,+              (c) Andriy Palamarchuk 2007,+              (C) 2015 KONISHI Yohsuke,+License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for Reader Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of ReaderT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadError`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-} {-# LANGUAGE MultiParamTypeClasses,               FlexibleInstances #-} module DeepControl.Monad.Reader (     MonadReader(..),     asks, +    -- * Level-0     Reader(..),-+    -- * Level-1+    ReaderT(..), mapReaderT, liftCatch,+    -- * Level-2+    ReaderT2(..), mapReaderT2,+    -- * Level-3+    ReaderT3(..), mapReaderT3,+         ) where   import DeepControl.Applicative import DeepControl.Monad+import DeepControl.MonadTrans  import Control.Monad.Reader (MonadReader(..))+import Control.Monad.Signatures  asks :: MonadReader r m => (r -> a) -> m a asks = reader  ------------------------------------------------------------------------- Reader+-- Level-0  newtype Reader r a = Reader { runReader :: r -> a } @@ -26,9 +55,9 @@         f $ runReader v r  instance Applicative (Reader r) where     pure a = Reader $ \_ -> a-    (<*>) = ap+    (<*>)  = ap instance Monad (Reader r) where-    return = (*:)+    return = pure     mv >>= f = mv >- \(Reader v) -> Reader $ \r ->         v r >- \a ->          runReader (f a) r@@ -45,4 +74,97 @@     ask       = Reader id     local f m = Reader $ runReader m . f +----------------------------------------------------------------------+-- Level-1++newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }++instance (Functor m) => Functor (ReaderT r m) where+    fmap f m = ReaderT $ \r ->+        f |$> runReaderT m r+instance (Monad m) => Applicative (ReaderT s m) where+    pure a = ReaderT $ \_ -> (*:) a+    (<*>)  = ap+instance (Monad m) => Monad (ReaderT r m) where+    return = pure+    (ReaderT v) >>= f = ReaderT $ \r ->+        v r >>= \a -> +        runReaderT (f a) r+instance (Monad m) => MonadReader r (ReaderT r m) where+    ask       = ReaderT $ (*:)+    local f m = ReaderT $ runReaderT m . f++instance MonadTrans (ReaderT r) where+    trans m = ReaderT $ \r -> +        m >>= \a ->+        (*:) a+instance (MonadIO m, Monad m) => MonadIO (ReaderT r m) where+    liftIO = trans . liftIO++mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b+mapReaderT f m = ReaderT $ f . runReaderT m++liftCatch :: Catch e m a -> Catch e (ReaderT r m) a+liftCatch catch m h =+    ReaderT $ \ r -> runReaderT m r `catch` \ e -> runReaderT (h e) r++----------------------------------------------------------------------+-- Level-2++newtype ReaderT2 r m1 m2 a = ReaderT2 { runReaderT2 :: r -> m1 (m2 a) }++instance (Functor m1, Functor m2) => Functor (ReaderT2 r m1 m2) where+    fmap f m = ReaderT2 $ \r ->+        f |$>> runReaderT2 m r+instance (Monad m1, Monad2 m2) => Applicative (ReaderT2 s m1 m2) where+    pure a = ReaderT2 $ \_ -> (**:) a+    (<*>)  = ap+instance (Monad m1, Monad2 m2) => Monad (ReaderT2 r m1 m2) where+    return = pure+    (ReaderT2 v) >>= f = ReaderT2 $ \r ->+        v r >>== \a -> +        runReaderT2 (f a) r+instance (Monad m1, Monad2 m2) => MonadReader r (ReaderT2 r m1 m2) where+    ask       = ReaderT2 $ (**:)+    local f m = ReaderT2 $ runReaderT2 m . f++instance MonadTrans2 (ReaderT2 r) where+    trans2 m = ReaderT2 $ \r -> +        m >>== \a ->+        (**:) a+instance (MonadIO m1, Monad m1, Monad2 m2) => MonadIO (ReaderT2 r m1 m2) where+    liftIO = trans2 . (-*) . liftIO++mapReaderT2 :: (m1 (m2 a) -> n1 (n2 b)) -> ReaderT2 r m1 m2 a -> ReaderT2 r n1 n2 b+mapReaderT2 f m = ReaderT2 $ f . runReaderT2 m++----------------------------------------------------------------------+-- Level-3++newtype ReaderT3 r m1 m2 m3 a = ReaderT3 { runReaderT3 :: r -> m1 (m2 (m3 a)) }++instance (Functor m1, Functor m2, Functor m3) => Functor (ReaderT3 r m1 m2 m3) where+    fmap f m = ReaderT3 $ \r ->+        f |$>>> runReaderT3 m r+instance (Monad m1, Monad2 m2, Monad3 m3) => Applicative (ReaderT3 s m1 m2 m3) where+    pure a = ReaderT3 $ \_ -> (***:) a+    (<*>)  = ap+instance (Monad m1, Monad2 m2, Monad3 m3) => Monad (ReaderT3 r m1 m2 m3) where+    return = pure+    (ReaderT3 v) >>= f = ReaderT3 $ \r ->+        v r >>>== \a -> +        runReaderT3 (f a) r+instance (Monad m1, Monad2 m2, Monad3 m3) => MonadReader r (ReaderT3 r m1 m2 m3) where+    ask       = ReaderT3 $ (***:)+    local f m = ReaderT3 $ runReaderT3 m . f++instance MonadTrans3 (ReaderT3 r) where+    trans3 m = ReaderT3 $ \r -> +        m >>>== \a ->+        (***:) a+instance (MonadIO m1, Monad m1, Monad2 m2, Monad3 m3) => MonadIO (ReaderT3 r m1 m2 m3) where+    liftIO = trans3 . (-**) . liftIO++mapReaderT3 :: (m1 (m2 (m3 a)) -> n1 (n2 (n3 b))) -> ReaderT3 r m1 m2 m3 a -> ReaderT3 r n1 n2 n3 b+mapReaderT3 f m = ReaderT3 $ f . runReaderT3 m 

@@ -1,3 +1,21 @@+{-|+Module      : DeepControl.Monad.State+Description : +Copyright   : (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology, 2001,+              (C) 2015 KONISHI Yohsuke,+License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for State Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of StateT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadError`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-} {-# LANGUAGE MultiParamTypeClasses,              FlexibleInstances,              UndecidableInstances #-}@@ -5,14 +23,23 @@     MonadState(..),     modify, gets, -    State(..), evalState, execState, +    -- * Level-0+    State(..), evalState, execState, mapState, withState,+    -- * Level-1+    StateT(..), evalStateT, execStateT, mapStateT, withStateT, liftCatch,+    -- * Level-2+    StateT2(..), evalStateT2, execStateT2, mapStateT2, withStateT2, +    -- * Level-3+    StateT3(..), evalStateT3, execStateT3, mapStateT3, withStateT3,       ) where   import DeepControl.Applicative import DeepControl.Monad+import DeepControl.MonadTrans  import Control.Monad.State (MonadState(..))+import Control.Monad.Signatures  modify :: MonadState s m => (s -> s) -> m () modify f = state $ \s -> ((), f s)@@ -21,7 +48,7 @@ gets f = state $ \s -> (f s, s)  ------------------------------------------------------------------------- State+-- Level-0  newtype State s a = State { runState :: s -> (a, s) } @@ -50,5 +77,144 @@ execState m s =      let (_, s') = runState m s     in s'++mapState :: ((a, s) -> (b, s)) -> State s a -> State s b+mapState f m = State $ f . runState m+withState :: (s -> s) -> State s a -> State s a+withState f m = State $ runState m . f++----------------------------------------------------------------------+-- Level-1++newtype StateT s m a = StateT { runStateT :: (s -> m (a,s)) }++instance (Functor m) => Functor (StateT s m) where+    fmap f v = StateT $ \s ->+        (\(a, s') -> (f a, s')) |$> runStateT v s+instance (Monad m) => Applicative (StateT s m) where+    pure a = StateT $ \s -> (*:) (a,s)+    (<*>)  = ap+instance (Monad m) => Monad (StateT s m) where+    return = pure+    (StateT v) >>= f = +        StateT $ \s -> +            v s >>= \(a, s') ->+            runStateT (f a) s'+instance (Monad m) => MonadState s (StateT s m) where+    get   = StateT $ \s -> (*:) (s, s)+    put s = StateT $ \_ -> (*:) ((), s)++instance MonadTrans (StateT s) where+    trans m = StateT $ \s -> +        m >>= \a ->+        (*:) (a, s)+instance (MonadIO m, Monad m) => MonadIO (StateT s m) where+    liftIO = trans . liftIO++evalStateT :: (Monad m) => StateT s m a -> s -> m a+evalStateT m s = +    runStateT m s >>= \(a, _) ->+    (*:) a+execStateT :: (Monad m) => StateT s m a -> s -> m s+execStateT m s = +    runStateT m s >>= \(_, s') ->+    (*:) s'++mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b+mapStateT f m = StateT $ f . runStateT m+withStateT :: (s -> s) -> StateT s m a -> StateT s m a+withStateT f m = StateT $ runStateT m . f++liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a+liftCatch catch m h =+    StateT $ \ s -> runStateT m s `catch` \ e -> runStateT (h e) s++----------------------------------------------------------------------+-- Level-2++newtype StateT2 s m1 m2 a = StateT2 { runStateT2 :: (s -> m1 (m2 (a,s))) }++instance (Functor m1, Functor m2) => Functor (StateT2 s m1 m2) where+    fmap f v = StateT2 $ \s ->+        (\(a, s') -> (f a, s')) |$>> runStateT2 v s+instance (Monad m1, Monad2 m2) => Applicative (StateT2 s m1 m2) where+    pure a = StateT2 $ \s -> (**:) (a,s)+    (<*>)  = ap+instance (Monad m1, Monad2 m2) => Monad (StateT2 s m1 m2) where+    return = pure+    (StateT2 v) >>= f = +        StateT2 $ \s -> +            v s >>== \(a, s') ->+            runStateT2 (f a) s'+instance (Monad m1, Monad2 m2) => MonadState s (StateT2 s m1 m2) where+    get   = StateT2 $ \s -> (**:) (s, s)+    put s = StateT2 $ \_ -> (**:) ((), s)++instance MonadTrans2 (StateT2 s) where+    trans2 m = StateT2 $ \s -> +        m >>== \a ->+        (**:) (a, s)+instance (MonadIO m1, Monad m1, Monad2 m2) => MonadIO (StateT2 s m1 m2) where+    liftIO = trans2 . (-*) . liftIO++evalStateT2 :: (Monad m1, Monad2 m2) => StateT2 s m1 m2 a -> s -> m1 (m2 a)+evalStateT2 m s = +    runStateT2 m s >>== \(a, _) ->+    (**:) a+execStateT2 :: (Monad m1, Monad2 m2) => StateT2 s m1 m2 a -> s -> m1 (m2 s)+execStateT2 m s = +    runStateT2 m s >>== \(_, s') ->+    (**:) s'++mapStateT2 :: (m1 (m2 (a, s)) -> n1 (n2 (b, s))) -> StateT2 s m1 m2 a -> StateT2 s n1 n2 b+mapStateT2 f m = StateT2 $ f . runStateT2 m+withStateT2 :: (s -> s) -> StateT2 s m1 m2 a -> StateT2 s m1 m2 a+withStateT2 f m = StateT2 $ runStateT2 m . f++----------------------------------------------------------------------+-- Level-3++newtype StateT3 s m1 m2 m3 a = StateT3 { runStateT3 :: (s -> m1 (m2 (m3 (a,s)))) }++instance (Functor m1, Functor m2, Functor m3) => Functor (StateT3 s m1 m2 m3) where+    fmap f v = StateT3 $ \s ->+        (\(a, s') -> (f a, s')) |$>>> runStateT3 v s+instance (Monad m1, Monad2 m2, Monad3 m3) => Applicative (StateT3 s m1 m2 m3) where+    pure a = StateT3 $ \s -> (***:) (a,s)+    (<*>)  = ap+instance (Monad m1, Monad2 m2, Monad3 m3) => Monad (StateT3 s m1 m2 m3) where+    return = pure+    (StateT3 v) >>= f = +        StateT3 $ \s -> +            v s >>>== \(a, s') ->+            runStateT3 (f a) s'+instance (Monad m1, Monad2 m2, Monad3 m3) => MonadState s (StateT3 s m1 m2 m3) where+    get   = StateT3 $ \s -> (***:) (s, s)+    put s = StateT3 $ \_ -> (***:) ((), s)++instance MonadTrans3 (StateT3 s) where+    trans3 m = StateT3 $ \s -> +        m >>>== \a ->+        (***:) (a, s)+instance (MonadIO m1, Monad m1, Monad2 m2, Monad3 m3) => MonadIO (StateT3 s m1 m2 m3) where+    liftIO = trans3 . (-**) . liftIO++evalStateT3 :: (Monad m1, Monad2 m2, Monad3 m3) => StateT3 s m1 m2 m3 a -> s -> m1 (m2 (m3 a))+evalStateT3 m s = +    runStateT3 m s >>>== \(a, _) ->+    (***:) a+execStateT3 :: (Monad m1, Monad2 m2, Monad3 m3) => StateT3 s m1 m2 m3 a -> s -> m1 (m2 (m3 s))+execStateT3 m s = +    runStateT3 m s >>>== \(_, s') ->+    (***:) s'++mapStateT3 :: (m1 (m2 (m3 (a, s))) -> n1 (n2 (n3 (b, s)))) -> StateT3 s m1 m2 m3 a -> StateT3 s n1 n2 n3 b+mapStateT3 f m = StateT3 $ f . runStateT3 m+withStateT3 :: (s -> s) -> StateT3 s m1 m2 m3 a -> StateT3 s m1 m2 m3 a+withStateT3 f m = StateT3 $ runStateT3 m . f++++  

@@ -1,17 +1,45 @@+{-|+Module      : DeepControl.Monad.State+Description : +Copyright   : (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology, 2001,+              (C) 2015 KONISHI Yohsuke,+License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module is just a concise mimic for Reader Monad in mtl(monad-transformer-library).+The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically.+So when making some new data type of WriterT, you have to manually define involved Monad instances, +for example `DeepControl.Monad.MonadError`, +by making use of the transformation functions such as `trans`, `trans2`, etc.+Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead.+-} {-# LANGUAGE MultiParamTypeClasses,               FlexibleInstances #-} module DeepControl.Monad.Writer (     MonadWriter(..),     listens, censor, -    Writer(..), execWriter,+    -- * Level-0+    Writer(..), execWriter, mapWriter,+    -- * Level-1+    WriterT(..), execWriterT, mapWriterT, liftCatch,+    -- * Level-2+    WriterT2(..), execWriterT2, mapWriterT2,+    -- * Level-3+    WriterT3(..), execWriterT3, mapWriterT3,      ) where   import DeepControl.Applicative import DeepControl.Monad+import DeepControl.MonadTrans  import Control.Monad.Writer (MonadWriter(..))+import Control.Monad.Signatures+import Data.Monoid  listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b) listens f m = do@@ -24,7 +52,7 @@     return (a, f)  ------------------------------------------------------------------------- Writer+-- Level-0  newtype Writer w a = Writer { runWriter :: (a, w) } @@ -33,29 +61,29 @@ instance (Monoid w) => Applicative (Writer w) where     pure a = Writer $ (a, mempty)     (<*>) = \(Writer (f, w)) (Writer (a, w')) ->-        Writer (f a, w' `mappend` w)+        Writer (f a, w <> w')  instance (Monoid w) => Monad (Writer w) where-    return   = (*:)+    return = pure     mv >>= f =          mv >- \(Writer (a, w)) -> -        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) $ f a+        (\(Writer (b, w')) -> Writer (b, w <> w')) $ f a instance (Monoid w) => Monad2 (Writer w) where     mmv >>== f =          mmv >>= \(Writer (a, w)) -> -        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$> f a+        (\(Writer (b, w')) -> Writer (b, w <> w')) |$> f a instance (Monoid w) => Monad3 (Writer w) where     mmv >>>== f =          mmv >>== \(Writer (a, w)) -> -        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>> f a+        (\(Writer (b, w')) -> Writer (b, w <> w')) |$>> f a instance (Monoid w) => Monad4 (Writer w) where     mmv >>>>== f =          mmv >>>== \(Writer (a, w)) -> -        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>>> f a+        (\(Writer (b, w')) -> Writer (b, w <> w')) |$>>> f a instance (Monoid w) => Monad5 (Writer w) where     mmv >>>>>== f =          mmv >>>>== \(Writer (a, w)) -> -        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>>>> f a+        (\(Writer (b, w')) -> Writer (b, w <> w')) |$>>>> f a  instance (Monoid w) => MonadWriter w (Writer w) where     writer   = Writer@@ -71,5 +99,135 @@ execWriter m =     runWriter m >- \(_, w) ->     w++mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b+mapWriter f m = Writer $ f (runWriter m)++----------------------------------------------------------------------+-- Level-1++newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }++instance (Monad m) => Functor (WriterT w m) where+    fmap f v = WriterT $ (\(a, w) -> (f a, w)) |$> (runWriterT v)+instance (Monoid w, Monad m) => Applicative (WriterT w m) where+    pure a = WriterT $ (*:) (a, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m) => Monad (WriterT w m) where  +    return = pure+    (WriterT v) >>= f = WriterT $+        v >>= \(a, w) ->+        runWriterT (f a) >>= \(a', w') ->+        (*:) (a', w <> w')+instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where+    writer   = WriterT . (*:)+    tell w   = writer $ ((), w)+    listen m = WriterT $+        runWriterT m >>= \(a, w) ->+        (*:) ((a, w), w) +    pass m   = WriterT $+        runWriterT m >>= \((a, f), w) ->+        (*:) (a, f w)++instance (Monoid w) => MonadTrans (WriterT w) where+    trans m = WriterT $ +        m >>= \a ->+        (*:) (a, mempty)+instance (Monoid w, MonadIO m, Monad m) => MonadIO (WriterT w m) where+    liftIO = trans . liftIO++execWriterT :: (Monad m) => WriterT w m a -> m w+execWriterT m =+    runWriterT m >>= \(_, w) ->+    (*:) w++mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b+mapWriterT f m = WriterT $ f (runWriterT m)++liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a+liftCatch catchE m h =+    WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e)++----------------------------------------------------------------------+-- Level-2++newtype WriterT2 w m1 m2 a = WriterT2 { runWriterT2 :: m1 (m2 (a, w)) }++instance (Monad m1, Monad2 m2) => Functor (WriterT2 w m1 m2) where+    fmap f v = WriterT2 $ (\(a, w) -> (f a, w)) |$>> (runWriterT2 v)+instance (Monoid w, Monad m1, Monad2 m2) => Applicative (WriterT2 w m1 m2) where+    pure a = WriterT2 $ (**:) (a, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m1, Monad2 m2) => Monad (WriterT2 w m1 m2) where  +    return = pure+    (WriterT2 v) >>= f = WriterT2 $+        v >>== \(a, w) ->+        runWriterT2 (f a) >>== \(a', w') ->+        (**:) (a', w <> w')+instance (Monoid w, Monad m1, Monad2 m2) => MonadWriter w (WriterT2 w m1 m2) where+    writer   = WriterT2 . (**:)+    tell w   = writer $ ((), w)+    listen m = WriterT2 $+        runWriterT2 m >>== \(a, w) ->+        (**:) ((a, w), w) +    pass m   = WriterT2 $+        runWriterT2 m >>== \((a, f), w) ->+        (**:) (a, f w)++instance (Monoid w) => MonadTrans2 (WriterT2 w) where+    trans2 m = WriterT2 $ +        m >>== \a ->+        (**:) (a, mempty)+instance (Monoid w, MonadIO m1, Monad m1, Monad2 m2) => MonadIO (WriterT2 w m1 m2) where+    liftIO = trans2 . (-*) . liftIO++execWriterT2 :: (Monad m1, Monad2 m2) => WriterT2 w m1 m2 a -> m1 (m2 w)+execWriterT2 m =+    runWriterT2 m >>== \(_, w) ->+    (**:) w++mapWriterT2 :: (m1 (m2 (a, w)) -> n1 (n2 (b, w'))) -> WriterT2 w m1 m2 a -> WriterT2 w' n1 n2 b+mapWriterT2 f m = WriterT2 $ f (runWriterT2 m)++----------------------------------------------------------------------+-- Level-3++newtype WriterT3 w m1 m2 m3 a = WriterT3 { runWriterT3 :: m1 (m2 (m3 (a, w))) }++instance (Monad m1, Monad2 m2, Monad3 m3) => Functor (WriterT3 w m1 m2 m3) where+    fmap f v = WriterT3 $ (\(a, w) -> (f a, w)) |$>>> (runWriterT3 v)+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => Applicative (WriterT3 w m1 m2 m3) where+    pure a = WriterT3 $ (***:) (a, mempty)+    (<*>)  = ap+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => Monad (WriterT3 w m1 m2 m3) where  +    return = pure+    (WriterT3 v) >>= f = WriterT3 $+        v >>>== \(a, w) ->+        runWriterT3 (f a) >>>== \(a', w') ->+        (***:) (a', w <> w')+instance (Monoid w, Monad m1, Monad2 m2, Monad3 m3) => MonadWriter w (WriterT3 w m1 m2 m3) where+    writer   = WriterT3 . (***:)+    tell w   = writer $ ((), w)+    listen m = WriterT3 $+        runWriterT3 m >>>== \(a, w) ->+        (***:) ((a, w), w) +    pass m   = WriterT3 $+        runWriterT3 m >>>== \((a, f), w) ->+        (***:) (a, f w)++instance (Monoid w) => MonadTrans3 (WriterT3 w) where+    trans3 m = WriterT3 $ +        m >>>== \a ->+        (***:) (a, mempty)+instance (Monoid w, MonadIO m1, Monad m1, Monad2 m2, Monad3 m3) => MonadIO (WriterT3 w m1 m2 m3) where+    liftIO = trans3 . (-**) . liftIO++execWriterT3 :: (Monad m1, Monad2 m2, Monad3 m3) => WriterT3 w m1 m2 m3 a -> m1 (m2 (m3 w))+execWriterT3 m =+    runWriterT3 m >>>== \(_, w) ->+    (***:) w++mapWriterT3 :: (m1 (m2 (m3 (a, w))) -> n1 (n2 (n3 (b, w')))) -> WriterT3 w m1 m2 m3 a -> WriterT3 w' n1 n2 n3 b+mapWriterT3 f m = WriterT3 $ f (runWriterT3 m)  

@@ -0,0 +1,396 @@+{-|+Module      : DeepControl.MonadTrans+Description : Enable deep level Monad-Transform programming.+Copyright   : (c) Andy Gill 2001,+              (c) Oregon Graduate Institute of Science and Technology, 2001,+              (C) 2015 KONISHI Yohsuke +License     : BSD-style (see the file LICENSE)+Maintainer  : ocean0yohsuke@gmail.com+Stability   : experimental+Portability : ---++This module enables you to program in Monad-Transformer style for more __deeper__ level than the usual @Control.Monad.Trans@ module expresses.+You would realize exactly what __/more deeper level/__ means by reading the example codes, which are attached on the page bottom.+Note: all the MonadTransx instances for Level-4 and Level-5 haven't been written yet.+-}+module DeepControl.MonadTrans (+    -- * MonadIO+    MonadIO(..),++    -- * MonadTrans+    MonadTrans(..), +    MonadTrans2(..),+    MonadTrans3(..),+    MonadTrans4(..),+    MonadTrans5(..),++    -- * Level-1 example+    -- $Example_Level1++    -- * Level-2 example+    -- $Example_Level2++) where++import DeepControl.Monad++import Control.Monad.IO.Class++----------------------------------------------------------------------+-- Level-1++class  MonadTrans t  where+    -- | Alias for @'Control.Monad.Trans.Class.lift'@.+    trans :: (Monad m) => m a -> t m a++----------------------------------------------------------------------+-- Level-2++class  MonadTrans2 t  where+    trans2 :: (Monad m1, Monad2 m2) => m1 (m2 a) -> t m1 m2 a++----------------------------------------------------------------------+-- Level-3++class  MonadTrans3 t  where+    trans3 :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 (m3 a)) -> t m1 m2 m3 a++----------------------------------------------------------------------+-- Level-4++class  MonadTrans4 t  where+    trans4 :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4) => m1 (m2 (m3 (m4 a))) -> t m1 m2 m3 m4 a++----------------------------------------------------------------------+-- Level-5++class  MonadTrans5 t  where+    trans5 :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 m5) => m1 (m2 (m3 (m4 (m5 a)))) -> t m1 m2 m3 m4 m5 a++----------------------------------------------------------------------+-- Examples++{- $Example_Level1+Here is a monad transformer example how to implement a tiny interpreter with RWST-ExceptT-IO monad, a level-1 monad-transformation.++Please turn on three pragmas GeneralizedNewtypeDeriving, FlexibleInstances and MultiParamTypeClasses on this example.++>import DeepControl.Applicative+>import DeepControl.Monad+>import DeepControl.MonadTrans+>import DeepControl.Monad.Except+>import DeepControl.Monad.RWS+>+>import qualified Data.Map as M+>+>-- ----------------------------------------------+>-- Data-types+>+>type Name = String          -- variable names+>+>-- Expression+>data Exp = Lit Int          -- Literal+>         | Var Name         -- Variable+>         | Plus Exp Exp     -- (+)+>         | Lam Name Exp     -- λ+>         | App Exp Exp      -- Application+>         deriving (Show)+>+>-- Value+>data Value = IntVal Int          -- Int Value +>           | FunVal Env Name Exp -- Functional Value+>           deriving (Show)+>+>-- Environment+>type Env = M.Map Name Value    -- mapping from names to values+>+>-- ----------------------------------------------+>-- Monad-Transform+>+>type EvalError = String+>instance Error EvalError where+>    strMsg x = x+> +>newtype Eval a = Eval (RWST Env [String] Int +>                      (ExceptT EvalError+>                          IO) a)+>  deriving (Functor, Applicative, Monad, MonadIO)+>+>unEval :: Eval a -> (RWST Env [String] Int +>                    (ExceptT EvalError+>                        IO) a)+>unEval (Eval a) = a+>+>runEval :: Eval a +>           -> Env  -- Reader+>           -> Int  -- States+>           -> IO (Either EvalError (a, Int, [String])) +>runEval (Eval x) env state = x >- \x -> runRWST x env state+>                               >- runExceptT+>+>instance MonadError EvalError Eval where+>    throwError = Eval . trans . throwError+>    catchError x h = +>        let x' = unEval x+>        in Eval $ (liftCatch catchError x') (\e -> unEval (h e))+>instance MonadReader Env Eval where+>    ask     = Eval $ ask+>    local x = Eval . (local x) . unEval+>instance MonadWriter [String] Eval where+>    writer   = Eval . writer+>    listen m = Eval $ (listen (unEval m)) +>    pass m   = Eval $ (pass (unEval m)) +>instance MonadState Int Eval where+>    get   = Eval $ get+>    put   = Eval . put+>    state = Eval . state+>+>-- ----------------------------------------------+>-- Interpreter+>+>tick :: (Num s, MonadState s m) => m ()+>tick = do +>    st <- get+>    put (st + 1)+>+>eval :: Exp -> Eval Value+>eval (Lit i)   = do +>    tick+>    liftIO $ print i+>    return $ IntVal i+>eval (Var n)   = do +>    tick+>    tell [n]+>    env <- ask+>    case M.lookup n env of+>        Nothing  -> throwError $ "unbound variable: " ++ n+>        Just val -> return val+>eval (Plus e1 e2) = do +>    tick+>    e1' <- eval e1+>    e2' <- eval e2+>    case (e1', e2') of+>        (IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)+>        _                      -> throwError "type error in addition"+>eval (Lam n e) = do +>    tick+>    env <- ask+>    return $ FunVal env n e+>eval (App e1 e2) = do +>    tick+>    val1 <- eval e1+>    val2 <- eval e2+>    case val1 of+>        FunVal env' n body -> local (const (M.insert n val2 env')) $ eval body+>        _                  -> throwError "type error in application"+>+>-- ----------------------------------------------+>-- Examples+>+>-- 12 + ((\x -> x) (4 + 2))+>exp1 :: Exp+>exp1 = Lit 12 `Plus` ((Lam "x" (Var "x")) `App` (Lit 4 `Plus` Lit 2))+>+>-- (\x -> (\y -> x + y)) a b+>exp2 :: Exp+>exp2 = (Lam "x" (Lam "y" ((Var "x") `Plus` (Var "y")))) `App` (Var "a") `App` (Var "b")+>+>-- An environment+>env :: Env+>env = M.fromList [ ("a", IntVal 1)+>                 , ("b", IntVal 2)+>                 , ("c", IntVal 3)  +>                 , ("d", IntVal 4)+>                 ] +>+>-- ----------------------------------------------+>-- Tests+>--+>-- > runEval (eval exp1) env 0+>-- 12+>-- 4+>-- 2+>-- Right (IntVal 18,8,["x"])+>+>-- > runEval (eval exp2) env 0+>-- Right (IntVal 3,9,["a","b","x","y"])+>+>-- > runEval (eval $ Var "x") env 0+>-- Left "unbound variable: x"+-}++{- $Example_Level2+Here is a monad transformer example how to implement Polish Notation with StateT2-IO-Maybe monad, a level-2 monad-transformation.++>import DeepControl.Applicative+>import DeepControl.Commutative (cmap)+>import DeepControl.Monad+>import DeepControl.Monad.State+>import DeepControl.MonadTrans+>+>-----------------------------------------------+>-- State+>+>push :: a -> State [a] a+>push x = do +>    xs <- get+>    put (x:xs)+>    return x+>+>pop :: State [a] a+>pop = do +>    xs <- get+>    put (tail xs)+>    return (head xs)+>+>-- > runState (push 1 >> push 2 >> push 3) []+>-- (3,[3,2,1])+>-- > runState (push 1 >> push 2 >> push 3 >> pop >> pop) []+>-- (2,[1])+>+>poland :: String -> State [Double] Double+>poland "+" = do +>    x <- pop+>    y <- pop+>    push (y + x)+>poland "-" = do +>    x <- pop+>    y <- pop+>    push (y - x)+>poland "*" = do +>    x <- pop+>    y <- pop+>    push (y * x)+>poland "/" = do+>    x <- pop+>    y <- pop+>    push (y / x)+>poland x = push (read x :: Double)+>+>poland_calc :: [String] -> Double+>poland_calc xs = evalState (cmap poland xs >> pop) []+>+>-- > poland_calc ["1","2","*"]+>-- 2.0+>-- > poland_calc ["1","2","-"]+>-- -1.0+>-- > poland_calc ["1","2","+","3","*"]+>-- 9.0+>-- > poland_calc ["1","2","+","3","*","3","/"]+>-- 3.0+>-- > poland_calc ["1","2","+","3","*","0","/"]+>-- Infinity+>+>-----------------------------------------------+>-- StateT-Maybe+>+>pushT :: a -> StateT [a] Maybe a+>pushT x = do +>    xs <- get+>    put (x:xs)+>    return x+>+>popT :: StateT [a] Maybe a+>popT = do +>    xs <- get+>    put (tail xs)+>    return (head xs)+>+>-- > runStateT (pushT 1 >> pushT 2 >> pushT 3) []+>-- Just (3,[3,2,1])+>-- > runStateT (pushT 1 >> pushT 2 >> pushT 3 >> popT >> popT) []+>-- Just (2,[1])+>+>polandT :: String -> StateT [Double] Maybe Double+>polandT "+" = do +>    x <- popT+>    y <- popT+>    pushT (y + x)+>polandT "-" = do +>    x <- popT+>    y <- popT+>    pushT (y - x)+>polandT "*" = do +>    x <- popT+>    y <- popT+>    pushT (y * x)+>polandT "/" = do+>    x <- popT+>    y <- popT+>    trans $ guard (x /= 0)+>    pushT (y / x)+>polandT x = pushT (read x :: Double)+>+>poland_calcT :: [String] -> Maybe Double+>poland_calcT xs = evalStateT (cmap polandT xs >> popT) []+>+>-- > poland_calcT ["1","2","*"]+>-- Just 2.0+>-- > poland_calcT ["1","2","-"]+>-- Just (-1.0)+>-- > poland_calcT ["1","2","+","3","*"]+>-- Just 9.0+>-- > poland_calcT ["1","2","+","3","*","3","/"]+>-- Just 3.0+>-- > poland_calcT ["1","2","+","3","*","0","/"]+>-- Nothing+>+>-----------------------------------------------+>-- StateT2-IO-Maybe+>+>pushT2 :: a -> StateT2 [a] IO Maybe a+>pushT2 x = do +>    xs <- get+>    put (x:xs)+>    return x+>popT2 :: StateT2 [a] IO Maybe a+>popT2 = do +>    xs <- get+>    put (tail xs)+>    return (head xs)+>+>polandT2 :: String -> StateT2 [Double] IO Maybe Double+>polandT2 "+" = do +>    x <- popT2+>    y <- popT2+>    liftIO $ putStrLn (show y ++" + "++ show x ++" = "++ show (y + x))+>    pushT2 (y + x)+>polandT2 "-" = do +>    x <- popT2+>    y <- popT2+>    liftIO $ putStrLn (show y ++" - "++ show x ++" = "++ show (y - x))+>    pushT2 (y - x)+>polandT2 "*" = do+>    x <- popT2+>    y <- popT2+>    liftIO $ putStrLn (show y ++" * "++ show x ++" = "++ show (y * x))+>    pushT2 (y * x)+>polandT2 "/" = do+>    x <- popT2+>    y <- popT2+>    liftIO $ putStr (show y ++" / "++ show x ++" = ")+>    trans2.(*:) $ guard (x /= 0)+>    liftIO $ putStr (show (y / x) ++"\n")+>    pushT2 (y / x)+>polandT2 x = pushT2 (read x :: Double)+>+>poland_calcT2 :: [String] -> IO (Maybe Double)+>poland_calcT2 xs = evalStateT2 (cmap polandT2 xs >> popT2) []+>+>-- > poland_calcT2 ["1","2","*"]+>-- 1.0 * 2.0 = 2.0+>-- Just 2.0+>-- > poland_calcT2 ["1","2","+","3","*"]+>-- 1.0 + 2.0 = 3.0+>-- 3.0 * 3.0 = 9.0+>-- Just 9.0+>-- > poland_calcT2 ["1","2","+","3","*","3","/"]+>-- 1.0 + 2.0 = 3.0+>-- 3.0 * 3.0 = 9.0+>-- 9.0 / 3.0 = 3.0+>-- Just 3.0+>-- > poland_calcT2 ["1","2","+","3","*","0","/"]+>-- 1.0 + 2.0 = 3.0+>-- 3.0 * 3.0 = 9.0+>-- 9.0 / 0.0 = Nothing+-}

@@ -0,0 +1,329 @@+# deepcontrol++A Haskell library that enables more deeper level style programming than the usual Control.xxx modules provide, especially for Applicative and Monad.++## Installing with [Stack](https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md)++If you haven't installed Stack yet, install [Stack](https://github.com/commercialhaskell/stack#readme). ++If you have never even used Stack, launch the terminal and go to your working directory:++    .../yourworkingdirectory$++To create your own Stack new project folder, type as below:++    ../yourworkingdirectory$ stack new yourproject simple+    Downloading template "simple" to create project "yourproject" in yourproject/ ...+    ...++Go into your project folder:++    ../yourworkingdirectory$ cd yourproject/++To install GHC on your Stack project folder, type as below:++    .../yourproject$ stack setup+    stack will use a locally installed GHC++Now start ghci and see if it works well.++    .../yourproject$ stack ghci+    ...+    Prelude>++### Fetch from [Stackage](http://www.stackage.org/)++Add `deepcontrol` to your .cabal file:++yourproject.cabal:++      ...+      build-depends:       ...+                         , deepcontrol++On your project folder run "stack build" to get Stack to install `deepcontrol` into your project.++    .../yourproject$ stack build++If Stack yields a messeage below, it means that `deepcontrol` failed to be resolved on yourproject's Stack resolver.+Probably you will get this message since `deepcontrol` is just one of miner libraries yet.++    .../yourproject$ stack build+    While constructing the BuildPlan the following exceptions were encountered:+    ...++If you want to try other resolver, type as below:++    .../yourproject$ stack init+    Refusing to overwrite existing stack.yaml, please delete before running stack init or if you are sure use "--force"++Please follow the message direction.++### Fetch from [Hackage](https://hackage.haskell.org/package/deepcontrol)++Ok, I(you) got `deepcontrol` isn't in Stackage. Then let's fetch `deepcontrol` from Hackage.+Add `deepcontrol-0.1.0.0` to your extra-deps field in stack.yaml too:++stack.yaml:++    extra-deps:+    ...+    - deepcontrol-0.1.0.0++And type as below:++    .../yourproject$ stack build++Stack must fetch and install `deepcontrol` automatically.++    ../yourproject$ stack build+    deepcontrol-0.1.0.0: configure+    ...++Now start ghci and see if it works well.++    .../yourproject$ stack ghci+    ...+    Prelude> :m DeepControl.Applicative++## Installing with Cabal++`deepcontrol` is available from+[Hackage](https://hackage.haskell.org/package/deepcontrol).++Launch the terminal and go to your project folder:++    .../yourproject$++If you haven't done setup cabal sandbox on your project folder yet, type as below so that `deepcontrol` will be installed locally on your project folder:++    .../yourproject$ cabal sandbox init+    Writing a default package environment file to+    ...++To install `deepcontrol` on your project folder, type as below:++    .../yourproject$ cabal update+    Downloading the latest package list from hackage.haskell.org+    ...+    .../yourproject$ cabal install deepcontrol+    Resolving dependencies...+    ...+    +Now start ghci and see if it works well.++    .../yourproject$ cabal repl+    ...++    Prelude> :m DeepControl.Applicative++## Examples++### [Applicative](https://hackage.haskell.org/package/deepcontrol-0.1.0.0/docs/DeepControl-Applicative.html)++This module enables you to program in applicative style for more deeper level than the usual Applicative module expresses. +You would soon realize exactly what more deeper level means by reading the example codes below in order.++    Prelude> :m DeepControl.Applicative++#### Level-0++bra-ket notation:++    > (1+) |> 2 +    3+    > 1 <| (+2) +    3++    > 1 <|(+)|> 2 +    3+    > 1 <|(+)|> 2 <|(*)|> 3+    9++    > 1 <|(,)|> 2+    (1,2)++#### Level-1++bra-ket notation:++    > (1+) |$> [2] +    [3]+    > [1] <$| (+2) +    [3] +    > ("<"++)|$> ["a","b"] <$|(++">")+    ["<a>","<b>"]++    > [(1+)] |*> [2]+    [3]++    > [1] <$|(+)|*> [2]+    [3] +    > [1] <$|(+)|*> [0,1,2] +    [1,2,3]+    > [0,1] <$|(+)|*> [2,3] <$|(+)|*> [4,5]+    [6,7,7,8,7,8,8,9]++    > foldr (\x acc -> x <$|(:)|*> acc) ((*:) []) [Just 1, Just 2,  Just 3] +    Just [1,2,3]+    > foldr (\x acc -> x <$|(:)|*> acc) ((*:) []) [Just 1, Nothing, Just 3]+    Nothing++    > filter (even <$|(&&)|*> (10 >)) [1..100] +    [2,4,6,8]+    > filter (even <$|(&&)|*> (10 >) <$|(&&)|*> (5 <)) [1..100] +    [6,8]++braket-cover notation++    > [(1+)] |* 2 +    [3] +    > [1] <$|(+)|* 2 +    [3]+    > [1] <$|(+)|* 2 <$|(*)|* 3 +    [9]++    > Just 1 <$|(,)|* 2 +    Just (1,2)++    > 1 *| [(+2)] +    [3]+    > 1 *| [(+)] |* 2 +    [3]+    > 1 *|[(+),(-),(*),(^)]|* 2 +    [3,-1,2,1]++    > 1 *|Just (,)|* 2+    Just (1,2)++#### Level-2++bra-ket notation:++    > (+1) |$>> [[2]]+    [[3]]+    > [[2]] <<$| (+1)+    [[3]]++    > [Just 1] <<$|(+)|*>> [Just 2]+    [Just 3]+    > [Just 1] <<$|(,)|*>> [Just 2] +    [Just (1,2)]++    > [[1]] <<$|(+)|*>> [[2]] <<$|(-)|*>> [[3]]+    [[0]]++    > foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right (Just 2), Right (Just 3)] :: Either () (Maybe Int)+    Right (Just 6)+    > foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right Nothing, Right (Just 3)] :: Either () (Maybe Int)+    Right Nothing+    > foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) [Right (Just 1), Right Nothing, Left ()]+    Left ()++braket-cover notation:++    > [Just 1] <<$|(+)|** 2 +    [Just 3]+    > 1 **|(+)|$>> [Just 2] +    [Just 3]+    > 1 **|[Just (+)]|**  2 +    [Just 3]+    > 1 **|[Just (+), Just (-), Just (*), Nothing]|** 2 +    [Just 3,Just (-1),Just 2,Nothing]++    > [Just 1] <<$|(+)|-* [2] +    [Just 3]+    > [Just 1] <<$|(+)|*- Just 2 +    [Just 3]+    >      [1]  -*|(+)|$>> [Just 2] +    [Just 3]+    >   Just 1  *-|(+)|$>> [Just 2] +    [Just 3]+    >   Just 1  *-|[Just (+)]|** 2+    [Just 3]+    >   Just 1  *-|[Just (+)]|*- Just 2+    [Just 3]+    >      [1]  -*|[Just (+)]|*- Just 2+    [Just 3]+    >      [1]  -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2+    [Just 3,Just (-1),Just 2,Nothing]+    >    [0,1]  -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2+    [Just 2,Just 3,Just (-2),Just (-1),Just 0,Just 2,Nothing,Nothing]++#### Level-3++Work well likewise.++#### Level-4, Level-5++Not completely written up yet.++### [Monad](https://hackage.haskell.org/package/deepcontrol-0.1.0.0/docs/DeepControl-Monad.html)++This module enables you to program in Monad for more deeper level than the usual Monad module expresses.+You would soon realize exactly what more deeper level means by reading the example codes below in order.++#### Level-2++```haskell+import DeepControl.Applicative ((**:))+import DeepControl.Monad++listlist :: [[String]]             -- List-List Monad+listlist = [["a","b"]] >>== \x -> +           [[0],[1,2]] >>== \y -> +           (**:) $ x ++ show y++-- > listlist+-- [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]]+```++```haskell+import DeepControl.Applicative+import DeepControl.Monad++isJust (Just _) = True+isJust _        = False++pythagorean_triples :: [Maybe (Int, Int, Int)]  -- List-Maybe Monad+pythagorean_triples = filter isJust $+    [1..10] >-== \x ->+    [1..10] >-== \y ->+    [1..10] >-== \z ->+    guard (x < y && x*x + y*y == z*z) ->~+    (**:) (x,y,z)++-- > pythagorean_triples+-- [Just (3,4,5),Just (6,8,10)]+```++#### Level-3++```haskell+import DeepControl.Applicative+import DeepControl.Monad++isJust (Just _) = True+isJust _        = False++pythagorean_triples :: IO [Maybe (Int, Int, Int)]  -- IO-List-Maybe Monad+pythagorean_triples = filter isJust |$> (+    [1..10] ->-== \x ->+    [1..10] ->-== \y ->+    [1..10] ->-== \z ->+    guard (x < y && x*x + y*y == z*z) -->~+    print (x,y,z) >--~+    (***:) (x,y,z)+  )++-- > pythagorean_triples+-- (3,4,5)+-- (6,8,10)+-- [Just (3,4,5),Just (6,8,10)]+```++### [Arrow](https://hackage.haskell.org/package/deepcontrol-0.1.0.0/docs/DeepControl-Arrow.html)++### [Commutative](https://hackage.haskell.org/package/deepcontrol-0.1.0.0/docs/DeepControl-Commutative.html)++

@@ -1,7 +1,7 @@ name:                deepcontrol-version:             0.1.0.0-synopsis:            Enable deeper level style of programming than the usual control provides-description:         This module enables deeper level style of programming than the usual control provides, especially for Applicative and Monad.+version:             0.2.0.0+synopsis:            Enable more deeper level style of programming than the usual Control.xxx modules express+description:         This module enables more deeper level style of programming than the usual Control.xxx modules provides, especially for Applicative and Monad. license:             BSD3 license-file:        LICENSE author:              KONISHI Yohsuke@@ -12,22 +12,35 @@ build-type:          Simple -- extra-source-files:   cabal-version:       >=1.10+extra-source-files:  README.md +bug-reports:         https://github.com/ocean0yohsuke/deepcontrol/issues++source-repository head+  type:           git+  location:       https://github.com/ocean0yohsuke/deepcontrol.git+ library   exposed-modules:     DeepControl.Arrow                      , DeepControl.Applicative                      , DeepControl.Commutative                      , DeepControl.Monad+                     , DeepControl.Monad.Except+                     , DeepControl.Monad.List+                     , DeepControl.Monad.Maybe                      , DeepControl.Monad.RWS                      , DeepControl.Monad.Reader                      , DeepControl.Monad.State                      , DeepControl.Monad.Writer+                     , DeepControl.MonadTrans   -- other-modules:       -  other-extensions:    Arrows-  build-depends:       base >=4.8 && <4.9, mtl >=2.2 && <2.3+  -- other-extensions:    +  build-depends:       base >=4.8 && <4.9+                     , mtl >=2.2 && <2.3+                     , transformers   --hs-source-dirs:         default-language:    Haskell2010-  Ghc-Options:         -Wall -O2+  --Ghc-Options:         -Wall -O2  Test-Suite doctest   Type:                 exitcode-stdio-1.0

@@ -159,10 +159,13 @@          , [[1]] <<$|(+)|** 2 <<$|(-)|** 3    ~?= [[0]]         , 1 **|(+)|$>> [[2]] <<$|(-)|** 3    ~?= [[0]]+        ] +{-+    , TestList $ ("*>>, <<*, -*>, <-*, *->, <*-" ~:) |$> [           ]-+-}     ]  tLevel3 = ("Level3" ~:) |$> [