deepcontrol 0.4.3.0 → 0.5.1.0

raw patch · 24 files changed

+1647/−1428 lines, 24 filesdep ~basedep ~mtldep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, mtl, transformers

API changes (from Hackage documentation)

Files

• DeepControl/Applicative.hs +142/−142
• DeepControl/Arrow.hs +26/−26
• DeepControl/Commutative.hs +0/−183
• DeepControl/Monad.hs +148/−152
• DeepControl/Monad/Morph.hs +377/−30
• DeepControl/Monad/Signatures.hs +1/−1
• DeepControl/Monad/Trans.hs +102/−531
• DeepControl/Monad/Trans/Except.hs +27/−17
• DeepControl/Monad/Trans/Identity.hs +313/−116
• DeepControl/Monad/Trans/Writer.hs +1/−1
• DeepControl/Traversable.hs +135/−0
• README.md +147/−105
• deepcontrol.cabal +16/−6
• test/doctests.hs +6/−3
• test/unit_Applicative.hs +7/−7
• test/unit_Commutative.hs +0/−30
• test/unit_Monad-Level2.hs +22/−23
• test/unit_Monad-factorial.hs +10/−4
• test/unit_Monad-factorial2.hs +10/−4
• test/unit_Monad.hs +21/−21
• test/unit_MonadMorph-bind.hs +82/−0
• test/unit_MonadTrans-ackermann.hs +16/−16
• test/unit_MonadTrans.hs +8/−10
• test/unit_Traversable.hs +30/−0

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Applicative-Description : Enable deep level Applicative style programming.+Description : Deepened the usual Control.Applicative module. Copyright   : (c) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com@@ -19,7 +19,7 @@      -- * Level-1     -- ** cover notation-    (*:),+    (.*),     -- ** bra-ket notation     (|$>), (<$|), (|*>), (<*|),     -- ** cover-bracket notation@@ -27,7 +27,7 @@      -- * Level-2     -- ** cover notation-    (**:), (-*),+    (.**), (-*),     -- ** bra-ket notation     (|$>>), (<<$|), (|*>>), (<<*|),     -- ** cover-bracket notation@@ -39,7 +39,7 @@      -- * Level-3     -- ** cover notation-    (***:), +    (.***),      (*-*), (-**),      (--*),     -- ** bra-ket notation@@ -61,7 +61,7 @@      -- * Level-4     -- ** cover notation-    (****:), +    (.****),      (---*),     (--**), (-*-*), (*--*),      (-***), (*-**), (**-*),@@ -88,7 +88,7 @@      -- * Level-5     -- ** cover notation-    (*****:), +    (.*****),      (----*),      (---**), (--*-*), (-*--*), (*---*),     (--***), (-*-**), (*--**), (*-*-*), (-**-*), (**--*),@@ -132,7 +132,7 @@ (|>) :: (a -> b) -> a -> b (|>) = ($) --- | The auguments-flipped function for @'|>'@. +-- | The auguments-flipped function of @'|>'@.  --  -- >>> 1 <| (+2)  -- 3 @@ -149,10 +149,10 @@ ------------------------------------------------------------------------------- -- Level-1 functions -infixl 6  *:+infixl 6  .* -- | Alias to @'pure'@.-(*:) :: (Applicative f) => a -> f a-(*:) = pure+(.*) :: (Applicative f) => a -> f a+(.*) = pure  infixl 4 |$> -- | Alias to @'<$>'@.@@ -164,7 +164,7 @@  infixl 3  <$|, |*>, <*|, |*, *| --- | The auguments-flipped function for @'|$>'@.+-- | The auguments-flipped function of @'|$>'@. -- -- >>> [1] <$| (+2)  -- [3]@@ -186,9 +186,9 @@ -- >>> [0,1] <$|(+)|*> [2,3] <$|(^)|*> [4,5] -- [16,32,81,243,81,243,256,1024] ----- >>> foldr (\x acc -> x <$|(:)|*> acc) ((*:) []) [Just 1, Just 2,  Just 3]+-- >>> 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]+-- >>> foldr (\x acc -> x <$|(:)|*> acc) ((.*) []) [Just 1, Nothing, Just 3] -- Nothing -- -- >>> filter (even <$|(&&)|*> (10 >)) [1..100]@@ -198,11 +198,11 @@ (|*>) :: Applicative f => f (a -> b) -> f a -> f b (|*>) = (<*>) --- | The auguments-flipped function for @'|*>'@. +-- | The auguments-flipped function of @'|*>'@.  (<*|) :: Applicative f => f a -> f (a -> b) -> f b (<*|) = flip (|*>) --- | Definition: @ f |* x = f |*> (*:) x @+-- | Definition: @ f |* x = f |*> (.*) x @ -- -- >>> [(1+)] |* 2 -- [3]@@ -221,9 +221,9 @@ -- [('a',"b1",'c',"d1"),('a',"b1",'c',"d2"),('a',"b2",'c',"d1"),('a',"b2",'c',"d2")] -- (|*) :: Applicative f => f (a -> b) -> a -> f b-f |* x = f |*> (*:) x+f |* x = f |*> (.*) x --- | The auguments-flipped function for @'|*'@. +-- | Definition: @ (*|) = (.*) x <*| f @ -- -- >>> 1 *| [(+2)] -- [3]@@ -235,28 +235,27 @@ -- >>> 1 *|Just (,)|* 2 -- Just (1,2) (*|) :: Applicative f => a -> f (a -> b) -> f b-(*|) = flip (|*)+x *| f = (.*) x <*| f  ------------------------------------------------------------------------------- -- Level-2 functions -infixl 6  **:+infixl 6  .** infixl 6  -*--- | Definition: @ (**:) = (*:) . (*:) @+-- | Definition: @ (.**) = (.*) . (.*) @ ----- >>> (**:) 1 :: Maybe [Int]+-- >>> (.**) 1 :: Maybe [Int] -- Just [1]-(**:) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a)-(**:) = (*:) . (*:)--- | Definition: @ (-*) = ((*:)|$>)  @+(.**) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a)+(.**) = (.*) . (.*)+-- | Definition: @ (-*) = ((.*)|$>)  @ -- -- >>> (-*) (Just 1) :: Maybe [Int] -- Just [1] (-*) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 a)-(-*) = ((*:)|$>) +(-*) = ((.*)|$>)   infixl 4  |$>>- -- | Definition: @ (|$>>) = (|$>) . (|$>) @ -- -- >>> (+1) |$>> [[2]]@@ -268,14 +267,14 @@ infixl 3  |**, **| infixl 3  |-*, |*-, -*|, *-| --- | The auguments-flipped function for @'|$>>'@+-- | The auguments-flipped function of @'|$>>'@ -- -- >>> [[2]] <<$| (+1) -- [[3]] (<<$|) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b) (<<$|) = flip (|$>>) --- | Definition: @ (|*>>) = liftA2 (|*>) @+-- | Definition: @ f |*>> x = f <$|(|*>)|*> x @ -- -- >>> [Just 1] <<$|(+)|*>> [Just 2]  -- [Just 3]@@ -286,27 +285,28 @@ -- >>> [[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 (|*>)+-- (|*>>) = liftA2 (|*>)+f |*>> x = f <$|(|*>)|*> x  -- | Definition: @ (<<*|) = liftA2 (<*|) @ (<<*|) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 (a -> b)) -> f1 (f2 b)-(<<*|) = liftA2 (<*|)+x <<*| f = x <$|(<*|)|*> f --- | Definition: @ f |** x = f |*>> (**:) x @+-- | Definition: @ 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 --- | Definition: @ x **| f = (**:) x <<*| f @+-- | Definition: @ x **| f = (.**) x <<*| f @ -- -- >>> 1 **|(+)|$>> [Just 2] -- [Just 3]@@ -316,7 +316,7 @@ -- >>> 1 **|[Just (+), Just (-), Just (*), Nothing]|** 2 -- [Just 3,Just (-1),Just 2,Nothing] (**|) :: (Applicative f1, Applicative f2) => a -> f1 (f2 (a -> b)) -> f1 (f2 b)-x **| f = (**:) x <<*| f+x **| f = (.**) x <<*| f  -- | Definition: @ f |-* x = f |*>> (-*) x @ --@@ -325,12 +325,12 @@ (|-*) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f1 a -> f1 (f2 b) f |-* x = f |*>> (-*) x --- | Definition: @ f |*- x = f |*>> (*:) x @+-- | Definition: @ 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  -- | Definition: @ x -*| f = (-*) x <<*| f @ --@@ -339,7 +339,7 @@ (-*|) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 (a -> b)) -> f1 (f2 b) x -*| f = (-*) x <<*| f --- | Definition: @ x *-| f = (*:) x <<*| f @+-- | Definition: @ x *-| f = (.*) x <<*| f @ -- -- >>> Just 1 *-|(+)|$>> [Just 2] -- [Just 3]@@ -359,14 +359,14 @@ -- 2 -- [3] (*-|) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 (a -> b)) -> f1 (f2 b)-x *-| f = (*:) x <<*| f+x *-| f = (.*) x <<*| f  infixl 5  <<*, *>> infixl 5  *->, <*-, -*>, <-* --- | Definition: @ (*>>) = liftA2 (*>) @+-- | Definition: @ f *>> x = f <$|(*>)|*> x @ ----- >>> sequence $ Just (print 1) *>> (**:) 2+-- >>> sequence $ Just (print 1) *>> (.**) 2 -- 1 -- Just 2 --@@ -374,26 +374,26 @@ -- 1 -- Just 2 (*>>) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 b)-(*>>) = liftA2 (*>)+f *>> x = f <$|(*>)|*> x  -- | Definition: @ (<<*) = liftA2 (<*) @ ----- >>> sequence $ (**:) 2 <<* Just (print 1)+-- >>> sequence $ (.**) 2 <<* Just (print 1) -- 1 -- Just 2--- >>> sequence $ Just (print 1) *>> (**:) 3 <<* Just (print 2)+-- >>> sequence $ Just (print 1) *>> (.**) 3 <<* Just (print 2) -- 1 -- 2 -- Just 3 ----- >>> sequence $ [putStr "1", putStr "2"] *>> (**:) 0 <<* [putStr "3", putStr "4"]+-- >>> sequence $ [putStr "1", putStr "2"] *>> (.**) 0 <<* [putStr "3", putStr "4"] -- 13142324[0,0,0,0] (<<*) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 a)-(<<*) = liftA2 (<*)+x <<* f = x <$|(<*)|*> f  -- | Definition: @ a -*> x = (-*) a *>> x @ ----- >>> print 1 -*> (*:) (Just 2)+-- >>> print 1 -*> (.*) (Just 2) -- 1 -- Just 2 (-*>) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 b) -> f1 (f2 b)@@ -401,54 +401,54 @@  -- | Definition: @ x <-* a = x <<* (-*) a @ ----- >>> (*:) (Just 2) <-* print 1+-- >>> (.*) (Just 2) <-* print 1 -- 1 -- Just 2--- >>> print 1 -*> (*:) (Just 3) <-* print 2+-- >>> print 1 -*> (.*) (Just 3) <-* print 2 -- 1 -- 2 -- Just 3--- >>> print 1 -*> (*:) (Just 3) <*- Nothing+-- >>> print 1 -*> (.*) (Just 3) <*- Nothing -- 1 -- Nothing (<-*) :: (Applicative f1, Applicative f2) => f1 (f2 b) -> f1 a -> f1 (f2 b) x <-* a = x <<* (-*) a --- | Definition: @ a *-> x = (*:) a *>> x @+-- | Definition: @ a *-> x = (.*) a *>> x @ ----- >>> sequence $ print 1 *-> Just ((*:) 2)+-- >>> sequence $ print 1 *-> Just ((.*) 2) -- 1 -- Just 2 (*->) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 b) -> f1 (f2 b)-a *-> x = (*:) a *>> x+a *-> x = (.*) a *>> x --- | Definition: @ x <*- a = x <<* (*:) a @+-- | Definition: @ x <*- a = x <<* (.*) a @ ----- >>> sequence $ Just ((*:) 2) <*- print 1+-- >>> sequence $ Just ((.*) 2) <*- print 1 -- 1 -- Just 2--- >>> sequence $ print 1 *-> Just ((*:) 3) <*- print 2+-- >>> sequence $ print 1 *-> Just ((.*) 3) <*- print 2 -- 1 -- 2 -- Just 3--- >>> sequence $ print 1 *-> Just ((*:) 3) <-* Nothing+-- >>> sequence $ print 1 *-> Just ((.*) 3) <-* Nothing -- Nothing (<*-) :: (Applicative f1, Applicative f2) => f1 (f2 b) -> f2 a -> f1 (f2 b)-x <*- a = x <<* (*:) a+x <*- a = x <<* (.*) a  ------------------------------------------------------------------------------- -- Level-3 functions -infixl 6  ***:-(***:) :: (Applicative f1, Applicative f2, Applicative f3) => a -> f1 (f2 (f3 a))-(***:) = (*:) . (**:)+infixl 6  .***+(.***) :: (Applicative f1, Applicative f2, Applicative f3) => a -> f1 (f2 (f3 a))+(.***) = (.*) . (.**) infixl 6  -**, *-*, --* (--*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 a) -> f1 (f2 (f3 a)) (--*) = ((-*)|$>) (-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 a))-(-**) = ((**:)|$>) +(-**) = ((.**)|$>)  (*-*) :: (Applicative f1, Applicative f2, Applicative f3) => f2 a -> f1 (f2 (f3 a))-(*-*) = (--*) . (*:) +(*-*) = (--*) . (.*)   infixl 4  |$>>> (|$>>>) :: (Functor f1, Functor f2, Functor f3) => (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))@@ -458,15 +458,15 @@ (<<<$|) :: (Functor f1, Functor f2, Functor f3) => f1 (f2 (f3 a)) -> (a -> b) -> f1 (f2 (f3 b)) (<<<$|) = flip (|$>>>) (|*>>>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))-(|*>>>) = liftA2 (|*>>)+f |*>>> x = f <$|(|*>>)|*> x (<<<*|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(<<<*|) = flip (|*>>>)+x <<<*| f = x <$|(<<*|)|*> f  infixl 3  |***, ***| (|***) :: (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 (|***)+x ***| f = (.***) x <<<*| f  infixl 3  |-**, |*-*, |**-, |--*, |-*-, |*-- (|-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 a -> f1 (f2 (f3 b))@@ -474,43 +474,43 @@ (|*-*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f2 a -> f1 (f2 (f3 b)) 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 (|*--) :: (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 -infixl 3  -**|, *-*|, **-|, --*|, -*-|, *--|+infixl 3  --*|, -*-|, *--|, -**|, *-*|, **-|+(--*|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))+x --*| f = (--*) x <<<*| f+(-*-|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f3 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))+x -*-| f = (-*) x <<<*| f+(*--|) :: (Applicative f1, Applicative f2, Applicative f3) => f2 (f3 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))+x *--| f = (.*) x <<<*| f (-**|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(-**|) = flip (|-**)+x -**| f = (-**) x <<<*| f (*-*|) :: (Applicative f1, Applicative f2, Applicative f3) => f2 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(*-*|) = flip (|*-*)+x *-*| f = (*-*) x <<<*| f (**-|) :: (Applicative f1, Applicative f2, Applicative f3) => f3 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(**-|) = flip (|**-)-(--*|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(--*|) = flip (|--*)-(*--|) :: (Applicative f1, Applicative f2, Applicative f3) => f2 (f3 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(*--|) = flip (|*--)-(-*-|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f3 a) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))-(-*-|) = flip (|-*-)+x **-| f = (.**) x <<<*| f  infixl 5  <<<*, *>>> (*>>>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))-(*>>>) = liftA2 (*>>)+f *>>> x = f <$|(*>>)|*> x (<<<*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 a))-(<<<*) = liftA2 (<<*)+x <<<* f = x <$|(<<*)|*> f  infixl 5  *-->, -*->, --*>, **->, *-*>, -**> (*-->) :: (Applicative f1, Applicative f2, Applicative f3) => f2 (f3 a) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))-a *--> x = (*:) a *>>> x+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+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))@@ -518,13 +518,13 @@  infixl 5  <*--, <-*-, <--*, <**-, <*-*, <-** (<*--) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 b)) -> f2 (f3 a) -> f1 (f2 (f3 b))-x <*-- a = x <<<* (*:) a+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 +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))@@ -533,9 +533,9 @@ -------------------------------------------------------------------------------- -- Level-4 functions -infixl 6  ****:-(****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => a -> f1 (f2 (f3 (f4 a)))-(****:) = (***:) . (*:)+infixl 6  .****+(.****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => a -> f1 (f2 (f3 (f4 a)))+(.****) = (.***) . (.*) infixl 6  ---* (---*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 a))) (---*) = ((--*)|$>)@@ -545,14 +545,14 @@ (-*-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f3 a) -> f1 (f2 (f3 (f4 a))) (-*-*) = (---*) . (-*) (*--*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f2 (f3 a) -> f1 (f2 (f3 (f4 a)))-(*--*) = (---*) . (*:)+(*--*) = (---*) . (.*) infixl 6  -***, *-**, **-* (-***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 a -> f1 (f2 (f3 (f4 a)))-(-***) = ((***:)|$>) +(-***) = ((.***)|$>)  (*-**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f2 a -> f1 (f2 (f3 (f4 a))) (*-**) = (---*) . (*-*)  (**-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f3 a -> f1 (f2 (f3 (f4 a)))-(**-*) = (---*) . (**:)+(**-*) = (---*) . (.**)  infixl 4  |$>>>> (|$>>>>) :: (Functor f1, Functor f2, Functor f3, Functor f4) => (a -> b) -> f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b)))@@ -562,13 +562,13 @@ (<<<<$|) :: (Functor f1, Functor f2, Functor f3, Functor f4) => f1 (f2 (f3 (f4 a))) -> (a -> b) -> f1 (f2 (f3 (f4 b))) (<<<<$|) = flip (|$>>>>) (|*>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b)))-(|*>>>>) = liftA2 (|*>>>)+f |*>>>> x = f <$|(|*>>>)|*> x (<<<<*|) :: (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 (|*>>>>)+x <<<<*| f = x <$|(<<<*|)|*> f  infixl 3  |**** (|****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> a -> f1 (f2 (f3 (f4 b)))-f |**** x = f |*>>>> (****:) x+f |**** x = f |*>>>> (.****) x infixl 3  |-***, |*-**, |**-*, |***-   (|-***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 a -> f1 (f2 (f3 (f4 b))) f |-*** x = f |*>>>> (-***) x@@ -577,7 +577,7 @@ (|**-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f3 a -> f1 (f2 (f3 (f4 b))) f |**-* x = f |*>>>> (**-*) x (|***-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f4 a -> f1 (f2 (f3 (f4 b)))-f |***- x = f |*>>>> (***:) x+f |***- x = f |*>>>> (.***) x infixl 3  |--**, |-*-*, |*--*, |*-*-, |-**-, |**-- (|--**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 a) -> f1 (f2 (f3 (f4 b))) f |--** x = f |*>>>> (--**) x@@ -590,7 +590,7 @@ (|-**-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f4 a) -> f1 (f2 (f3 (f4 b))) f |-**- x = f |*>>>> (-**) x (|**--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f3 (f4 a) -> f1 (f2 (f3 (f4 b)))-f |**-- x = f |*>>>> (**:) x+f |**-- x = f |*>>>> (.**) x infixl 3  |---*, |--*-, |-*--, |*--- (|---*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 b))) f |---* x = f |*>>>> (---*) x@@ -599,11 +599,11 @@ (|-*--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b))) f |-*-- x = f |*>>>> (-*) x (|*---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 (a -> b)))) -> f2 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b)))-f |*--- x = f |*>>>> (*:) x+f |*--- x = f |*>>>> (.*) x  infixl 3  ****| (****|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => a -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))-(****|)  = flip (|****)+x ****| f = (.****) x <<<<*| f infixl 3  -***|, *-**|, **-*|, ***-|    (-***|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 a -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))@@ -613,7 +613,7 @@ (**-*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f3 a -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) x **-*| f = (**-*) x <<<<*| f (***-|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f4 a -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))-x ***-| f = (***:) x <<<<*| f+x ***-| f = (.***) x <<<<*| f infixl 3  --**|, -*-*|, *--*|, *-*-|, -**-|, **--| (--**|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 a) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) x --**| f = (--**) x <<<<*| f@@ -626,7 +626,7 @@ (-**-|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f4 a) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) x -**-| f = (-**) x <<<<*| f (**--|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f3 (f4 a) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))-x **--| f = (**:) x <<<<*| f+x **--| f = (.**) x <<<<*| f infixl 3  ---*|, --*-|, -*--|, *---| (---*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) x ---*| f = (---*) x <<<<*| f@@ -635,13 +635,13 @@ (-*--|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f3 (f4 a)) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b))) x -*--| f = (-*) x <<<<*| f (*---|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f2 (f3 (f4 a)) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))-x *---| f = (*:) x <<<<*| f+x *---| f = (.*) x <<<<*| f  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 (*>>>)+f *>>>> x = f <$|(*>>>)|*> x (<<<<*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 a)))-(<<<<*) = liftA2 (<<<*)+x <<<<* f = x <$|(<<<*)|*> f  infixl 5  <---*, <--*-, <-*--, <*--- (<---*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 b)))@@ -651,7 +651,7 @@ (<-*--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f1 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b))) x <-*-- a = x <<<<* (-*) a (<*---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f2 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b)))-x <*--- a = x <<<<* (*:) a+x <*--- a = x <<<<* (.*) a infixl 5  <--**, <-*-*, <*--*, <*-*-, <-**-, <**-- (<--**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f1 (f2 a) -> f1 (f2 (f3 (f4 b))) x <--** a = x <<<<* (--**) a@@ -664,7 +664,7 @@ (<-**-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f1 (f4 a) -> f1 (f2 (f3 (f4 b))) x <-**- a = x <<<<* (-**) a (<**--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f3 (f4 a) -> f1 (f2 (f3 (f4 b)))-x <**-- a = x <<<<* (**:) a+x <**-- a = x <<<<* (.**) a infixl 5  <-***, <*-**, <**-*, <***- (<-***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f1 a -> f1 (f2 (f3 (f4 b))) x <-*** a = x <<<<* (-***) a@@ -673,7 +673,7 @@ (<**-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f3 a -> f1 (f2 (f3 (f4 b))) x <**-* a = x <<<<* (**-*) a (<***-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 b))) -> f4 a -> f1 (f2 (f3 (f4 b)))-x <***- a = x <<<<* (***:) a+x <***- a = x <<<<* (.***) a  infixl 5  ---*>, --*->, -*-->, *---> (---*>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b)))@@ -683,7 +683,7 @@ (-*-->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) a -*--> x = (-*) a *>>>> x (*--->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f2 (f3 (f4 a)) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b)))-a *---> x = (*:) a *>>>> x+a *---> x = (.*) a *>>>> x infixl 5  --**>, -*-*>, *--*>, *-*->, -**->, **--> (--**>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 a) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) a --**> x = (--**) a *>>>> x@@ -696,7 +696,7 @@ (-**->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f4 a) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) a -**-> x = (-**) a *>>>> x (**-->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f3 (f4 a) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b)))-a **--> x = (**:) a *>>>> x+a **--> x = (.**) a *>>>> x infixl 5  -***>, *-**>, **-*>, ***-> (-***>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 a -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) a -***> x = (-***) a *>>>> x@@ -705,48 +705,48 @@ (**-*>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f3 a -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b))) a **-*> x = (**-*) a *>>>> x (***->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f4 a -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b)))-a ***-> x = (***:) a *>>>> x+a ***-> x = (.***) a *>>>> x  ------------------------------------------------------------------------------- -- Level-5 functions -infixl 6  *****:-(*****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => a -> f1 (f2 (f3 (f4 (f5 a))))-(*****:) = (*:) . (****:)+infixl 6  .*****+(.*****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => a -> f1 (f2 (f3 (f4 (f5 a))))+(.*****) = (.*) . (.****) infixl 6  ----* (----*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (f5 a)))) (----*) = ((---*)|$>) infixl 6  ---**, --*-*, -*--*, *---* (---**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (f5 a))))-(---**) = ((**:)|$>>>)+(---**) = ((.**)|$>>>) (--*-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f4 a)) -> f1 (f2 (f3 (f4 (f5 a)))) (--*-*) = (----*) . (--*) (-*--*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f3 (f4 a)) -> f1 (f2 (f3 (f4 (f5 a)))) (-*--*) = (----*) . (-*) (*---*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f3 (f4 a)) -> f1 (f2 (f3 (f4 (f5 a))))-(*---*) = (----*) . (*:)+(*---*) = (----*) . (.*) infixl 6  --***, -*-**, *--**, *-*-*, -**-*, **--* (--***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 a) -> f1 (f2 (f3 (f4 (f5 a)))) (--***) = ((-***)|$>) (-*-**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f3 a) -> f1 (f2 (f3 (f4 (f5 a)))) (-*-**) = (---**) . (-*) (*--**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f3 a) -> f1 (f2 (f3 (f4 (f5 a))))-(*--**) = (---**) . (*:)+(*--**) = (---**) . (.*) (*-*-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f4 a) -> f1 (f2 (f3 (f4 (f5 a)))) (*-*-*) = (----*) . (*-*) (-**-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f4 a) -> f1 (f2 (f3 (f4 (f5 a)))) (-**-*) = (----*) . (-**) (**--*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f3 (f4 a) -> f1 (f2 (f3 (f4 (f5 a))))-(**--*) = (----*) . (**:)+(**--*) = (----*) . (.**) infixl 6  -****, *-***, **-**, ***-* (-****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 a -> f1 (f2 (f3 (f4 (f5 a))))-(-****) = ((****:)|$>)+(-****) = ((.****)|$>) (*-***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 a -> f1 (f2 (f3 (f4 (f5 a))))-(*-***) = (--***) . (*:)+(*-***) = (--***) . (.*) (**-**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f3 a -> f1 (f2 (f3 (f4 (f5 a))))-(**-**) = (---**) . (**:)+(**-**) = (---**) . (.**) (***-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f4 a -> f1 (f2 (f3 (f4 (f5 a))))-(***-*) = (----*) . (***:)+(***-*) = (----*) . (.***)  infixl 4  |$>>>>> (|$>>>>>) :: (Functor f1, Functor f2, Functor f3, Functor f4, Functor f5) => (a -> b) -> f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b))))@@ -755,9 +755,9 @@ (<<<<<$|) :: (Functor f1, Functor f2, Functor f3, Functor f4, Functor f5) => f1 (f2 (f3 (f4 (f5 a)))) -> (a -> b) -> f1 (f2 (f3 (f4 (f5 b)))) (<<<<<$|) = flip (|$>>>>>) (|*>>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b))))-(|*>>>>>) = liftA2 (|*>>>>)+f |*>>>>> x = f <$|(|*>>>>)|*> x (<<<<<*|) :: (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 (|*>>>>>)+x <<<<<*| f = x <$|(<<<<*|)|*> f  infixl 3  |-****, |*-***, |**-**, |***-*, |****- (|-****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 a -> f1 (f2 (f3 (f4 (f5 b))))@@ -769,7 +769,7 @@ (|***-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f4 a -> f1 (f2 (f3 (f4 (f5 b)))) f |***-* x = f |*>>>>> (***-*) x (|****-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f5 a -> f1 (f2 (f3 (f4 (f5 b))))-f |****- x = f |*>>>>> (****:) x+f |****- x = f |*>>>>> (.****) x infixl 3  |--***, |-*-**, |*--**, |*-*-*, |-**-*, |**--*, |**-*-, |*-**-, |-***-, |***-- (|--***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 a) -> f1 (f2 (f3 (f4 (f5 b)))) f |--*** x = f |*>>>>> (--***) x@@ -790,7 +790,7 @@ (|-***-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f5 a) -> f1 (f2 (f3 (f4 (f5 b)))) f |-***- x = f |*>>>>> (-***) x (|***--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f4 (f5 a) -> f1 (f2 (f3 (f4 (f5 b))))-f |***-- x = f |*>>>>> (***:) x+f |***-- x = f |*>>>>> (.***) x infixl 3  |---**, |--*-*, |-*--*, |*---*, |*--*-, |-*-*-, |--**-, |-**--, |*-*--, |**--- (|---**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (f5 b)))) f |---** x = f |*>>>>> (---**) x@@ -811,7 +811,7 @@ (|*-*--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f2 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b)))) f |*-*-- x = f |*>>>>> (*-*) x (|**---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f3 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b))))-f |**--- x = f |*>>>>> (**:) x+f |**--- x = f |*>>>>> (.**) x infixl 3  |----*, |---*-, |--*--, |-*---, |*---- (|----*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (f5 b)))) f |----* x = f |*>>>>> (----*) x@@ -822,7 +822,7 @@ (|-*---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b)))) f |-*--- x = f |*>>>>> (-*) x (|*----) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f2 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b))))-f |*---- x = f |*>>>>> (*:) x+f |*---- x = f |*>>>>> (.*) x  infixl 3  -****|, *-***|, **-**|, ***-*|, ****-| (-****|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 a -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))@@ -834,7 +834,7 @@ (***-*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f4 a -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x ***-*| f = (***-*) x <<<<<*| f (****-|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f5 a -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))-x ****-| f = (****:) x <<<<<*| f+x ****-| f = (.****) x <<<<<*| f infixl 3  --***|, -*-**|, *--**|, *-*-*|, -**-*|, **--*|, **-*-|, *-**-|, -***-|, ***--|  (--***|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 a) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x --***| f = (--***) x <<<<<*| f@@ -855,7 +855,7 @@ (-***-|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f5 a) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x -***-| f = (-***) x <<<<<*| f (***--|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f4 (f5 a) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))-x ***--| f = (***:) x <<<<<*| f+x ***--| f = (.***) x <<<<<*| f infixl 3  ---**|, --*-*|, -*--*|, *---*|, *--*-|, -*-*-|, --**-|, -**--|, *-*--|, **---| (---**|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x ---**| f = (---**) x <<<<<*| f@@ -876,7 +876,7 @@ (*-*--|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x *-*--| f = (*-*) x <<<<<*| f (**---|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f3 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))-x **---| f = (**:) x <<<<<*| f+x **---| f = (.**) x <<<<<*| f infixl 3  ----*|, ---*-|, --*--|, -*---|, *----| (----*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x ----*| f = (----*) x <<<<<*| f@@ -887,13 +887,13 @@ (-*---|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b)))) x -*---| f = (-*) x <<<<<*| f (*----|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))-x *----| f = (*:) x <<<<<*| f+x *----| f = (.*) x <<<<<*| f  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 (*>>>>)+f *>>>>> x = f <$|(*>>>>)|*> x (<<<<<*) :: (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 (<<<<*)+x <<<<<* f = x <$|(<<<<*)|*> f  infixl 5  <----*, <---*-, <--*--, <-*---, <*---- (<----*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (f5 b))))@@ -905,7 +905,7 @@ (<-*---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b)))) x <-*--- a = x <<<<<* (-*) a (<*----) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f2 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b))))-x <*---- a = x <<<<<* (*:) a+x <*---- a = x <<<<<* (.*) a infixl 5  <---**, <--*-*, <-*--*, <*---*, <*--*-, <-*-*-, <--**-, <-**--, <*-*--, <**--- (<---**) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (f5 b)))) x <---** a = x <<<<<* (---**) a@@ -926,7 +926,7 @@ (<*-*--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f2 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b)))) x <*-*-- a = x <<<<<* (*-*) a (<**---) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f3 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b))))-x <**--- a = x <<<<<* (**:) a+x <**--- a = x <<<<<* (.**) a infixl 5  <--***, <-*-**, <*--**, <*-*-*, <-**-*, <**--*, <**-*-, <*-**-, <-***-, <***-- (<--***) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 a) -> f1 (f2 (f3 (f4 (f5 b)))) x <--*** a = x <<<<<* (--***) a@@ -947,7 +947,7 @@ (<-***-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f5 a) -> f1 (f2 (f3 (f4 (f5 b)))) x <-***- a = x <<<<<* (-***) a (<***--) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f4 (f5 a) -> f1 (f2 (f3 (f4 (f5 b))))-x <***-- a = x <<<<<* (***:) a+x <***-- a = x <<<<<* (.***) a infixl 5  <-****, <*-***, <**-**, <***-*, <****- (<-****) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f1 a -> f1 (f2 (f3 (f4 (f5 b)))) x <-**** a = x <<<<<* (-****) a@@ -958,7 +958,7 @@ (<***-*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f4 a -> f1 (f2 (f3 (f4 (f5 b)))) x <***-* a = x <<<<<* (***-*) a (<****-) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 b)))) -> f5 a -> f1 (f2 (f3 (f4 (f5 b))))-x <****- a = x <<<<<* (****:) a+x <****- a = x <<<<<* (.****) a  infixl 5  ----*>, ---*->, --*-->, -*--->, *----> (----*>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))@@ -970,7 +970,7 @@ (-*--->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a -*---> x = (-*) a *>>>>> x (*---->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f3 (f4 (f5 a))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))-a *----> x = (*:) a *>>>>> x+a *----> x = (.*) a *>>>>> x infixl 5  ---**>, --*-*>, -*--*>, *---*>, *--*->, -*-*->, --**->, -**-->, *-*-->, **---> (---**>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a ---**> x = (---**) a *>>>>> x@@ -991,7 +991,7 @@ (*-*-->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f2 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a *-*--> x = (*-*) a *>>>>> x (**--->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f3 (f4 (f5 a)) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))-a **---> x = (**:) a *>>>>> x+a **---> x = (.**) a *>>>>> x infixl 5  --***>, -*-**>, *--**>, *-*-*>, -**-*>, **--*>, **-*->, *-**->, -***->, ***--> (--***>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 a) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a --***> x = (--***) a *>>>>> x@@ -1012,7 +1012,7 @@ (-***->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f5 a) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a -***-> x = (-***) a *>>>>> x (***-->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f4 (f5 a) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))-a ***--> x = (***:) a *>>>>> x+a ***--> x = (.***) a *>>>>> x infixl 5  -****>, *-***>, **-**>, ***-*>, ****-> (-****>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 a -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a -****> x = (-****) a *>>>>> x@@ -1023,5 +1023,5 @@ (***-*>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f4 a -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b)))) a ***-*> x = (***-*) a *>>>>> x (****->) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f5 a -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))-a ****-> x = (****:) a *>>>>> x+a ****-> x = (.****) a *>>>>> x 

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Arrow-Description : Enable deep level Arrow programming.+Description : Deepened the usual Control.Arrow module. Copyright   : (c) Ross Paterson 2002,               (c) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution)@@ -20,7 +20,7 @@     ) where   import DeepControl.Applicative-import DeepControl.Commutative+import DeepControl.Traversable import DeepControl.Monad import Control.Arrow import Prelude hiding (id, (.))@@ -31,54 +31,54 @@  newtype Kleisli2 m1 m2 a b = Kleisli2 { runKleisli2 :: a -> m1 (m2 b) } -instance (Monad m1, Monad m2, Commutative m2) => Category (Kleisli2 m1 m2) where-    id = Kleisli2 $ (**:) +instance (Monad m1, Monad m2, Traversable m2) => Category (Kleisli2 m1 m2) where+    id = Kleisli2 $ (.**)      (Kleisli2 g) . (Kleisli2 f) = Kleisli2 $ f >==> g -instance (Monad m1, Monad m2, Commutative m2) => Arrow (Kleisli2 m1 m2) where-    arr f = Kleisli2 $ (**:) . f-    first (Kleisli2 f) = Kleisli2 $ \ ~(b,d) -> f b >>== \c -> (**:) (c,d)-    second (Kleisli2 f) = Kleisli2 $ \ ~(d,b) -> f b >>== \c -> (**:) (d,c)+instance (Monad m1, Monad m2, Traversable m2) => Arrow (Kleisli2 m1 m2) where+    arr f = Kleisli2 $ (.**) . f+    first (Kleisli2 f) = Kleisli2 $ \ ~(b,d) -> f b >>== \c -> (.**) (c,d)+    second (Kleisli2 f) = Kleisli2 $ \ ~(d,b) -> f b >>== \c -> (.**) (d,c)  ---------------------------------------------------------------------- -- Kleisli3  newtype Kleisli3 m1 m2 m3 a b = Kleisli3 { runKleisli3 :: a -> m1 (m2 (m3 b)) } -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => Category (Kleisli3 m1 m2 m3) where-    id = Kleisli3 $ (***:) +instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => Category (Kleisli3 m1 m2 m3) where+    id = Kleisli3 $ (.***)      (Kleisli3 g) . (Kleisli3 f) = Kleisli3 $ f >===> g -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => Arrow (Kleisli3 m1 m2 m3) where-    arr f = Kleisli3 $ (***:) . f-    first (Kleisli3 f) = Kleisli3 $ \ ~(b,d) -> f b >>>== \c -> (***:) (c,d)-    second (Kleisli3 f) = Kleisli3 $ \ ~(d,b) -> f b >>>== \c -> (***:) (d,c)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => Arrow (Kleisli3 m1 m2 m3) where+    arr f = Kleisli3 $ (.***) . f+    first (Kleisli3 f) = Kleisli3 $ \ ~(b,d) -> f b >>>== \c -> (.***) (c,d)+    second (Kleisli3 f) = Kleisli3 $ \ ~(d,b) -> f b >>>== \c -> (.***) (d,c)  ---------------------------------------------------------------------- -- Kleisli4  newtype Kleisli4 m1 m2 m3 m4 a b = Kleisli4 { runKleisli4 :: a -> m1 (m2 (m3 (m4 b))) } -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => Category (Kleisli4 m1 m2 m3 m4) where-    id = Kleisli4 $ (****:) +instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => Category (Kleisli4 m1 m2 m3 m4) where+    id = Kleisli4 $ (.****)      (Kleisli4 g) . (Kleisli4 f) = Kleisli4 $ f >====> g -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => Arrow (Kleisli4 m1 m2 m3 m4) where-    arr f = Kleisli4 $ (****:) . f-    first (Kleisli4 f) = Kleisli4 $ \ ~(b,d) -> f b >>>>== \c -> (****:) (c,d)-    second (Kleisli4 f) = Kleisli4 $ \ ~(d,b) -> f b >>>>== \c -> (****:) (d,c)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => Arrow (Kleisli4 m1 m2 m3 m4) where+    arr f = Kleisli4 $ (.****) . f+    first (Kleisli4 f) = Kleisli4 $ \ ~(b,d) -> f b >>>>== \c -> (.****) (c,d)+    second (Kleisli4 f) = Kleisli4 $ \ ~(d,b) -> f b >>>>== \c -> (.****) (d,c)  ---------------------------------------------------------------------- -- Kleisli5  newtype Kleisli5 m1 m2 m3 m4 m5 a b = Kleisli5 { runKleisli5 :: a -> m1 (m2 (m3 (m4 (m5 b)))) } -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => Category (Kleisli5 m1 m2 m3 m4 m5) where-    id = Kleisli5 $ (*****:)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => Category (Kleisli5 m1 m2 m3 m4 m5) where+    id = Kleisli5 $ (.*****)     (Kleisli5 g) . (Kleisli5 f) = Kleisli5 $ f >=====> g -instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => Arrow (Kleisli5 m1 m2 m3 m4 m5) where-    arr f = Kleisli5 $ (*****:) . f-    first (Kleisli5 f) = Kleisli5 $ \ ~(b,d) -> f b >>>>>== \c -> (*****:) (c,d)-    second (Kleisli5 f) = Kleisli5 $ \ ~(d,b) -> f b >>>>>== \c -> (*****:) (d,c)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => Arrow (Kleisli5 m1 m2 m3 m4 m5) where+    arr f = Kleisli5 $ (.*****) . f+    first (Kleisli5 f) = Kleisli5 $ \ ~(b,d) -> f b >>>>>== \c -> (.*****) (c,d)+    second (Kleisli5 f) = Kleisli5 $ \ ~(d,b) -> f b >>>>>== \c -> (.*****) (d,c) 

@@ -1,183 +0,0 @@-{-|-Module      : DeepControl.Commutative-Description : ----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-Portability : -----This module is made of @'Data.Traversable'@, distilling most function names polluted with action kind of concepts into crystalized(static) ones.--}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-module DeepControl.Commutative (-    -- * The 'Commutative' class-    Commutative(..),-    -- * Utility functions-    cmap,-    cfor,-    -- * General definitions for superclass methods-    fmapDefault,-    foldMapDefault,--    -- * Utility functions 2-    -- ** Level-2-    sink2, float2,-    -- ** Level-3-    sink3, float3,-    -- ** Level-4-    sink4, float4,-    -- ** Level-5-    sink5, float5,--    ) where --import DeepControl.Applicative-import Data.Monoid--import Control.Monad.Identity (Identity(..))-import Control.Monad.Except (Except, ExceptT(..), runExcept)-import Control.Monad.Writer (Writer, WriterT(..), runWriter)----------------------------------------------------------------------------------- Level-1---- | [], Maybe, Either, Except and Writer are all commutative each other.---   So these monads can be deepened to Monad2, Monad3, Monad4 and Monad5.--- -class (Functor c) => Commutative c where-  -- | This method is equivalent for @'Data.Traversable.sequenceA'@ except the name.-  --   The only difference is the name "commute", that is to say from which no action kind of concepts smell.-  ---  -- >>> commute $ Just [1]-  -- [Just 1]-  -- >>> commute $ [Just 1]-  -- Just [1]-  ---  -- >>> commute $ Right (Just 1)-  -- Just (Right 1)-  -- >>> commute $ Just (Right 1)-  -- Right (Just 1)-  ---  commute :: Applicative f => c (f a) -> f (c a)---- | Do @fmap f@ then commute, equivalent for @'Data.Traversable.traverse'@.-cmap :: (Applicative f, Commutative c) => (a -> f b) -> c a -> f (c b)-cmap f = commute . (f |$>)--- | The auguments-flipped function for @'cmap'@, equivalent 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-    commute Nothing   = (*:) Nothing--instance Commutative [] where-    commute = foldr (\x acc -> x <$|(:)|*> acc) ((*:) [])-  -instance (Monoid w) => Commutative (Writer w) where-    commute x = -        let (a, b) = runWriter x-        in  (WriterT . Identity) |$> (a <$|(,)|* b)--instance Commutative (Either a) where-    commute (Right x) = Right |$> x-    commute (Left x)  = (*:) $ Left x-instance Commutative (Except e) where-    commute x = ExceptT . Identity |$> commute (runExcept x)--instance Commutative (Const m) where-    commute (Const m) = (*:) $ Const m--{--instance Commutative ((->) r) where-    -- TODO: If GHC could parse this expression, maybe I could write up DeepControl.Monad.-    commute ((r->) mv) = (r->) |$> mv--}---- | This function may be used as a value for `fmap` in a `Functor`---   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 . 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 . cmap (Const . f)---- local instances-newtype Id a = Id { getId :: a }-instance Functor Id where-    fmap f (Id x) = Id (f x)-instance Applicative Id where-    pure = Id-    Id f <*> Id x = Id (f x)----------------------------------------------------------------------------------- Level-2---- | sink2 = (commute|$>) . commute------ >>> sink2 $ Right (Just [1])--- Just [Right 1]----sink2 :: (Commutative m1, Applicative m2, Applicative m3) => -         m1 (m2 (m3 a)) -> m2 (m3 (m1 a))-sink2 = (commute|$>) . commute---- | float2 = commute . (commute|$>)------ >>> float2 $ Just [Right 1]--- Right (Just [1])----float2 :: (Applicative m1, Commutative m2, Commutative m3) => -          m2 (m3 (m1 a)) -> m1 (m2 (m3 a))-float2 = commute . (commute|$>)----------------------------------------------------------------------------------- Level-3---- | sink3 = (sink2|$>) . commute------ >>> sink3 $ Right [Just [1]]--- [Just [Right 1]]----sink3 :: (Commutative m1, Applicative m2, Applicative m3, Applicative m4) => -         m1 (m2 (m3 (m4 a))) -> m2 (m3 (m4 (m1 a)))-sink3 = (sink2|$>) . commute---- | float3 = commute . (float2|$>)------ >>> float3 $ [Just [Right 1]]--- Right [Just [1]]----float3 :: (Applicative m1, Commutative m2, Commutative m3, Commutative m4) => -          m2 (m3 (m4 (m1 a))) -> m1 (m2 (m3 (m4 a)))-float3 = commute . (float2|$>)----------------------------------------------------------------------------------- Level-4--sink4 :: (Commutative m1, Applicative m2, Applicative m3, Applicative m4, Applicative m5) => -         m1 (m2 (m3 (m4 (m5 a)))) -> m2 (m3 (m4 (m5 (m1 a))))-sink4 = (sink3|$>) . commute--float4 :: (Applicative m1, Commutative m2, Commutative m3, Commutative m4, Commutative m5) => -          m2 (m3 (m4 (m5 (m1 a)))) -> m1 (m2 (m3 (m4 (m5 a))))-float4 = commute . (float3|$>)----------------------------------------------------------------------------------- Level-5--sink5 :: (Commutative m1, Applicative m2, Applicative m3, Applicative m4, Applicative m5, Applicative m6) => -         m1 (m2 (m3 (m4 (m5 (m6 a))))) -> m2 (m3 (m4 (m5 (m6 (m1 a)))))-sink5 = (sink4|$>) . commute--float5 :: (Applicative m1, Commutative m2, Commutative m3, Commutative m4, Commutative m5, Commutative m6) => -          m2 (m3 (m4 (m5 (m6 (m1 a))))) -> m1 (m2 (m3 (m4 (m5 (m6 a)))))-float5 = commute . (float4|$>)--

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad-Description : Enable deep level Monad programming.+Description : Deepend the usual Control.Monad module. Copyright   : (c) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution) Maintainer  : ocean0yohsuke@gmail.com@@ -13,7 +13,7 @@ Note:       * This module never makes mtl(monad-transformer-library) unnessasary. -      The range in which this module is helpful is regrettably confined to the range of deep monads (namely Monad, Monad, etc).+      The range in which this module is helpful is regrettably confined to the range of @'Traversable'@.          * In my opinion this bad confinement is hard-wired with the ability of the compiler, that is to say GHC doesn't parse @(r->)@ or @((->) r)@ as a data constructor;        thus some fundamental expressions such as @(r->)|$>@ or @fmap (r->)@ are useless.@@ -92,13 +92,9 @@     ) where   import DeepControl.Applicative-import DeepControl.Commutative+import DeepControl.Traversable  import Control.Monad-import Control.Monad.Writer (Writer, WriterT(..), runWriter)-import Control.Monad.Except (Except, ExceptT(..), runExcept)-import Data.Functor.Identity-import Data.Monoid (Monoid, (<>))  ------------------------------------------------------------------------------- -- Level-0 functions@@ -159,7 +155,7 @@ --  -- List-List monad --  [["a","b"]] >>== \x ->   -- (>>==) is the level-2 bind function, analogous for (>>=) --  [[0],[1,2]] >>== \y -> ---  (**:) (x ++ show y)+--  (.**) (x ++ show y) -- :} -- [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]] --@@ -171,42 +167,42 @@ --      averageM =  --          (-*) sum >>== \s -> --          lengthM >>== \l ->---          (**:) (fromIntegral s / fromIntegral l)+--          (.**) (fromIntegral s / fromIntegral l) --  in [averageM [10, 25, 70], averageM []] -- :} -- [Just 35.0,Nothing] ---(>>==) :: (Monad m1, Monad m2, Commutative m2) => m1 (m2 a) -> (a -> m1 (m2 b)) -> m1 (m2 b)-m >>== f = m >>= \x -> join |$> (commute $ f |$> x)+(>>==) :: (Monad m1, Monad m2, Traversable m2) => m1 (m2 a) -> (a -> m1 (m2 b)) -> m1 (m2 b)+m >>== f = m >>= \x -> join |$> (sink $ f |$> x)  -- | The level-2 composite function, analogous for @'>=>'@.-(>==>) :: (Monad m1, Monad m2, Commutative m2) => (a -> m1 (m2 b)) -> (b -> m1 (m2 c)) -> a -> m1 (m2 c)+(>==>) :: (Monad m1, Monad m2, Traversable m2) => (a -> m1 (m2 b)) -> (b -> m1 (m2 c)) -> a -> m1 (m2 c) f >==> g = \x -> f x >>== g -- | The level-2 sequence function, analogous for @'>>'@. -- --   Definition: @ m >>~ f = m >>== \\_ -> f @-(>>~) :: (Monad m1, Monad m2, Commutative m2) => m1 (m2 a) -> m1 (m2 b) -> m1 (m2 b)+(>>~) :: (Monad m1, Monad m2, Traversable m2) => m1 (m2 a) -> m1 (m2 b) -> m1 (m2 b) m >>~ f = m >>== \_ -> f -- | A level-2 cover-bind function, analogous for @'>>='@. -- --   Definition: @ m >-== f = (-*) m >>== f @-(>-==) :: (Monad m1, Monad m2, Commutative m2) => m1 a -> (a -> m1 (m2 b)) -> m1 (m2 b)+(>-==) :: (Monad m1, Monad m2, Traversable m2) => m1 a -> (a -> m1 (m2 b)) -> m1 (m2 b) m >-== f = (-*) m >>== f -- | A level-2 cover-bind function, analogous for @'>>='@. -----   Definition: @ m ->== f = (*:) m >>== f @-(->==) :: (Monad m1, Monad m2, Commutative m2) => m2 a -> (a -> m1 (m2 b)) -> m1 (m2 b)-m ->== f = (*:) m >>== f+--   Definition: @ m ->== f = (.*) m >>== f @+(->==) :: (Monad m1, Monad m2, Traversable m2) => m2 a -> (a -> m1 (m2 b)) -> m1 (m2 b)+m ->== f = (.*) m >>== f -- | A level-2 cover-sequence function, analogous for @'>>'@. -- --   Definition: @ m >-~ f = (-*) m >>~ f @-(>-~) :: (Monad m1, Monad m2, Commutative m2) => m1 a -> m1 (m2 b) -> m1 (m2 b)+(>-~) :: (Monad m1, Monad m2, Traversable m2) => m1 a -> m1 (m2 b) -> m1 (m2 b) m >-~ f = (-*) m >>~ f -- | A level-2 cover-sequence function, analogous for @'>>'@. -----   Definition: @ m ->~ f = (*:) m >>~ f @-(->~) :: (Monad m1, Monad m2, Commutative m2) => m2 a -> m1 (m2 b) -> m1 (m2 b)-m ->~ f = (*:) m >>~ f+--   Definition: @ m ->~ f = (.*) m >>~ f @+(->~) :: (Monad m1, Monad m2, Traversable m2) => m2 a -> m1 (m2 b) -> m1 (m2 b)+m ->~ f = (.*) m >>~ f  ------------------------------------------------------------------------------- -- Level-3 functions@@ -220,10 +216,10 @@ --  -- >>> :{ --  -- IO-List-List monad---  (*:) [["a","b"]] >>>== \x ->   -- (>>>==) is the level-3 bind function, analogous for (>>=)---  (*:) [[0],[1,2]] >>>== \y ->+--  (.*) [["a","b"]] >>>== \x ->   -- (>>>==) is the level-3 bind function, analogous for (>>=)+--  (.*) [[0],[1,2]] >>>== \y -> --  (-**) (print (x,y)) >>>~       -- (>>>~) is the level-3 sequence function, analogous for (>>)---  (***:) (x ++ show y)+--  (.***) (x ++ show y) -- :} -- ("a",0) -- ("a",1)@@ -240,7 +236,7 @@ --  [["a","b"]] ->>== \x ->   -- (->>==) is a level-3 cover-bind function, analogous for (>>=) --  [[0],[1,2]] ->>== \y -> --  print (x,y) >--~          -- (>--~) is a level-3 cover-sequence function, analogous for (>>)---  (***:) (x ++ show y)+--  (.***) (x ++ show y) -- :} -- ("a",0) -- ("a",1)@@ -250,37 +246,37 @@ -- ("b",2) -- [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]] ---(>>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+(>>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b)) m >>>== f = m >>== \x -> join |$>> (sink2 $ f |$> x) -(>===>) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => (a -> m1 (m2 (m3 b))) -> (b -> m1 (m2 (m3 c))) -> a -> m1 (m2 (m3 c))+(>===>) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => (a -> m1 (m2 (m3 b))) -> (b -> m1 (m2 (m3 c))) -> a -> m1 (m2 (m3 c)) f >===> g = \x -> f x >>>== g-(>>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m2 (m3 a)) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+(>>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m2 (m3 a)) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b)) m >>>~ k = m >>>== \_ -> k -(>--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+(>--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b)) m >--== k = (-**) m >>>== k-(->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m2 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+(->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m2 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b)) m ->-== k = (*-*) m >>>== k-(-->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m3 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))-m -->== k = (**:) m >>>== k-(>>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m2 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+(-->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m3 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+m -->== k = (.**) m >>>== k+(>>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m2 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b)) m >>-== k = (--*) m >>>== k-(->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m2 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))-m ->>== k = (*:) m >>>== k-(>->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+(->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m2 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))+m ->>== k = (.*) m >>>== k+(>->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b)) m >->== k = (-*) m >>>== k-(-->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m3 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))-m -->~ k = (**:) m >>>~ k-(->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m2 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+(-->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m3 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+m -->~ k = (.**) m >>>~ k+(->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m2 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b)) m ->-~ k = (*-*) m >>>~ k-(>--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+(>--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b)) m >--~ k = (-**) m >>>~ k-(->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m2 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))-m ->>~ k = (*:) m >>>~ k-(>->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+(->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m2 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+m ->>~ k = (.*) m >>>~ k+(>->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b)) m >->~ k = (-*) m >>>~ k-(>>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => m1 (m2 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))+(>>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => m1 (m2 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b)) m >>-~ k = (--*) m >>>~ k  -------------------------------------------------------------------------------@@ -295,74 +291,74 @@ infixr 1  -->>~, ->->~, >-->~, >->-~, ->>-~, >>--~ infixr 1  ->>>~, >->>~, >>->~, >>>-~ -(>>>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m3 (m4 a))) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>>>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m3 (m4 a))) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >>>>== f = m >>>== \x -> join |$>>> (sink3 $ f |$> x) -(>====>) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => (a -> m1 (m2 (m3 (m4 b)))) -> (b -> m1 (m2 (m3 (m4 c)))) -> a -> m1 (m2 (m3 (m4 c)))+(>====>) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => (a -> m1 (m2 (m3 (m4 b)))) -> (b -> m1 (m2 (m3 (m4 c)))) -> a -> m1 (m2 (m3 (m4 c))) f >====> g = \x -> f x >>>>== g-(>>>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>>>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >>>>~ k = m >>>>== \_ -> k -(--->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m4 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))-m --->== k = (***:) m >>>>== k -(-->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m3 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(--->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m4 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+m --->== k = (.***) m >>>>== k +(-->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m3 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m -->-== k = (**-*) m >>>>== k -(->--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(->--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m ->--== k = (*-**) m >>>>== k -(>---==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>---==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 a -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >---== k = (-***) m >>>>== k -(-->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m3 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))-m -->>== k = (**:) m >>>>== k -(->->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(-->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m3 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+m -->>== k = (.**) m >>>>== k +(->->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m ->->== k = (*-*) m >>>>== k -(>-->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>-->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m4 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >-->== k = (-**) m >>>>== k -(>->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m3 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m3 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >->-== k = (-*-*) m >>>>== k -(->>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m3 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(->>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m3 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m ->>-== k = (*--*) m >>>>== k -(>>--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>>--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 a) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >>--== k = (--**) m >>>>== k  -(->>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))-m ->>>== k = (*:) m >>>>== k -(>->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(->>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+m ->>>== k = (.*) m >>>>== k +(>->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >->>== k = (-*) m >>>>== k -(>>->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>>->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m4 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >>->== k = (--*) m >>>>== k -(>>>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))+(>>>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b))) m >>>-== k = (---*) m >>>>== k  -(--->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m4 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))-m --->~ k = (***:) m >>>>~ k-(-->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m3 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(--->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m4 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+m --->~ k = (.***) m >>>>~ k+(-->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m3 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m -->-~ k = (**-*) m >>>>~ k-(->--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(->--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m ->--~ k = (*-**) m >>>>~ k-(>---~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>---~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 a -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >---~ k = (-***) m >>>>~ k -(-->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m3 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))-m -->>~ k = (**:) m >>>>~ k-(->->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(-->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m3 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+m -->>~ k = (.**) m >>>>~ k+(->->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m ->->~ k = (*-*) m >>>>~ k-(>-->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>-->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m4 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >-->~ k = (-**) m >>>>~ k-(>->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m3 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m3 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >->-~ k = (-*-*) m >>>>~ k-(->>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m3 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(->>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m3 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m ->>-~ k = (*--*) m >>>>~ k-(>>--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>>--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 a) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >>--~ k = (--**) m >>>>~ k -(->>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m2 (m3 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))-m ->>>~ k = (*:) m >>>>~ k-(>->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m3 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(->>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m2 (m3 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+m ->>>~ k = (.*) m >>>>~ k+(>->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m3 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >->>~ k = (-*) m >>>>~ k-(>>->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>>->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m4 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >>->~ k = (--*) m >>>>~ k-(>>>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => m1 (m2 (m3 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))+(>>>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => m1 (m2 (m3 a)) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b))) m >>>-~ k = (---*) m >>>>~ k  -------------------------------------------------------------------------------@@ -380,140 +376,140 @@ infixr 1  -->>>~, ->->>~, >-->>~, >->->~, ->>->~, >>-->~, >>->-~, >->>-~, ->>>-~, >>>--~ infixr 1  ->>>>~, >->>>~, >>->>~, >>>->~, >>>>-~ -(>>>>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m4 (m5 a)))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m4 (m5 a)))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>>>== f = m >>>>== \x -> join |$>>>> (sink4 $ f |$> x) -(>=====>) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => (a -> m1 (m2 (m3 (m4 (m5 b))))) -> (b -> m1 (m2 (m3 (m4 (m5 c))))) -> a -> m1 (m2 (m3 (m4 (m5 c))))+(>=====>) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => (a -> m1 (m2 (m3 (m4 (m5 b))))) -> (b -> m1 (m2 (m3 (m4 (m5 c))))) -> a -> m1 (m2 (m3 (m4 (m5 c)))) f >=====> g = \x -> f x >>>>>== g-(>>>>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m4 (m5 a)))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m4 (m5 a)))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>>>~ k = m >>>>>== \_ -> k -(---->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m5 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))-m ---->== k = (****:) m >>>>>== k -(--->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m4 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(---->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m5 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+m ---->== k = (.****) m >>>>>== k +(--->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m4 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m --->-== k = (***-*) m >>>>>== k -(-->--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->--== k = (**-**) m >>>>>== k -(->---==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->---==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->---== k = (*-***) m >>>>>== k -(>----==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>----==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 a -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >----== k = (-****) m >>>>>== k  -(--->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m4 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))-m --->>== k = (***:) m >>>>>== k -(-->->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(--->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m4 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+m --->>== k = (.***) m >>>>>== k +(-->->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->->== k = (**-*) m >>>>>== k -(->-->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->-->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->-->== k = (*-**) m >>>>>== k -(>--->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>--->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m5 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >--->== k = (-***) m >>>>>== k -(>-->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>-->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >-->-== k = (-**-*) m >>>>>== k -(->->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->->-== k = (*-*-*) m >>>>>== k -(-->>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m4 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->>-== k = (**--*) m >>>>>== k -(->>--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>--== k = (*--**) m >>>>>== k -(>->--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->--== k = (-*-**) m >>>>>== k -(>>---==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>---==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 a) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>---== k = (--***) m >>>>>== k  -(-->>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))-m -->>>== k = (**:) m >>>>>== k -(->->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+m -->>>== k = (.**) m >>>>>== k +(->->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->->>== k = (*-*) m >>>>>== k -(>-->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>-->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m4 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >-->>== k = (-**) m >>>>>== k -(>->->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->->== k = (-*-*) m >>>>>== k -(->>->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>->== k = (*--*) m >>>>>== k -(>>-->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>-->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m5 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>-->== k = (--**) m >>>>>== k -(>>->-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>->-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>->-== k = (--*-*) m >>>>>== k -(>->>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->>-== k = (-*--*) m >>>>>== k -(->>>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m4 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>>-== k = (*---*) m >>>>>== k -(>>>--==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>--==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>--== k = (---**) m >>>>>== k  -(->>>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))-m ->>>>== k = (*:) m >>>>>== k -(>->>>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+m ->>>>== k = (.*) m >>>>>== k +(>->>>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->>>== k = (-*) m >>>>>== k -(>>->>==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>->>==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m4 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>->>== k = (--*) m >>>>>== k -(>>>->==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>->==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m5 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>->== k = (---*) m >>>>>== k -(>>>>-==) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m4 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>>-==) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m4 a))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>>-== k = (----*) m >>>>>== k   -(---->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m5 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))-m ---->~ k = (****:) m >>>>>~ k -(--->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m4 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(---->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m5 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+m ---->~ k = (.****) m >>>>>~ k +(--->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m4 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m --->-~ k = (***-*) m >>>>>~ k -(-->--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->--~ k = (**-**) m >>>>>~ k -(->---~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->---~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->---~ k = (*-***) m >>>>>~ k -(>----~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>----~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 a -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >----~ k = (-****) m >>>>>~ k  -(--->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m4 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))-m --->>~ k = (***:) m >>>>>~ k -(-->->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(--->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m4 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+m --->>~ k = (.***) m >>>>>~ k +(-->->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->->~ k = (**-*) m >>>>>~ k -(->-->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->-->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->-->~ k = (*-**) m >>>>>~ k -(>--->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>--->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m5 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >--->~ k = (-***) m >>>>>~ k -(>-->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>-->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >-->-~ k = (-**-*) m >>>>>~ k -(->->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->->-~ k = (*-*-*) m >>>>>~ k -(-->>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m4 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m -->>-~ k = (**--*) m >>>>>~ k -(->>--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>--~ k = (*--**) m >>>>>~ k -(>->--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->--~ k = (-*-**) m >>>>>~ k -(>>---~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>---~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 a) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>---~ k = (--***) m >>>>>~ k  -(-->>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m3 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))-m -->>>~ k = (**:) m >>>>>~ k -(->->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(-->>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m3 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+m -->>>~ k = (.**) m >>>>>~ k +(->->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->->>~ k = (*-*) m >>>>>~ k -(>-->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>-->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m4 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >-->>~ k = (-**) m >>>>>~ k -(>->->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->->~ k = (-*-*) m >>>>>~ k -(->>->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>->~ k = (*--*) m >>>>>~ k -(>>-->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>-->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m5 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>-->~ k = (--**) m >>>>>~ k -(>>->-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>->-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>->-~ k = (--*-*) m >>>>>~ k -(>->>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>->>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->>-~ k = (-*--*) m >>>>>~ k -(->>>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m4 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m ->>>-~ k = (*---*) m >>>>>~ k -(>>>--~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>--~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 a)) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>--~ k = (---**) m >>>>>~ k  -(->>>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m2 (m3 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))-m ->>>>~ k = (*:) m >>>>>~ k -(>->>>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m3 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(->>>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m2 (m3 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+m ->>>>~ k = (.*) m >>>>>~ k +(>->>>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m3 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >->>>~ k = (-*) m >>>>>~ k -(>>->>~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>->>~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m4 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>->>~ k = (--*) m >>>>>~ k -(>>>->~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>->~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m5 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>->~ k = (---*) m >>>>>~ k -(>>>>-~) :: (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))+(>>>>-~) :: (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b)))) m >>>>-~ k = (----*) m >>>>>~ k  

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad.Morph-Description : Extension for mmorph's Contrl.Monad.Morph.+Description : Deepened the usual Control.Monad.Morph module. Copyright   : 2013 Gabriel Gonzalez,               (c) 2015 KONISHI Yohsuke  License     : BSD-style (see the LICENSE file in the distribution)@@ -18,123 +18,413 @@ module DeepControl.Monad.Morph (     module Control.Monad.Morph, +    -- * SinkT+    SinkT(..), sinkT2, sinkT3, sinkT4, +     -- * Level-1     -- ** trans-map     (|>|), (|<|), +    -- ** trans-cover+    (|*|),      -- * Level-2+    -- ** trans-bind+    (|>>=),     -- ** trans-map     (|>>|), (|<<|),+    -- ** trans-cover  +    (|**|),+    (|-*|),       -- * Level-3+    -- ** trans-bind+    (|>>>=),     -- ** trans-map     (|>>>|), (|<<<|),+    -- ** trans-cover  +    (|***|),+    (|--*|), +    (|-**|), (|*-*|),       -- * Level-4+    -- ** trans-bind+    (|>>>>=),     -- ** trans-map     (|>>>>|), (|<<<<|),+    -- ** trans-cover+    (|****|),+    (|---*|),+    (|--**|), (|-*-*|), (|*--*|),+    (|-***|), (|*-**|), (|**-*|),       -- * Level-5     -- ** trans-map     (|>>>>>|), (|<<<<<|),+    -- ** trans-cover+    (|*****|),+    (|----*|), +    (|---**|), (|--*-*|), (|-*--*|), (|*---*|), +    (|--***|), (|-*-**|), (|*--**|), (|*-*-*|), (|-**-*|), (|**--*|),+    (|-****|), (|*-***|), (|**-**|), (|***-*|),  -    -- * Level-2 example-    -- $Example_Level2+    -- * Level-2 example: trans-map+    -- $Example +    -- * Level-2 example: trans-cover and trans-bind +    -- $Example-2+     ) where   import DeepControl.Applicative+import DeepControl.Traversable+import DeepControl.Monad.Trans  import Control.Monad.Morph+-- import Control.Monad.Identity (Identity(..))+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.Maybe (MaybeT(..))+import Control.Monad.List (ListT(..))+import Control.Monad.Except (Except, ExceptT(..), runExcept, runExceptT)+import Control.Monad.Writer (Writer, WriterT(..), runWriter)+import Data.Monoid   -------------------------------------------------------------------------------+-- SinkT++class (MonadTrans s) => SinkT s where+    sinkT :: (Monad m, MMonad t,+              MonadTrans_ x t, Traversable x) => +             s (t m) a -> t (s m) a++instance SinkT IdentityT where+    sinkT (IdentityT x) = trans . IdentityT . untrans $ x+instance SinkT MaybeT where+    sinkT (MaybeT x)    = trans . MaybeT . (sink|$>) . untrans $ x+instance SinkT ListT where+    sinkT (ListT x)     = trans . ListT . (sink|$>) . untrans $ x+instance SinkT (ExceptT e) where+    sinkT (ExceptT x)   = trans . ExceptT . (sink|$>) . untrans $ x+instance (Monoid w) => SinkT (WriterT w) where+    sinkT (WriterT x)   = trans . WriterT . (sinkToTuple|$>) . untrans $ x+      where+        sinkToTuple :: (Functor m, Traversable m, Monoid w) => m (a, w) -> (m a, w)+        sinkToTuple = flipTuple . sink . (flipTuple|$>)+        flipTuple (x,y) = (y,x)++sinkT2 :: (Monad m, Monad (s (t2 m)), Monad (t2 m), +           MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, +           SinkT s, MMonad t1, MMonad t2) =>+          s (t1 (t2 m)) a -> t1 (t2 (s m)) a+sinkT2 = (sinkT|>|) . sinkT++sinkT3 +  :: (Monad m, Monad (s (t2 (t3 m))), Monad (s (t3 m)), Monad (t2 (t3 m)), Monad (t3 m), +      MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, MonadTrans_ x3 t3, Traversable x3, +      SinkT s, MMonad t1, MMonad t2, MMonad t3) =>+     s (t1 (t2 (t3 m))) a -> t1 (t2 (t3 (s m))) a+sinkT3 = (sinkT2|>|) . sinkT++sinkT4+  :: (Monad m, Monad (s (t2 (t3 (t4 m)))), Monad (s (t3 (t4 m))), Monad (s (t4 m)), Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), Monad (t4 m), +      MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, MonadTrans_ x3 t3, Traversable x3, MonadTrans_ x4 t4, Traversable x4, +      MMonad t1, MMonad t2, MMonad t3, MMonad t4, SinkT s) =>+     s (t1 (t2 (t3 (t4 m)))) a -> t1 (t2 (t3 (t4 (s m)))) a+sinkT4 = (sinkT3|>|) . sinkT++------------------------------------------------------------------------------- -- Level-1 functions -infixl 2  |>|+infixl 4  |>| -- | Alias to @'hoist'@. (|>|) :: (Monad m, MFunctor t) => (forall a . m a -> n a) -> t m b -> t n b (|>|) = hoist -infixr 2  |<|+infixl 4  |<| -- | Equivalent to (|>|) with the arguments flipped. (|<|) :: (Monad m, MFunctor t) => t m b -> (forall a . m a -> n a) -> t n b (|<|) l r = hoist r l +-- sinkT :: t1 (t2 m) a -> t2 (t1 m) a++infixl 5 |*|+-- | Alias to @'lift'@+(|*|) :: (Monad m, MonadTrans t) => m a -> t m a +(|*|) = lift++{-+-- TODO:+(|>~) :: t1 m a -> t1 n a -> t1 n a+m |>~ k = m |>= \_ -> k+-}+ ------------------------------------------------------------------------------- -- Level-2 functions -infixl 2  |>>|+infixr 3  |>>=+-- | The level-2 trans-bind function, analogous to ('>>=')+(|>>=) :: (Monad n, Monad m, Monad (t2 n), Monad (t2 (t2 n)),+           MonadTrans_ x t1, Traversable x, +           MMonad t1, MMonad t2, SinkT t2) => +          t1 (t2 m) b -> (forall a. m a -> t1 (t2 n) a) -> t1 (t2 n) b+m |>>= f = m |>= \x -> squash |>| (sinkT $ f |>| x)++infixl 4  |>>| (|>>|) :: (Monad m, Monad (t2 m), MFunctor t1, MFunctor t2) =>            (forall a . m a -> n a) -> t1 (t2 m) b -> t1 (t2 n) b (|>>|) f g = (f |>|) |>| g -infixr 2  |<<|+infixl 4  |<<| (|<<|) :: (Monad m, Monad (t2 m), MFunctor t1, MFunctor t2) =>             t1 (t2 m) b -> (forall a . m a -> n a) -> t1 (t2 n) b (|<<|) f g = (g |>|) |>| f +infixl 5 |**|+(|**|) :: (Monad m, MonadTrans t1, MonadTrans t2, Monad (t2 m)) => m a -> t1 (t2 m) a +(|**|) = (|*|) . (|*|)++infixl 5  |-*|+(|-*|) :: (Monad m, MonadTrans t1, MonadTrans t2, MFunctor t1) => t1 m a -> t1 (t2 m) a+(|-*|) = ((|*|) |>|)+ ------------------------------------------------------------------------------- -- Level-3 functions -infixl 2  |>>>|+infixr 3  |>>>=+(|>>>=) :: +   (Monad n, Monad (t3 n), Monad m, Monad (t3 m), +    Monad (t2 (t3 n)), Monad (t2 (t3 (t3 n))), Monad (t3 (t3 n)), Monad (t3 (t2 (t3 n))), Monad (t2 (t2 (t3 n))), +    MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, +    SinkT t2, SinkT t3, +    MMonad t1, MMonad t2, MMonad t3) => +   t1 (t2 (t3 m)) b -> (forall a. m a -> t1 (t2 (t3 n)) a) -> t1 (t2 (t3 n)) b+m |>>>= f = m |>>= \x -> squash |>>| (sinkT2 $ f |>| x)++infixl 4  |>>>| (|>>>|) :: (Monad m, Monad (t3 m), Monad (t2 (t3 m)), MFunctor t1, MFunctor t2, MFunctor t3) =>             (forall a . m a -> n a) -> t1 (t2 (t3 m)) b -> t1 (t2 (t3 n)) b (|>>>|) f g = (f |>|) |>>| g -infixr 2  |<<<|+infixl 4  |<<<| (|<<<|) :: (Monad m, Monad (t3 m), Monad (t2 (t3 m)), MFunctor t1, MFunctor t2, MFunctor t3) =>             t1 (t2 (t3 m)) b -> (forall a . m a -> n a) -> t1 (t2 (t3 n)) b (|<<<|) f g = (g |>|) |>>| f +infixl 5 |***|+(|***|) :: (Monad m, Monad (t2 (t3 m)), Monad (t3 m),+            MonadTrans t1, MonadTrans t2, MonadTrans t3) => +            m a -> t1 (t2 (t3 m)) a +(|***|) = (|*|) . (|**|)++infixl 5  |--*|+(|--*|) :: (Monad m, Monad (t2 m),+            MonadTrans t1, MonadTrans t2, MonadTrans t3, +            MFunctor t1, MFunctor t2) => +            t1 (t2 m) a -> t1 (t2 (t3 m)) a+(|--*|) = ((|*|) |>>|)++infixl 5  |-**|, |*-*|+(|-**|) :: (Monad m, Monad (t2 (t3 m)), Monad (t3 m),+            MonadTrans t1, MonadTrans t2, MonadTrans t3, +            MFunctor t1) => +            t1 m a -> t1 (t2 (t3 m)) a+(|-**|) = ((|**|) |>|)+(|*-*|) :: (Monad m, Monad (t3 m), Monad (t2 (t3 m)),+            MonadTrans t1, MonadTrans t2, MonadTrans t3,+            MFunctor t2) => +            t2 m a -> t1 (t2 (t3 m)) a+(|*-*|) = (|*|) . ((|*|) |>|)+ ------------------------------------------------------------------------------- -- Level-4 functions -infixl 2  |>>>>|+infixr 4  |>>>>=+(|>>>>=) :: +   (Monad n, Monad (t4 n), Monad (t4 m), Monad m,+    Monad (t2 (t3 (t4 n))), Monad (t2 (t3 (t4 (t4 n)))), Monad (t2 (t2 (t3 (t4 n)))), +    Monad (t3 (t4 n)), Monad (t3 (t4 (t4 n))), Monad (t4 (t4 n)), Monad (t4 (t2 (t3 (t4 n)))), Monad (t2 (t3 (t3 (t4 n)))), Monad (t4 (t3 (t4 n))),+    Monad (t2 (t4 n)), Monad (t3 (t2 (t3 (t4 n)))), Monad (t3 (t3 (t4 n))), Monad (t3 (t4 m)), +    MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, MonadTrans_ x3 t3, Traversable x3,+    SinkT t2, SinkT t3, SinkT t4, +    MMonad t1, MMonad t2, MMonad t3, MMonad t4) => +   t1 (t2 (t3 (t4 m))) b -> (forall a. m a -> t1 (t2 (t3 (t4 n))) a) -> t1 (t2 (t3 (t4 n))) b+m |>>>>= f = m |>>>= \x -> squash |>>>| (sinkT3 $ f |>| x)++infixl 4  |>>>>| (|>>>>|) :: (Monad m, Monad (t4 m), Monad (t3 (t4 m)), Monad (t2 (t3 (t4 m))), MFunctor t1, MFunctor t2, MFunctor t3, MFunctor t4) =>              (forall a . m a -> n a) -> t1 (t2 (t3 (t4 m))) b -> t1 (t2 (t3 (t4 n))) b (|>>>>|) f g = (f |>|) |>>>| g -infixr 2  |<<<<|+infixl 4  |<<<<| (|<<<<|) :: (Monad m, Monad (t4 m), Monad (t3 (t4 m)), Monad (t2 (t3 (t4 m))), MFunctor t1, MFunctor t2, MFunctor t3, MFunctor t4) =>              t1 (t2 (t3 (t4 m))) b -> (forall a . m a -> n a) -> t1 (t2 (t3 (t4 n))) b (|<<<<|) f g = (g |>|) |>>>| f +infixl 5 |****|+(|****|) :: (Monad m, Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), Monad (t4 m),+            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            m a -> t1 (t2 (t3 (t4 m))) a +(|****|) = (|*|) . (|***|)++infixl 5  |---*|+(|---*|) :: (Monad m, Monad (t2 (t3 m)), Monad (t3 m), +            MFunctor t1, MFunctor t2, MFunctor t3,+            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t1 (t2 (t3 m)) a -> t1 (t2 (t3 (t4 m))) a+(|---*|) = ((|*|) |>>>|)+infixl 5  |--**|, |-*-*|+(|--**|) :: (Monad m, Monad (t2 m), Monad (t4 m), +            MFunctor t1, MFunctor t2,+            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t1 (t2 m) a -> t1 (t2 (t3 (t4 m))) a+(|--**|) = ((|**|) |>>|)+(|-*-*|) :: (Monad m, Monad (t3 m), Monad (t3 (t4 m)), Monad (t4 m),+            MFunctor t1, MFunctor t3,+            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t1 (t3 m) a -> t1 (t2 (t3 (t4 m))) a+(|-*-*|) = ((|*-*|) |>|)+(|*--*|) :: (Monad m, Monad (t3 m), Monad (t2 (t3 (t4 m))), Monad (t2 (t3 m)),+            MFunctor t2, MFunctor t3,+            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t2 (t3 m) a -> t1 (t2 (t3 (t4 m))) a+(|*--*|) = (|*|) . (|--*|)+infixl 5  |-***|, |*-**|, |**-*|+(|-***|) :: (Monad m, Monad (t3 (t4 m)), Monad (t4 m),+            MFunctor t1, +            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t1 m a -> t1 (t2 (t3 (t4 m))) a+(|-***|) = ((|***|) |>|)+(|*-**|) :: (Monad m, Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), Monad (t4 m),+            MFunctor t2, +            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t2 m a -> t1 (t2 (t3 (t4 m))) a+(|*-**|) = (|*|) . (|-**|)+(|**-*|) :: (Monad m, Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), +            MFunctor t3, +            MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) => +            t3 m a -> t1 (t2 (t3 (t4 m))) a+(|**-*|) = (|**|) . (|-*|)+ ------------------------------------------------------------------------------- -- Level-5 functions -infixl 2  |>>>>>|+infixr 4  |>>>>>=+(|>>>>>=) :: +   (Monad n, Monad m, Monad (t5 n), Monad (t5 m),+    Monad (t2 (t3 (t4 (t5 n)))), Monad (t2 (t3 (t4 (t5 (t5 n))))), Monad (t3 (t4 (t5 n))), Monad (t3 (t4 (t5 (t5 n)))), +    Monad (t4 (t5 n)), Monad (t4 (t5 (t5 n))), Monad (t5 (t2 (t3 (t4 (t5 n))))), Monad (t5 (t5 n)), Monad (t5 (t3 (t4 (t5 n)))), +    Monad (t2 (t2 (t3 (t4 (t5 n))))), Monad (t5 (t4 (t5 n))), Monad (t2 (t3 (t3 (t4 (t5 n))))), Monad (t2 (t3 (t4 (t4 (t5 n))))), +    Monad (t2 (t4 (t5 n))), Monad (t3 (t2 (t3 (t4 (t5 n))))), Monad (t3 (t3 (t4 (t5 n)))), Monad (t3 (t4 (t4 (t5 n)))), +    Monad (t3 (t4 (t5 m))), Monad (t4 (t2 (t3 (t4 (t5 n))))), Monad (t4 (t3 (t4 (t5 n)))), Monad (t4 (t4 (t5 n))), Monad (t4 (t5 m)), +    MonadTrans_ x1 t1, Traversable x1, MonadTrans_ x2 t2, Traversable x2, MonadTrans_ x3 t3, Traversable x3, MonadTrans_ x4 t4, Traversable x4,+    SinkT t2, SinkT t3, SinkT t4, SinkT t5, +    MMonad t1, MMonad t2, MMonad t3, MMonad t4, MMonad t5) => +   t1 (t2 (t3 (t4 (t5 m)))) b -> (forall a. m a -> t1 (t2 (t3 (t4 (t5 n)))) a) -> t1 (t2 (t3 (t4 (t5 n)))) b+m |>>>>>= f = m |>>>>= \x -> squash |>>>>| (sinkT4 $ f |>| x)++infixl 4  |>>>>>| (|>>>>>|) :: (Monad m, Monad (t5 m), Monad (t4 (t5 m)), Monad (t3 (t4 (t5 m))), Monad (t2 (t3 (t4 (t5 m)))), MFunctor t1, MFunctor t2, MFunctor t3, MFunctor t4, MFunctor t5) =>               (forall a . m a -> n a) -> t1 (t2 (t3 (t4 (t5 m)))) b -> t1 (t2 (t3 (t4 (t5 n)))) b (|>>>>>|) f g = (f |>|) |>>>>| g -infixr 2  |<<<<<|+infixl 4  |<<<<<| (|<<<<<|) :: (Monad m, Monad (t5 m), Monad (t4 (t5 m)), Monad (t3 (t4 (t5 m))), Monad (t2 (t3 (t4 (t5 m)))), MFunctor t1, MFunctor t2, MFunctor t3, MFunctor t4, MFunctor t5) =>               t1 (t2 (t3 (t4 (t5 m)))) b -> (forall a . m a -> n a) -> t1 (t2 (t3 (t4 (t5 n)))) b (|<<<<<|) f g = (g |>|) |>>>>| f ----------------------------------------------------------------------------------- TODO+infixl 5 |*****|+(|*****|) :: (Monad m, Monad (t2 (t3 (t4 (t5 m)))), Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), Monad (t5 m), +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              m a -> t1 (t2 (t3 (t4 (t5 m)))) a +(|*****|) = (|*|) . (|****|) -{--infixr 2  |>>=-class (MFunctor t2, MonadTrans t2) => MMonad2 t2 where-    (|>>=) :: (Monad n, Monad m, MMonad t1) => t1 (t2 m) b -> (forall a . m a -> t1 (t2 n) a) -> t1 (t2 n) b+infixl 5  |----*|+(|----*|) :: (Monad m, Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), Monad (t4 m), +              MFunctor t1, MFunctor t2, MFunctor t3, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t2 (t3 (t4 m))) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|----*|) = ((|*|) |>>>>|) -instance MMonad2 I.IdentityT where-    m |>>= f = (I.runIdentityT |>| m) |>= f+infixl 5  |---**|, |--*-*|, |-*--*|, |*---*|+(|---**|) :: (Monad m, Monad (t2 (t3 m)), Monad (t3 m), Monad (t5 m), +              MFunctor t1, MFunctor t2, MFunctor t3,+              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t2 (t3 m)) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|---**|) = ((|**|) |>>>|)+(|--*-*|) :: (Monad m, Monad (t2 (t4 m)), Monad (t4 m), Monad (t4 (t5 m)), Monad (t5 m), +              MFunctor t1, MFunctor t2, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t2 (t4 m)) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|--*-*|) = ((|*-*|) |>>|)+(|-*--*|) :: (Monad m, Monad (t3 (t4 m)), Monad (t4 m), Monad (t3 (t4 (t5 m))),+              MFunctor t1, MFunctor t3, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t3 (t4 m)) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|-*--*|) = ((|*--*|) |>|)+(|*---*|) :: (Monad m, Monad (t3 (t4 m)), Monad (t4 m), Monad (t2 (t3 (t4 (t5 m)))), +              MFunctor t2, MFunctor t3, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t2 (t3 (t4 m)) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|*---*|) = (|*|) . (|---*|) -infixr 2  >||>-(>||>) :: (Monad m2, Monad m3, MMonad t1, MMonad2 t2) => -          (forall a. m1 a -> t1 (t2 m2) a) -> (forall b. m2 b -> t1 (t2 m3) b) -> m1 c -> t1 (t2 m3) c-(f >||> g) m = f m |>>= g+infixl 5  |--***|, |-*-**|, |*--**|, |*-*-*|, |-**-*|, |**--*|+(|--***|) :: (Monad m, Monad (t2 m), Monad (t4 (t5 m)), Monad (t5 m),+              MFunctor t1, MFunctor t2, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t2 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|--***|) = ((|***|) |>>|)+(|-*-**|) :: (Monad m, Monad (t3 m), Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), Monad (t5 m),+              MFunctor t1, MFunctor t3, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t3 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|-*-**|) = ((|*-**|) |>|)+(|*--**|) :: (Monad m, Monad (t3 m), Monad (t2 (t3 (t4 (t5 m)))), Monad (t5 m), +              MFunctor t2, MFunctor t3, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t2 (t3 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|*--**|) = (|*|) . (|--**|)+(|*-*-*|) :: (Monad m, Monad (t4 m), Monad (t2 (t3 (t4 (t5 m)))), Monad (t4 (t5 m)), Monad (t5 m), +              MFunctor t2, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t2 (t4 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|*-*-*|) = (|*|) . (|-*-*|)+(|-**-*|) :: (Monad m, Monad (t4 m), Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), Monad (t5 m), +              MFunctor t1, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 (t4 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|-**-*|) = (|-*|) . (|-*-*|)+(|**--*|) :: (Monad m, Monad (t4 m), Monad (t2 (t3 (t4 (t5 m)))), Monad (t3 (t4 (t5 m))), Monad (t3 (t4 m)), +              MFunctor t3, MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t3 (t4 m) a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|**--*|) = (|*|) . (|*--*|) --}+infixl 5  |-****|, |*-***|, |**-**|, |***-*|+(|-****|) :: (Monad m, Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), Monad (t5 m), +              MFunctor t1, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t1 m a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|-****|) = ((|****|) |>|)+(|*-***|) :: (Monad m, Monad (t2 (t3 (t4 (t5 m)))), Monad (t4 (t5 m)), Monad (t5 m),+              MFunctor t2, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t2 m a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|*-***|) = (|*|) . (|-***|)+(|**-**|) :: (Monad m, Monad (t2 (t3 (t4 (t5 m)))), Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), Monad (t5 m), +              MFunctor t3, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t3 m a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|**-**|) = (|**|) . (|-**|)+(|***-*|) :: (Monad m, Monad (t2 (t3 (t4 (t5 m)))), Monad (t3 (t4 (t5 m))), Monad (t4 (t5 m)), +              MFunctor t4, +              MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4, MonadTrans t5) => +              t4 m a -> t1 (t2 (t3 (t4 (t5 m)))) a+(|***-*|) = (|***|) . (|-*|)  ---------------------------------------------------------------------- -- Examples -{- $Example_Level2-Here is a monad-morph example, a level-2 monad-morph.+{- $Example+Here is a monad morph example how to use trans-map functions.  >import DeepControl.Monad.Morph >import DeepControl.Monad.Trans.State@@ -146,7 +436,7 @@ > >tock                        ::                   StateT Int IO () >tock = do->    generalize |>| tick     :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous for (|$>) +>    generalize |>| tick     :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous to (|$>)  >    lift $ putStrLn "Tock!" :: (MonadTrans t) => t          IO () > >-- λ> runStateT tock 0@@ -163,7 +453,7 @@ >program = replicateM_ 4 $ do >    lift |>| tock >        :: (MonadTrans t) => StateT Int (t             IO) ()->    generalize |>>| save                                         -- (|>>|) is the level-2 trans-map function, analogous for (|$>>)+>    generalize |>>| save                                         -- (|>>|) is the level-2 trans-map function, analogous to (|$>>) >        :: (Monad      m) => StateT Int (WriterT [Int] m ) () > >-- λ> execWriterT (runStateT program 0)@@ -172,4 +462,61 @@ >-- Tock! >-- Tock! >-- [1,2,3,4]+-}++{- $Example-2+Here is a monad morph example how to use trans-cover and trans-bind functions.++>import DeepControl.Monad ((>-))+>import DeepControl.Monad.Morph ((|>=), (|>>=), (|*|), (|-*|))+>import DeepControl.Monad.Trans.Except+>+>import Control.Exception (IOException, try)+>import Control.Monad.Trans.Maybe+>+>-----------------------------------------------+>-- Level-1 +>+>catchIOError :: IO a -> +>                ExceptT IOException IO a   -- ExceptT-IO monad+>catchIOError io = ExceptT $ (try io)+>+>viewFile :: IO ()                          -- IO monad+>viewFile = do+>    str <- readFile "test.txt"        +>    putStr str+>+>program :: ExceptT IOException IO ()       -- ExceptT-IO monad+>program = (|*|) viewFile |>= catchIOError  -- (|*|) is the level-1 trans-cover function, alias to 'lift', analogous to (.*)+>                                           -- (|>=) is the level-1 trans-bind function, analogous to (>>=)+>+>calc_program :: IO (Either IOException ())+>calc_program = runExceptT $ program        +>+>-- > calc_program+>-- Left test.txt: openFile: does not exist (No such file or directory)+>+>-----------------------------------------------+>-- Level-2+>+>viewFile2 :: String -> +>             MaybeT IO ()                        -- MaybeT-IO monad+>viewFile2 filename = do+>    guard (filename /= "")+>    str <- (|*|) $ readFile "test.txt"        +>    (|*|) $ putStr str+>+>program2 :: String -> +>            (ExceptT IOException (MaybeT IO)) () -- ExceptT-MaybeT-IO monad+>program2 filename = +>    (|*|) (viewFile2 filename) |>>= \x ->        -- (|>>=) is the level-2 trans-bind function, analogous to (>>=)+>    (|-*|) $ catchIOError x                      -- (|-*|) is a level-2 trans-cover function, analogous to (-*)+>+>calc_program2 :: String -> IO (Maybe (Either IOException ())) +>calc_program2 filename = runMaybeT . runExceptT $ program2 filename+>+>-- > calc_program "test.txt"+>-- Just (Left test.txt: openFile: does not exist (No such file or directory))+>-- > calc_program ""+>-- Nothing -}

@@ -1,5 +1,5 @@ -------------------------------------------------------------------------------- |+-- | Deepened the usual Control.Monad.Signatures module. -- Module      :  DeepControl.Monad.Signatures -- Copyright   :  (c) Ross Paterson 2012, --                (c) 2015 KONISHI Yohsuke

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad.Trans-Description : Enable deep level Monad-Transform programming.+Description : Deepened the usual Control.Monad.Trans module. Copyright   : (c) Andy Gill 2001,               (c) Oregon Graduate Institute of Science and Technology, 2001,               (c) 2015 KONISHI Yohsuke@@ -15,542 +15,155 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-} module DeepControl.Monad.Trans (-    -- * Level-1-    -- ** trans-lift-    MonadTrans(..), -    liftT, liftTT, liftTTT, liftTTTT, liftTTTTT,-    -- ** trans-down-    MonadTransDown(..), M,-    -- ** trans-cover  -    MonadTransCover(..),-    -- ** other  +    module Control.Monad.Trans,+    -- * MonadTrans     MonadTrans_(..),       -- * Level-2-    -- ** trans-lift-    MonadTrans2(..), -    liftTT2, liftTTT2, liftTTTT2, liftTTTTT2,-    -- ** trans-down-    MonadTrans2Down(..), M_, T_, -    -- ** trans-fold -    MonadTransFold2(..), -    -- ** trans-cover  -    MonadTransCover2(..),-    (|**|),-    -- ** other  -    trans2, untrans2, +    -- ** trans-roll+    transroll2, untransroll2,      -- * Level-3-    -- ** trans-lift-    MonadTrans3(..), -    liftTT3, liftTTT3, liftTTTT3, liftTTTTT3,-    -- ** trans-down-    MonadTrans3Down(..), M__, T__, -    -- ** trans-fold -    MonadTransFold3(..), -    -- ** trans-cover -    MonadTransCover3(..),-    (|***|), -    (|-**|), (|*-*|), (|**-|),-    -- ** other  -    trans3, untrans3, +    -- ** trans-roll+    transroll3, untransroll3,      -- * Level-4-    -- ** trans-lift-    MonadTrans4(..),-    -- ** trans-down-    MonadTrans4Down(..), M___, T___, T2__,-    -- ** trans-fold -    MonadTransFold4(..), -    -- ** trans-cover -    MonadTransCover4(..),-    (|****|), -    (|--**|), (|-*-*|), (|-**-|), (|*-*-|), (|**--|), (|*--*|),-    (|-***|), (|*-**|), (|**-*|), (|***-|), -    -- ** other  -    trans4, untrans4, +    -- ** trans-roll+    transroll4, untransroll4,      -- * Level-5-    -- ** trans-lift-    MonadTrans5(..),-    -- ** trans-down-    MonadTrans5Down(..), M____, T____, T2___, T3___,-    -- ** trans-fold -    MonadTransFold5(..), -    -- ** trans-cover -    MonadTransCover5(..),-    (|---**|), (|--*-*|), (|-*--*|), (|*---*|), (|*--*-|), (|*-*--|), (|**---|),-    (|--***|), (|-*-**|), (|*--**|), (|*-*-*|), (|**--*|), (|**-*-|), (|***--|),-    (|-****|), (|*-***|), (|**-**|), (|***-*|), (|****-|),-    -- ** other  -    trans5, untrans5, --    -- * MonadIO-    MonadIO(..),+    -- ** trans-roll+    transroll5, untransroll5,      -- * Level-2 example     -- $Example_Level2 -    -- * Level-2 example2-    -- $Example_Level2_cover- ) where  import DeepControl.Applicative import DeepControl.Monad -import Control.Monad.IO.Class-import Control.Monad.Trans.Class (MonadTrans (..))-import qualified Control.Monad.List          as L-import qualified Control.Monad.Trans.Maybe   as M-import qualified Control.Monad.Except        as E-import Control.Monad.Identity-import Control.Monad.RWS (RWS, RWST(..), runRWS)-import Control.Monad.Reader (Reader, ReaderT(..), runReader)-import Control.Monad.State (State, StateT(..), runState)+import Control.Monad.Trans+import Control.Monad.Identity (Identity(..))+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.List (ListT(..))+import Control.Monad.Trans.Maybe (MaybeT(..))+import Control.Monad.Except (Except, ExceptT(..), runExcept, runExceptT)+import Control.Monad.Writer (Writer, WriterT(..), runWriter)+import Data.Monoid +-- import Control.Monad.Reader (Reader, ReaderT(..), runReader) +-- $setup+-- >>> import Control.Monad.Trans.Maybe+-- >>> import Control.Monad.List+-- >>> import Control.Monad.Except+-- >>> import Control.Monad.Writer+ ---------------------------------------------------------------------- -- Level-1 --- | Alias to @'lift'@-liftT :: (Monad m, MonadTrans t) => m a -> t m a -liftT = lift--liftTT-  :: (Monad m, Monad (t1 m), -      MonadTrans t, MonadTrans t1) =>-     m a -> t (t1 m) a-liftTT = liftT.liftT--liftTTT-  :: (Monad m, Monad (t1 (t2 m)), Monad (t2 m), MonadTrans t,-      MonadTrans t1, MonadTrans t2) =>-     m a -> t (t1 (t2 m)) a-liftTTT = liftT.liftT.liftT--liftTTTT-  :: (Monad m, Monad (t1 (t2 (t3 m))), Monad (t2 (t3 m)), Monad (t3 m), -      MonadTrans t, MonadTrans t1, MonadTrans t2, MonadTrans t3) =>-     m a -> t (t1 (t2 (t3 m))) a-liftTTTT = liftT.liftT.liftT.liftT--liftTTTTT-  :: (Monad m, Monad (t1 (t2 (t3 (t4 m)))), Monad (t2 (t3 (t4 m))), Monad (t3 (t4 m)), Monad (t4 m), -      MonadTrans t, MonadTrans t1, MonadTrans t2, MonadTrans t3, MonadTrans t4) =>-     m a -> t (t1 (t2 (t3 (t4 m)))) a-liftTTTTT = liftT.liftT.liftT.liftT.liftT--class (Monad (TransDown t1), MonadTrans t1) => MonadTransDown t1 where-    type TransDown t1 :: * -> *-type M t1 = TransDown t1--instance MonadTransDown L.ListT where-    type TransDown L.ListT = []-instance MonadTransDown M.MaybeT where-    type TransDown M.MaybeT = Maybe-instance MonadTransDown (E.ExceptT e) where-    type TransDown (E.ExceptT e) = E.Except e-instance (Monoid w) => MonadTransDown (RWST r w s) where-    type TransDown (RWST r w s) = RWS r w s-instance MonadTransDown (ReaderT r) where-    type TransDown (ReaderT r) = Reader r-instance MonadTransDown (StateT s) where-    type TransDown (StateT s) = State s--infixl 3  |*|-class (MonadTransDown t1) => MonadTransCover t1 where-    (|*|) :: Monad m1 => (TransDown t1) a -> t1 m1 a--instance MonadTransCover L.ListT where-    (|*|) = L.ListT . (*:)-instance MonadTransCover M.MaybeT where-    (|*|) = M.MaybeT . (*:)-instance MonadTransCover (E.ExceptT e) where-    (|*|) = E.ExceptT . (*:) . E.runExcept-instance (Monoid w) => MonadTransCover (RWST r w s) where-    (|*|) = RWST . ((*:)|$>>) . runRWS-instance MonadTransCover (ReaderT s) where-    (|*|) = ReaderT . ((*:)|$>) . runReader-instance MonadTransCover (StateT s) where-    (|*|) = StateT . ((*:)|$>) . runState+-- | Required only for transroll+class (Monad m, MonadTrans t) => MonadTrans_ m t | m -> t, t -> m where+    trans :: (Monad n) => n (m a) -> t n a+    untrans :: (Monad n) => t n a -> n (m a) --- | Required only for @'MonadTransFold2'@ and @'MonadTransFold3'@ -class MonadTrans_ t where-    trans :: (Monad m) => m ((TransDown t) a) -> t m a-    untrans :: (Monad m) => t m a -> m ((TransDown t) a)+instance MonadTrans_ Identity IdentityT where+    trans   = IdentityT . (runIdentity|$>)+    untrans = (Identity|$>) . runIdentityT+instance MonadTrans_ [] ListT where+    trans   = ListT+    untrans = runListT+instance MonadTrans_ Maybe MaybeT where+    trans   = MaybeT+    untrans = runMaybeT+instance MonadTrans_ (Except e) (ExceptT e) where+    trans x   = ExceptT ((runIdentity . runExceptT) |$> x)+    untrans x = (ExceptT . Identity) |$> runExceptT x+instance (Monoid w) => MonadTrans_ (Writer w) (WriterT w) where+    trans x   = WriterT ((runIdentity . runWriterT) |$> x)+    untrans x = (WriterT . Identity) |$> runWriterT x -instance MonadTrans_ L.ListT where-    trans   = L.ListT-    untrans = L.runListT-instance MonadTrans_ M.MaybeT where-    trans   = M.MaybeT-    untrans = M.runMaybeT-instance MonadTrans_ (E.ExceptT e) where-    untrans x = (E.ExceptT . Identity) |$> E.runExceptT x-    trans x   = E.ExceptT ((runIdentity . E.runExceptT) |$> x)+{- +instance MonadTrans_ (Reader r) (ReaderT r) where+    trans x   = ReaderT . sink $ (((runIdentity|$>) . runReaderT) |$> x)+    untrans x = (ReaderT . (Identity|$>)) |$> (sink . runReaderT) x      -- error: Could not deduce (Traversable ((->) r))+-}  ---------------------------------------------------------------------- -- Level-2 -class MonadTrans2 t where-    liftT2 :: (Monad m1, Monad m2) => m1 (m2 a) -> t m1 m2 a--liftTT2-  :: (Monad m1, Monad (t2 m1 m2), Monad m2,-      MonadTrans t1, MonadTrans2 t2) =>-     m1 (m2 a) -> t1 (t2 m1 m2) a-liftTT2 = liftT.liftT2--liftTTT2-  :: (Monad m1, Monad (t1 (t2 m1 m2)), Monad (t2 m1 m2), Monad m2, -      MonadTrans t, MonadTrans t1, MonadTrans2 t2) =>-     m1 (m2 a) -> t (t1 (t2 m1 m2)) a-liftTTT2 = liftT.liftT.liftT2--liftTTTT2-  :: (Monad m1, Monad (t1 (t1' (t2 m1 m2))), Monad (t1' (t2 m1 m2)), Monad (t2 m1 m2), Monad m2, -      MonadTrans t, MonadTrans t1, MonadTrans t1', MonadTrans2 t2) =>-     m1 (m2 a) -> t (t1 (t1' (t2 m1 m2))) a-liftTTTT2 = liftT.liftT.liftT.liftT2--liftTTTTT2-  :: (Monad m1, Monad (t1 (t1' (t1'' (t2 m1 m2)))), Monad (t1' (t1'' (t2 m1 m2))), Monad (t1'' (t2 m1 m2)), Monad (t2 m1 m2), Monad m2, -      MonadTrans t, MonadTrans t1, MonadTrans t1', MonadTrans t1'', MonadTrans2 t2) =>-     m1 (m2 a) -> t (t1 (t1' (t1'' (t2 m1 m2)))) a-liftTTTTT2 = liftT.liftT.liftT.liftT.liftT2--class (MonadTrans (Trans2Down t2), MonadTrans2 t2) => MonadTrans2Down t2 where-    type Trans2Down t2 :: (* -> *) -> * -> *-type T_ t2 = Trans2Down t2---type M_ t2 = TransDown (Trans2Down t2)-type M_ t2 = TransDown (T_ t2)- -- |  ----- Following property holds.+-- >>> transroll2 $ [Just 1]+-- MaybeT [Just 1] ----- > untransfold2 . transfold2 == id-class (MonadTrans (T_ t), MonadTrans2 t) => MonadTransFold2 t where-    transfold2 :: (Monad m1, Monad (t2 m1), -                   MonadTrans_ t2) => -                  t m1 (TransDown t2) a -> (T_ t) (t2 m1) a-    untransfold2 :: (Monad m1, Monad (t2 m1), -                     MonadTrans_ t2) => -                    (T_ t) (t2 m1) a -> t m1 (TransDown t2) a--infixl 3  |-*|, |*-|, |**|--class (MonadTransCover (Trans2Down t2)) => MonadTransCover2 t2 where-    (|-*|) :: (Monad m1, Monad m2) => (Trans2Down t2) m1 a -> t2 m1 m2 a-    (|*-|) :: (Monad m1, Monad m2) => (Trans2Down t2) m2 a -> t2 m1 m2 a--(|**|) :: (Monad m1, Monad m2, MonadTransCover2 t2) => -          (M_ t2) a -> t2 m1 m2 a-(|**|) = (|*-|) . (|*|) --trans2 :: (Monad m, Monad (t1 m), -           MonadTrans_ t1, MonadTrans_ t2) =>-          m ((TransDown t1) ((TransDown t2) a)) -> t2 (t1 m) a-trans2 = trans . trans-untrans2 :: (Monad m, Monad (t1 m), -             MonadTrans_ t1, MonadTrans_ t2) =>-            t2 (t1 m) a -> m ((TransDown t1) ((TransDown t2) a))-untrans2 = untrans . untrans--------------------------------------------------------------------------- Level-3--class MonadTrans3 t where-    liftT3 :: (Monad m1, Monad m2, Monad m3) => m1 (m2 (m3 a)) -> t m1 m2 m3 a--liftTT3-  :: (Monad m1, Monad (t3 m1 m2 m3), Monad m2, Monad m3,-      MonadTrans t, MonadTrans3 t3) =>-     m1 (m2 (m3 a)) -> t (t3 m1 m2 m3) a-liftTT3 = liftT.liftT3--liftTTT3-  :: (Monad m1, Monad (t1 (t3 m1 m2 m3)), Monad (t3 m1 m2 m3), Monad m2, Monad m3, -      MonadTrans t, MonadTrans t1, MonadTrans3 t3) =>-     m1 (m2 (m3 a)) -> t (t1 (t3 m1 m2 m3)) a-liftTTT3 = liftT.liftT.liftT3--liftTTTT3-  :: (Monad m1, Monad (t1 (t1' (t3 m1 m2 m3))), Monad (t1' (t3 m1 m2 m3)), Monad (t3 m1 m2 m3), Monad m2, Monad m3, -      MonadTrans t, MonadTrans t1, MonadTrans t1', MonadTrans3 t3) =>-     m1 (m2 (m3 a)) -> t (t1 (t1' (t3 m1 m2 m3))) a-liftTTTT3 = liftT.liftT.liftT.liftT3--liftTTTTT3-  :: (Monad m1, Monad (t1 (t1' (t1'' (t3 m1 m2 m3)))), Monad (t1' (t1'' (t3 m1 m2 m3))), Monad (t1'' (t3 m1 m2 m3)), Monad (t3 m1 m2 m3), Monad m2, Monad m3,-      MonadTrans t, MonadTrans t1, MonadTrans t1', MonadTrans t1'', MonadTrans3 t3) =>-     m1 (m2 (m3 a)) -> t (t1 (t1' (t1'' (t3 m1 m2 m3)))) a-liftTTTTT3 = liftT.liftT.liftT.liftT.liftT3--class (MonadTrans2 (Trans3Down t3), MonadTrans3 t3) => MonadTrans3Down t3 where-    type Trans3Down t3 :: (* -> *) -> (* -> *) -> * -> *-type M__ t3 = M_ (Trans3Down t3)-type T__ t3 = T_ (Trans3Down t3)-type T2_ t3 = Trans3Down t3+-- >>> transroll2 $ Just [1]+-- ListT (Just [1])+--+transroll2 :: (Monad m1, MonadTrans_ m2 t2) => m1 (m2 a) -> (t2 m1) a+transroll2 = trans  -- |  ----- Following property holds.+-- >>> untransroll2 $ MaybeT [Just 1]+-- [Just 1] ----- > untransfold3 . transfold3 == id-class (MonadTrans (T__ t), MonadTrans3 t) => MonadTransFold3 t where-    transfold3 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), -                   MonadTrans t2, MonadTrans_ t2, -                   MonadTrans t3, MonadTrans_ t3) => -                  t m1 (TransDown t2) (TransDown t3) a -> (T__ t) (t3 (t2 m1)) a-    untransfold3 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), -                     MonadTrans t2, MonadTrans_ t2, -                     MonadTrans t3, MonadTrans_ t3) => -                    (T__ t) (t3 (t2 m1)) a -> t m1 (TransDown t2) (TransDown t3) a--infixl 3  |--*|, |-*-|, |*--|-class (MonadTransCover2 (Trans3Down t3)) => MonadTransCover3 t3 where-    (|--*|) :: (Monad m1, Monad m2, Monad m3) => (Trans3Down t3) m1 m2 a -> t3 m1 m2 m3 a-    (|-*-|) :: (Monad m1, Monad m2, Monad m3) => (Trans3Down t3) m1 m3 a -> t3 m1 m2 m3 a-    (|*--|) :: (Monad m1, Monad m2, Monad m3) => (Trans3Down t3) m2 m3 a -> t3 m1 m2 m3 a--infixl 3  |***|-(|***|) :: (Monad m1, Monad m2, Monad m3, MonadTransCover3 t3) => -           (M__ t3) a -> t3 m1 m2 m3 a-infixl 3  |-**|, |*-*|, |**-|-(|***|) = (|--*|) . (|**|)-(|-**|) :: (Monad m1, Monad m2, Monad m3, MonadTransCover3 t3) => -           (T__ t3) m1 a -> t3 m1 m2 m3 a-(|-**|) = (|--*|) . (|-*|)-(|*-*|) :: (Monad m1, Monad m2, Monad m3, MonadTransCover3 t3) => -           (T__ t3) m2 a -> t3 m1 m2 m3 a-(|*-*|) = (|--*|) . (|*-|)-(|**-|) :: (Monad m1, Monad m2, Monad m3, MonadTransCover3 t3) => -           (T__ t3) m3 a -> t3 m1 m2 m3 a-(|**-|) = (|-*-|) . (|*-|)--trans3 :: (Monad m, Monad (t2 (t1 m)), Monad (t1 m),-           MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3) =>-          m ((TransDown t1) ((TransDown t2) ((TransDown t3) a))) -> t3 (t2 (t1 m)) a-trans3 = trans2 . trans-untrans3 :: (Monad m, Monad (t2 (t1 m)), Monad (t1 m),-             MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3) =>-            t3 (t2 (t1 m)) a -> m ((TransDown t1) ((TransDown t2) ((TransDown t3) a)))-untrans3 = untrans2 . untrans+-- >>> untransroll2 $ ListT (Just [1])+-- Just [1]+--+untransroll2 :: (Monad m1, MonadTrans_ m2 t2) => (t2 m1) a -> m1 (m2 a)+untransroll2 = untrans  ------------------------------------------------------------------------- Level-4--class  MonadTrans4 t  where-    liftT4 :: (Monad m1, Monad m2, Monad m3, Monad m4) => m1 (m2 (m3 (m4 a))) -> t m1 m2 m3 m4 a--class (MonadTrans3 (Trans4Down t4), MonadTrans4 t4) => MonadTrans4Down t4 where-    type Trans4Down t4 :: (* -> *) -> (* -> *) -> (* -> *) -> * -> *-type M___ t4 = M__ (Trans4Down t4)-type T___ t4 = T__ (Trans4Down t4)-type T2__ t4 = Trans3Down (Trans4Down t4)+-- Level-3  -- |  ----- Following property holds.+-- >>> transroll3 $ ExceptT (Identity (Right [Just 1]))+-- MaybeT (ListT (ExceptT (Identity (Right [Just 1])))) ----- > untransfold4 . transfold4 == id-class (MonadTrans (T___ t), MonadTrans4 t) => MonadTransFold4 t where-    transfold4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), -                   MonadTrans t2, MonadTrans_ t2, -                   MonadTrans t3, MonadTrans_ t3,-                   MonadTrans t4, MonadTrans_ t4) => -                  t m1 (TransDown t2) (TransDown t3) (TransDown t4) a -> (T___ t) (t4 (t3 (t2 m1))) a-    untransfold4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), -                     MonadTrans t2, MonadTrans_ t2, -                     MonadTrans t3, MonadTrans_ t3,-                     MonadTrans t4, MonadTrans_ t4) => -                    (T___ t) (t4 (t3 (t2 m1))) a -> t m1 (TransDown t2) (TransDown t3) (TransDown t4) a--infixl 3  |---*|, |--*-|, |-*--|, |*---|-class (MonadTransCover3 (Trans4Down t4)) => MonadTransCover4 t4 where-    (|---*|) :: (Monad m1, Monad m2, Monad m3, Monad m4) => (Trans4Down t4) m1 m2 m3 a -> t4 m1 m2 m3 m4 a-    (|--*-|) :: (Monad m1, Monad m2, Monad m3, Monad m4) => (Trans4Down t4) m1 m2 m4 a -> t4 m1 m2 m3 m4 a-    (|-*--|) :: (Monad m1, Monad m2, Monad m3, Monad m4) => (Trans4Down t4) m1 m3 m4 a -> t4 m1 m2 m3 m4 a-    (|*---|) :: (Monad m1, Monad m2, Monad m3, Monad m4) => (Trans4Down t4) m2 m3 m4 a -> t4 m1 m2 m3 m4 a--infixl 3  |****|-(|****|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (M___ t4) a -> t4 m1 m2 m3 m4 a-(|****|) = (|---*|) . (|***|)-infixl 3  |--**|, |-*-*|, |-**-|, |*-*-|, |**--|, |*--*|-(|--**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m1 m2 a -> t4 m1 m2 m3 m4 a-(|--**|) = (|---*|) . (|--*|)-(|-*-*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m1 m3 a -> t4 m1 m2 m3 m4 a-(|-*-*|) = (|---*|) . (|-*-|)-(|-**-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m1 m4 a -> t4 m1 m2 m3 m4 a-(|-**-|) = (|--*-|) . (|-*-|)-(|*-*-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m2 m4 a -> t4 m1 m2 m3 m4 a-(|*-*-|) = (|--*-|) . (|*--|)-(|**--|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m3 m4 a -> t4 m1 m2 m3 m4 a-(|**--|) = (|-*--|) . (|*--|)-(|*--*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T2__ t4) m2 m3 a -> t4 m1 m2 m3 m4 a-(|*--*|) = (|---*|) . (|*--|)-infixl 3  |-***|, |*-**|, |**-*|, |***-| -(|-***|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T___ t4) m1 a -> t4 m1 m2 m3 m4 a-(|-***|) = (|---*|) . (|-**|)-(|*-**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T___ t4) m2 a -> t4 m1 m2 m3 m4 a-(|*-**|) = (|---*|) . (|*-*|)-(|**-*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T___ t4) m3 a -> t4 m1 m2 m3 m4 a-(|**-*|) = (|---*|) . (|**-|)-(|***-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, MonadTransCover4 t4) => -            (T___ t4) m4 a -> t4 m1 m2 m3 m4 a-(|***-|) = (|--*-|) . (|**-|)--trans4 :: (Monad m, Monad (t3 (t2 (t1 m))), Monad (t2 (t1 m)), Monad (t1 m),-           MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4) =>-          m ((TransDown t1) ((TransDown t2) ((TransDown t3) ((TransDown t4) a)))) -> t4 (t3 (t2 (t1 m))) a-trans4 = trans3 . trans-untrans4 :: (Monad m, Monad (t3 (t2 (t1 m))), Monad (t2 (t1 m)), Monad (t1 m),-             MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4) =>-            t4 (t3 (t2 (t1 m))) a -> m ((TransDown t1) ((TransDown t2) ((TransDown t3) ((TransDown t4) a))))-untrans4 = untrans3 . untrans--------------------------------------------------------------------------- Level-5--class MonadTrans5 t where-    liftT5 :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => m1 (m2 (m3 (m4 (m5 a)))) -> t m1 m2 m3 m4 m5 a--class (MonadTrans4 (Trans5Down t5), MonadTrans5 t5) => MonadTrans5Down t5 where-    type Trans5Down t5 :: (* -> *) -> (* -> *) -> (* -> *) -> (* -> *) -> * -> *-type M____ t5 = M___ (Trans5Down t5)-type T____ t5 = T___ (Trans5Down t5)-type T2___ t5 = T2__ (Trans5Down t5)-type T3___ t5 = Trans4Down (Trans5Down t5)-+transroll3 :: (Monad m1, Monad (t2 m1), MonadTrans_ m2 t2, MonadTrans_ m3 t3) => m1 (m2 (m3 a)) -> t3 (t2 m1) a+transroll3 = trans . trans -- |  ----- Following property holds.+-- >>> untransroll3 $ MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+-- ExceptT (Identity (Right [Just 1])) ----- > untransfold5 . transfold5 == id-class (MonadTrans (T____ t), MonadTrans5 t) => MonadTransFold5 t where-    transfold5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), Monad (t5 (t4 (t3 (t2 m1)))), -                   MonadTrans t2, MonadTrans_ t2, -                   MonadTrans t3, MonadTrans_ t3,-                   MonadTrans t4, MonadTrans_ t4,-                   MonadTrans t5, MonadTrans_ t5) => -                  t m1 (TransDown t2) (TransDown t3) (TransDown t4) (TransDown t5) a -> (T____ t) (t5 (t4 (t3 (t2 m1)))) a-    untransfold5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), Monad (t5 (t4 (t3 (t2 m1)))), -                     MonadTrans t2, MonadTrans_ t2, -                     MonadTrans t3, MonadTrans_ t3,-                     MonadTrans t4, MonadTrans_ t4,-                     MonadTrans t5, MonadTrans_ t5) => -                    (T____ t) (t5 (t4 (t3 (t2 m1)))) a -> t m1 (TransDown t2) (TransDown t3) (TransDown t4) (TransDown t5) a+untransroll3 :: (Monad m1, Monad (t2 m1), MonadTrans_ m2 t2, MonadTrans_ m3 t3) => t3 (t2 m1) a -> m1 (m2 (m3 a))+untransroll3 = untrans . untrans -infixl 3  |----*|, |---*-|, |--*--|, |-*---|, |*----|-class (MonadTransCover4 (Trans5Down t5)) => MonadTransCover5 t5 where-    (|----*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => (Trans5Down t5) m1 m2 m3 m4 a -> t5 m1 m2 m3 m4 m5 a-    (|---*-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => (Trans5Down t5) m1 m2 m3 m5 a -> t5 m1 m2 m3 m4 m5 a-    (|--*--|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => (Trans5Down t5) m1 m2 m4 m5 a -> t5 m1 m2 m3 m4 m5 a-    (|-*---|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => (Trans5Down t5) m1 m3 m4 m5 a -> t5 m1 m2 m3 m4 m5 a-    (|*----|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => (Trans5Down t5) m2 m3 m4 m5 a -> t5 m1 m2 m3 m4 m5 a+----------------------------------------------------------------------+-- Level-4 -infixl 3  |*****|-(|*****|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (M____ t5) a -> t5 m1 m2 m3 m4 m5 a-(|*****|) = (|----*|) . (|****|)-infixl 3  |---**|, |--*-*|, |-*--*|, |*---*|, |*--*-|, |*-*--|, |**---|-(|---**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m1 m2 m3 a -> t5 m1 m2 m3 m4 m5 a-(|---**|) = (|----*|) . (|---*|)-(|--*-*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m1 m2 m4 a -> t5 m1 m2 m3 m4 m5 a-(|--*-*|) = (|----*|) . (|--*-|)-(|-*--*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m1 m3 m4 a -> t5 m1 m2 m3 m4 m5 a-(|-*--*|) = (|----*|) . (|-*--|)-(|*---*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m2 m3 m4 a -> t5 m1 m2 m3 m4 m5 a-(|*---*|) = (|----*|) . (|*---|)-(|*--*-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m2 m3 m5 a -> t5 m1 m2 m3 m4 m5 a-(|*--*-|) = (|---*-|) . (|*---|)-(|*-*--|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m2 m4 m5 a -> t5 m1 m2 m3 m4 m5 a-(|*-*--|) = (|--*--|) . (|*---|)-(|**---|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T3___ t5) m3 m4 m5 a -> t5 m1 m2 m3 m4 m5 a-(|**---|) = (|-*---|) . (|*---|)-infixl 3  |--***|, |-*-**|, |*--**|, |*-*-*|, |**--*|, |**-*-|, |***--|-(|--***|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m1 m2 a -> t5 m1 m2 m3 m4 m5 a-(|--***|) = (|----*|) . (|--**|)-(|-*-**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m1 m3 a -> t5 m1 m2 m3 m4 m5 a-(|-*-**|) = (|----*|) . (|-*-*|)-(|*--**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m2 m3 a -> t5 m1 m2 m3 m4 m5 a-(|*--**|) = (|----*|) . (|*--*|)-(|*-*-*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m2 m4 a -> t5 m1 m2 m3 m4 m5 a-(|*-*-*|) = (|----*|) . (|*-*-|)-(|**--*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m3 m4 a -> t5 m1 m2 m3 m4 m5 a-(|**--*|) = (|----*|) . (|**--|)-(|**-*-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m3 m5 a -> t5 m1 m2 m3 m4 m5 a-(|**-*-|) = (|---*-|) . (|**--|)-(|***--|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T2___ t5) m4 m5 a -> t5 m1 m2 m3 m4 m5 a-(|***--|) = (|--*--|) . (|**--|)-infixl 3  |-****|, |*-***|, |**-**|, |***-*|, |****-|-(|-****|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T____ t5) m1 a -> t5 m1 m2 m3 m4 m5 a-(|-****|) = (|----*|) . (|-***|)-(|*-***|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T____ t5) m2 a -> t5 m1 m2 m3 m4 m5 a-(|*-***|) = (|----*|) . (|*-**|)-(|**-**|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T____ t5) m3 a -> t5 m1 m2 m3 m4 m5 a-(|**-**|) = (|----*|) . (|**-*|)-(|***-*|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T____ t5) m4 a -> t5 m1 m2 m3 m4 m5 a-(|***-*|) = (|----*|) . (|***-|)-(|****-|) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5, MonadTransCover5 t5) => -            (T____ t5) m5 a -> t5 m1 m2 m3 m4 m5 a-(|****-|) = (|---*-|) . (|***-|)+transroll4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4) => m1 (m2 (m3 (m4 a))) -> t4 (t3 (t2 m1)) a+transroll4 = trans . trans . trans+untransroll4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4) => t4 (t3 (t2 m1)) a -> m1 (m2 (m3 (m4 a)))+untransroll4 = untrans . untrans . untrans -trans5 :: (Monad m, Monad (t4 (t3 (t2 (t1 m)))), Monad (t3 (t2 (t1 m))), Monad (t2 (t1 m)), Monad (t1 m),-           MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4, MonadTrans_ t5) =>-          m ((TransDown t1) ((TransDown t2) ((TransDown t3) ((TransDown t4) ((TransDown t5) a))))) -> t5 (t4 (t3 (t2 (t1 m)))) a-trans5 = trans4 . trans-untrans5 :: (Monad m, Monad (t4 (t3 (t2 (t1 m)))), Monad (t3 (t2 (t1 m))), Monad (t2 (t1 m)), Monad (t1 m),-             MonadTrans_ t1, MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4, MonadTrans_ t5) =>-            t5 (t4 (t3 (t2 (t1 m)))) a -> m ((TransDown t1) ((TransDown t2) ((TransDown t3) ((TransDown t4) ((TransDown t5) a)))))-untrans5 = untrans4 . untrans+----------------------------------------------------------------------+-- Level-4 +transroll5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4, MonadTrans_ m5 t5) => +              m1 (m2 (m3 (m4 (m5 a)))) -> t5 (t4 (t3 (t2 m1))) a+transroll5 = trans . trans . trans . trans+untransroll5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4, MonadTrans_ m5 t5) => +                t5 (t4 (t3 (t2 m1))) a -> m1 (m2 (m3 (m4 (m5 a))))+untransroll5 = untrans . untrans . untrans . untrans  ---------------------------------------------------------------------- -- Examples  {- $Example_Level2-Here is a monad transformer example how to implement Ackermann function, improved to stop within a certain limit of time, with ReaderT-IdentityT2-IO-Maybe monad, a level-2 monad-transformation.+Here is a monad transformer example how to implement Ackermann function improved to stop within a certain limit of time, with ReaderT-IdentityT2-IO-Maybe monad, a level-2 monad-transformation.  >import DeepControl.Applicative->import DeepControl.Commutative (commute)+>import DeepControl.Traversable (sink) >import DeepControl.Monad ((>-))->import DeepControl.Monad.Morph ((|>|))->import DeepControl.Monad.Trans (liftTT2, transfold2, untransfold2)->import DeepControl.Monad.Trans.Identity+>import DeepControl.Monad.Morph ((|*|), (|>|))+>import DeepControl.Monad.Trans (transroll2, untransroll2)+>import DeepControl.Monad.Trans.Identity (Identity(..), IdentityT(..), IdentityT2(..)) >import Control.Monad.Reader >import Control.Monad.Trans.Maybe >@@ -559,76 +172,34 @@ >type TimeLimit = Int > >ackermannTimeLimit :: TimeLimit -> Int -> Int -> ->                      IO (Maybe Int)                     -- IO-Maybe Monad+>                      IO (Maybe Int)                      -- IO-Maybe Monad >ackermannTimeLimit timelimit x y = timeout timelimit (ackermannIO x y) >  where >    ackermannIO :: Int -> Int -> IO Int->    ackermannIO 0 n = (*:) $ n + 1+>    ackermannIO 0 n = (.*) $ n + 1 >    ackermannIO m n | m > 0 && n == 0 = ackermannIO (m-1) 1 >                    | m > 0 && n > 0  = ackermannIO m (n-1) >>= ackermannIO (m-1) >  >ackermann :: Int -> Int -> ->             ReaderT TimeLimit (IdentityT2 IO Maybe) Int -- ReaderT-IdentityT2-IO-Maybe monad+>             ReaderT TimeLimit (IdentityT2 IO Maybe) Int  -- ReaderT-IdentityT2-IO-Maybe monad >ackermann x y = do >    timelimit <- ask->    liftTT2 $ ackermannTimeLimit timelimit x y           -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function+>    (|*|) . IdentityT2 $ ackermannTimeLimit timelimit x y -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function > >calc_ackermann :: TimeLimit -> Int -> Int -> IO (Maybe Int) >calc_ackermann timelimit x y = ackermann x y >- \r -> runReaderT r timelimit >                                             >- runIdentityT2 >->-- λ> commute $ calc_ackermann 1000 |$> [0..4] |* 4+>-- λ> sink $ calc_ackermann 1000 |$> [0..4] |* 4 >-- [Just 5,Just 6,Just 11,Just 125,Nothing] > >ackermann' :: Int -> Int -> ->              ReaderT TimeLimit (MaybeT IO) Int                -- ReaderT-MaybeT-IO monad->ackermann' x y = (runIdentityT . transfold2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function+>              ReaderT TimeLimit (MaybeT IO) Int                 -- ReaderT-MaybeT-IO monad+>ackermann' x y = (transroll2 . runIdentityT2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function > >ackermann'' :: Int -> Int -> ->               ReaderT TimeLimit (IdentityT2 IO Maybe) Int      -- ReaderT-IdentityT2-IO-Maybe monad->ackermann'' x y = (untransfold2 . IdentityT) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function+>               ReaderT TimeLimit (IdentityT2 IO Maybe) Int       -- ReaderT-IdentityT2-IO-Maybe monad+>ackermann'' x y = (IdentityT2 . untransroll2) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function -} -{- $Example_Level2_cover-Here is a monad transformer example showing how to use trans-cover functions. ->import DeepControl.Applicative ((|$>))->import DeepControl.Commutative (Commutative)->import DeepControl.Monad (Monad)->import DeepControl.Monad.Morph ((|>|))->import DeepControl.Monad.Trans (liftT, (|*|), (|-*|), (|*-|))->import DeepControl.Monad.Trans.Identity->import Control.Monad.Writer->import Control.Monad.State->->tick :: State Int ()->tick = modify (+1)->->tock                         ::                   StateT Int IO ()->tock = do->    (|*|) tick               :: (Monad      m) => StateT Int m  ()  -- (|*|) is the level-1 trans-cover function, analogous for (*:)->    liftT $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- 'liftT' is the level-1 trans-lift function, alias to 'lift'->->-- λ> runStateT tock 0->-- Tock!->-- ((),1)->->save :: StateT Int (Writer [Int]) ()->save = do->    n <- get->    liftT $ tell [n]->->program ::                             StateT Int (IdentityT2 IO (Writer [Int])) () -- StateT-IdentityT2-IO-Writer monad, a level-2 monad-transform->program = replicateM_ 4 $ do->    ((|-*|).liftT) |>| tock                                                         -- (|-*|) is a level-2 trans-cover function, analogous for (-*)->        :: (Monad m, Commutative m) => StateT Int (IdentityT2 IO m             ) ()->    ((|*-|).liftT) |>| save                                                         -- (|*-|) is a level-2 trans-cover function, analogous for (*:)->        :: (Monad m               ) => StateT Int (IdentityT2 m  (Writer [Int])) ()->->-- λ> execWriter |$> runIdentityT2 (runStateT program 0)->-- Tock!->-- Tock!->-- Tock!->-- Tock!->-- [1,2,3,4]--}

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad.Trans.Except-Description : Extension for mtl's Contrl.Monad.Except.+Description : Deepened the usual Control.Monad.Except module. Copyright   : (C) 2013 Ross Paterson,               (c) 2015 KONISHI Yohsuke  License     : BSD-style (see the file LICENSE)@@ -15,6 +15,9 @@ module DeepControl.Monad.Trans.Except (     module Control.Monad.Except, +    -- * Useful function+    --except,+     -- * Level-2     throwError2,     catchError2,@@ -34,41 +37,48 @@     ) where   import DeepControl.Applicative-import DeepControl.Commutative+import DeepControl.Traversable import DeepControl.Monad import DeepControl.Monad.Signatures  import Control.Monad.Except+import Data.Functor.Identity  ----------------------------------------------------------------+-- ++--except :: Either e a -> Except e a+--except = ExceptT . Identity++---------------------------------------------------------------- -- Level-2  throwError2 :: (MonadError e m2, Applicative m1) => e -> m1 (m2 a)-throwError2 = (*:) |$> throwError+throwError2 = (.*) |$> throwError -catchError2 :: (MonadError e m2, Commutative m1, Applicative m1, Commutative m2, Applicative m2) => +catchError2 :: (MonadError e m2, Traversable m1, Applicative m1, Traversable m2, Applicative m2) =>                 Catch2 e m1 m2 a catchError2 = liftCatch catchError   where-    liftCatch :: (Commutative m1, Applicative m1, Commutative m2, Applicative m2) => +    liftCatch :: (Traversable m1, Applicative m1, Traversable m2, Applicative m2) =>                   (forall a. Catch e m2 a) -> Catch2 e m1 m2 a     liftCatch catch m h = -        let m' = commute m-            h' = commute |$> h-        in commute $ catch m' h'+        let m' = sink m+            h' = sink |$> h+        in sink $ catch m' h'   ---------------------------------------------------------------- -- Level-3  throwError3 :: (MonadError e m3, Applicative m1, Applicative m2) => e -> m1 (m2 (m3 a))-throwError3 = (**:) |$> throwError+throwError3 = (.**) |$> throwError -catchError3 :: (MonadError e m3, Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3) => +catchError3 :: (MonadError e m3, Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3) =>                 Catch3 e m1 m2 m3 a catchError3 = liftCatch catchError   where-    liftCatch :: (Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3) => +    liftCatch :: (Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3) =>                   (forall a. Catch e m3 a) -> Catch3 e m1 m2 m3 a     liftCatch catch m h =          let m' = float2 m@@ -79,13 +89,13 @@ -- Level-4  throwError4 :: (MonadError e m4, Applicative m1, Applicative m2, Applicative m3) => e -> m1 (m2 (m3 (m4 a)))-throwError4 = (***:) |$> throwError+throwError4 = (.***) |$> throwError -catchError4 :: (MonadError e m4, Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3, Commutative m4, Applicative m4) => +catchError4 :: (MonadError e m4, Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3, Traversable m4, Applicative m4) =>                 Catch4 e m1 m2 m3 m4 a catchError4 = liftCatch catchError   where-    liftCatch :: (Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3, Commutative m4, Applicative m4) => +    liftCatch :: (Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3, Traversable m4, Applicative m4) =>                   (forall a. Catch e m4 a) -> Catch4 e m1 m2 m3 m4 a     liftCatch catch m h =          let m' = float3 m@@ -96,13 +106,13 @@ -- Level-5  throwError5 :: (MonadError e m5, Applicative m1, Applicative m2, Applicative m3, Applicative m4) => e -> m1 (m2 (m3 (m4 (m5 a))))-throwError5 = (****:) |$> throwError+throwError5 = (.****) |$> throwError -catchError5 :: (MonadError e m5, Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3, Commutative m4, Applicative m4, Commutative m5, Applicative m5) => +catchError5 :: (MonadError e m5, Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3, Traversable m4, Applicative m4, Traversable m5, Applicative m5) =>                 Catch5 e m1 m2 m3 m4 m5 a catchError5 = liftCatch catchError   where-    liftCatch :: (Commutative m1, Applicative m1, Commutative m2, Applicative m2, Commutative m3, Applicative m3, Commutative m4, Applicative m4, Commutative m5, Applicative m5) =>+    liftCatch :: (Traversable m1, Applicative m1, Traversable m2, Applicative m2, Traversable m3, Applicative m3, Traversable m4, Applicative m4, Traversable m5, Applicative m5) =>                  (forall a. Catch e m5 a) -> Catch5 e m1 m2 m3 m4 m5 a     liftCatch catch m h =          let m' = float4 m

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad.Trans.Identity-Description : Enables dealing with deep monads in monad-transformer+Description : Deepened the usual Control.Monad.Trans.Identity module. Copyright   : (c) 2007 Magnus Therning,               (c) 2015 KONISHI Yohsuke License     : BSD-style (see the file LICENSE)@@ -18,30 +18,60 @@     module Data.Functor.Identity,     module Control.Monad.Trans.Identity, +    -- * Level-1+    -- ** identity-cover  +    (*:),+     -- * Level-2     IdentityT2(..),-    -- ** lift functions+    -- ** identity-cover  +    (**:),+    (-*:), (*-:),+    -- ** identity-roll  +    transrollI2, untransrollI2,+    -- ** lift     mapIdentityT2, liftCallCC2, liftCatch2,      -- * Level-3     IdentityT3(..),-    -- ** lift functions+    -- ** identity-cover  +    (***:),+    (--*:), (-*-:), (*--:),+    (-**:), (*-*:), (**-:),+    -- ** identity-roll  +    transrollI3, untransrollI3,+    -- ** lift      mapIdentityT3, liftCallCC3, liftCatch3,      -- * Level-4     IdentityT4(..),-    -- ** lift functions+    -- ** identity-cover+    (****:),+    (---*:), (--*-:), (-*--:), (*---:),+    (--**:), (-*-*:), (*--*:), (*-*-:), (-**-:), (**--:), +    (-***:), (*-**:), (**-*:), (***-:), +    -- ** identity-roll  +    transrollI4, untransrollI4,+    -- ** lift      mapIdentityT4, liftCallCC4, liftCatch4,      -- * Level-5     IdentityT5(..),-    -- ** lift functions+    -- ** identity-cover+    (*****:),+    (----*:), (---*-:), (--*--:), (-*---:), (*----:),+    (---**:), (--*-*:), (-*--*:), (*---*:), (*--*-:), (-*-*-:), (--**-:), (-**--:), (*-*--:), (**---:),+    (--***:), (-*-**:), (*--**:), (*-*-*:), (-**-*:), (**--*:), (**-*-:), (*-**-:), (-***-:), (***--:),+    (-****:), (*-***:), (**-**:), (***-*:), (****-:),+    -- ** identity-roll  +    transrollI5, untransrollI5,+    -- ** lift      mapIdentityT5, liftCallCC5, liftCatch5,      ) where   import DeepControl.Applicative-import DeepControl.Commutative+import DeepControl.Traversable import DeepControl.Monad import DeepControl.Monad.Trans import DeepControl.Monad.Signatures@@ -49,17 +79,34 @@ import Data.Functor.Identity import Control.Monad.Trans.Identity +-- $setup+-- >>> import Control.Monad.Trans.Maybe+-- >>> import Control.Monad.List+-- >>> import Control.Monad.Except+-- >>> import Control.Monad.Writer+ ---------------------------------------------------------------------- -- Level-1 -instance (Commutative f) => Commutative (IdentityT f) where-    commute = (IdentityT|$>) . commute . runIdentityT+infixl 3  *:+-- | The level-1 identity-cover function, analogous to @'(.*)'@+--+-- >>> (*:) (Identity 1) :: IdentityT [] Int+-- IdentityT [1]+--+-- >>> (*:) (Identity 1) :: IdentityT Maybe Int+-- IdentityT (Just 1)+--+(*:) :: (Monad m) => Identity a -> IdentityT m a+(*:) = IdentityT . (.*) . runIdentity -instance MonadTransDown IdentityT where-    type TransDown IdentityT = Identity+-- TODO: ($>:)+--($>:) :: (m a -> n b) -> IdentityT m a -> IdentityT n b+--($>:) = mapIdentityT -instance MonadTransCover IdentityT where-    (|*|) = IdentityT . (*:) . runIdentity+-- | Lift a binary operation to the new monad.+-- lift2IdentityT :: (m a -> n b -> p c) -> IdentityT m a -> IdentityT n b -> IdentityT p c+-- lift2IdentityT f a b = IdentityT (f (runIdentityT a) (runIdentityT b))  ---------------------------------------------------------------------- -- Level-2@@ -67,30 +114,29 @@ newtype IdentityT2 f1 f2 a = IdentityT2 { runIdentityT2 :: f1 (f2 a) }     deriving (Functor, Eq, Ord, Read, Show, Foldable, Traversable) -instance (Commutative f1, Commutative f2) => Commutative (IdentityT2 f1 f2) where-    commute = (IdentityT2|$>) . float2 . runIdentityT2- instance (Applicative m1, Applicative m2) => Applicative (IdentityT2 m1 m2) where-    pure x = IdentityT2 $ (**:) x+    pure x = IdentityT2 $ (.**) x     (<*>) = lift2IdentityT2 (|*>>)-instance (Monad m1, Monad m2, Commutative m2) => Monad (IdentityT2 m1 m2) where-    return = IdentityT2 . (**:)+instance (Monad m1, Monad m2, Traversable m2) => Monad (IdentityT2 m1 m2) where+    return = IdentityT2 . (.**)     m >>= f = IdentityT2 $ runIdentityT2 m >>== (f >-> runIdentityT2)  instance (Alternative m1, Alternative m2) => Alternative (IdentityT2 m1 m2) where     empty = IdentityT2 empty     (<|>) = lift2IdentityT2 (<|>)-instance (MonadPlus m1, Alternative m2, Monad m2, Commutative m2) => MonadPlus (IdentityT2 m1 m2) where+instance (MonadPlus m1, Alternative m2, Monad m2, Traversable m2) => MonadPlus (IdentityT2 m1 m2) where     mzero = IdentityT2 mzero     mplus = lift2IdentityT2 mplus -instance MonadTrans2 IdentityT2 where-    liftT2 = IdentityT2-instance (MonadIO m1, Monad m1, Monad m2, Commutative m2) => MonadIO (IdentityT2 m1 m2) where-    liftIO = liftT2 . (-*) . liftIO+instance (MonadIO m1, Monad m1, Monad m2, Traversable m2) => MonadIO (IdentityT2 m1 m2) where+    liftIO = IdentityT2 . (-*) . liftIO -lift2IdentityT2 ::-    (m1 (m2 a) -> n1 (n2 b) -> p1 (p2 c)) -> IdentityT2 m1 m2 a -> IdentityT2 n1 n2 b -> IdentityT2 p1 p2 c+transrollI2 :: (Monad m1, MonadTrans_ m2 t2) => IdentityT2 m1 m2 a -> IdentityT (t2 m1) a+transrollI2 = IdentityT . transroll2 . runIdentityT2+untransrollI2 :: (Monad m1, MonadTrans_ m2 t2) => IdentityT (t2 m1) a -> IdentityT2 m1 m2 a+untransrollI2 = IdentityT2 . untransroll2 . runIdentityT++lift2IdentityT2 :: (m1 (m2 a) -> n1 (n2 b) -> p1 (p2 c)) -> IdentityT2 m1 m2 a -> IdentityT2 n1 n2 b -> IdentityT2 p1 p2 c lift2IdentityT2 f a b = IdentityT2 (f (runIdentityT2 a) (runIdentityT2 b))  mapIdentityT2 :: (m1 (m2 a) -> n1 (n2 b)) -> IdentityT2 m1 m2 a -> IdentityT2 n1 n2 b@@ -102,16 +148,38 @@ liftCatch2 :: Catch2 e m1 m2 a -> Catch e (IdentityT2 m1 m2) a liftCatch2 catch m h = IdentityT2 $ (runIdentityT2 m) `catch` (h >-> runIdentityT2) -instance MonadTrans2Down IdentityT2 where-    type Trans2Down IdentityT2 = IdentityT--instance MonadTransFold2 IdentityT2 where-    transfold2 (IdentityT2 x) = IdentityT $ trans x-    untransfold2 (IdentityT x) = IdentityT2 $ untrans x--instance MonadTransCover2 IdentityT2 where-    (|-*|) = IdentityT2 . (-*) . runIdentityT-    (|*-|) = IdentityT2 . (*:) . runIdentityT+infixl 3  **:+-- | The level-2 identity-cover function, analogous to @'(**:)'@+--+-- >>> (**:) (Identity 1) :: IdentityT2 [] Maybe Int+-- IdentityT2 {runIdentityT2 = [Just 1]}+--+-- >>> (**:) (Identity 1) :: IdentityT2 (Except ()) (Writer String) Int+-- IdentityT2 {runIdentityT2 = ExceptT (Identity (Right (WriterT (Identity (1,"")))))}+--+(**:) :: (Monad m1, Monad m2) => Identity a -> IdentityT2 m1 m2 a+(**:) = IdentityT2 . (.**) . runIdentity+infixl 3  -*:, *-:+-- | The level-2 identity-cover function, analogous to @'(-*)'@+--+-- >>> (-*:) (IdentityT [1]) :: IdentityT2 [] Maybe Int+-- IdentityT2 {runIdentityT2 = [Just 1]}+--+-- >>> (-*:) (IdentityT (ExceptT (Identity (Right 1)))) :: IdentityT2 (Except ()) (Writer String) Int+-- IdentityT2 {runIdentityT2 = ExceptT (Identity (Right (WriterT (Identity (1,"")))))}+--+(-*:) :: (Monad m1, Monad m2) => IdentityT m1 a -> IdentityT2 m1 m2 a+(-*:) = IdentityT2 . (-*) . runIdentityT+-- | The level-2 identity-cover function, analogous to @'(.*)'@+--+-- >>> (*-:) (IdentityT (Just 1)) :: IdentityT2 [] Maybe Int+-- IdentityT2 {runIdentityT2 = [Just 1]}+--+-- >>> (*-:) (IdentityT (WriterT (Identity (1,"")))) :: IdentityT2 (Except ()) (Writer String) Int+-- IdentityT2 {runIdentityT2 = ExceptT (Identity (Right (WriterT (Identity (1,"")))))}+--+(*-:) :: (Monad m1, Monad m2) => IdentityT m2 a -> IdentityT2 m1 m2 a+(*-:) = IdentityT2 . (.*) . runIdentityT  ---------------------------------------------------------------------- -- Level-3@@ -119,32 +187,31 @@ newtype IdentityT3 f1 f2 f3 a = IdentityT3 { runIdentityT3 :: f1 (f2 (f3 a)) }     deriving (Functor, Eq, Ord, Read, Show, Foldable, Traversable) -instance (Commutative f1, Commutative f2, Commutative f3) => Commutative (IdentityT3 f1 f2 f3) where-    commute = (IdentityT3|$>) . float3 . runIdentityT3- instance (Applicative m1, Applicative m2, Applicative m3) => Applicative (IdentityT3 m1 m2 m3) where-    pure x = IdentityT3 $ (***:) x-    (<*>) = lift3IdentityT3 (|*>>>)-instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => Monad (IdentityT3 m1 m2 m3) where-    return = IdentityT3 . (***:)+    pure x = IdentityT3 $ (.***) x+    (<*>) = lift2IdentityT3 (|*>>>)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => Monad (IdentityT3 m1 m2 m3) where+    return = IdentityT3 . (.***)     m >>= f = IdentityT3 $ runIdentityT3 m >>>== (f >-> runIdentityT3)  instance (Alternative m1, Alternative m2, Alternative m3) => Alternative (IdentityT3 m1 m2 m3) where     empty = IdentityT3 empty-    (<|>) = lift3IdentityT3 (<|>)-instance (MonadPlus m1, Alternative m2, Monad m2, Commutative m2, Alternative m3, Monad m3, Commutative m3) => MonadPlus (IdentityT3 m1 m2 m3) where+    (<|>) = lift2IdentityT3 (<|>)+instance (MonadPlus m1, Alternative m2, Monad m2, Traversable m2, Alternative m3, Monad m3, Traversable m3) => MonadPlus (IdentityT3 m1 m2 m3) where     mzero = IdentityT3 mzero-    mplus = lift3IdentityT3 mplus+    mplus = lift2IdentityT3 mplus -instance MonadTrans3 IdentityT3 where-    liftT3 = IdentityT3-instance (MonadIO m1, Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3) => MonadIO (IdentityT3 m1 m2 m3) where-    liftIO = liftT3 . (-**) . liftIO+instance (MonadIO m1, Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3) => MonadIO (IdentityT3 m1 m2 m3) where+    liftIO = IdentityT3 . (-**) . liftIO -lift3IdentityT3 ::-    (m1 (m2 (m3 a)) -> n1 (n2 (n3 b)) -> p1 (p2 (p3 c))) -> IdentityT3 m1 m2 m3 a -> IdentityT3 n1 n2 n3 b -> IdentityT3 p1 p2 p3 c-lift3IdentityT3 f a b = IdentityT3 (f (runIdentityT3 a) (runIdentityT3 b))+transrollI3 :: (Monad m1, Monad (t2 m1), MonadTrans_ m2 t2, MonadTrans_ m3 t3) => IdentityT3 m1 m2 m3 a -> IdentityT (t3 (t2 m1)) a+transrollI3 = IdentityT . transroll3 . runIdentityT3+untransrollI3 :: (Monad m1, Monad (t2 m1), MonadTrans_ m2 t2, MonadTrans_ m3 t3) => IdentityT (t3 (t2 m1)) a -> IdentityT3 m1 m2 m3 a+untransrollI3 = IdentityT3 . untransroll3 . runIdentityT +lift2IdentityT3 :: (m1 (m2 (m3 a)) -> n1 (n2 (n3 b)) -> p1 (p2 (p3 c))) -> IdentityT3 m1 m2 m3 a -> IdentityT3 n1 n2 n3 b -> IdentityT3 p1 p2 p3 c+lift2IdentityT3 f a b = IdentityT3 (f (runIdentityT3 a) (runIdentityT3 b))+ mapIdentityT3 :: (m1 (m2 (m3 a)) -> n1 (n2 (n3 b))) -> IdentityT3 m1 m2 m3 a -> IdentityT3 n1 n2 n3 b mapIdentityT3 f = IdentityT3 . f . runIdentityT3 @@ -154,17 +221,25 @@ liftCatch3 :: Catch3 e m1 m2 m3 a -> Catch e (IdentityT3 m1 m2 m3) a liftCatch3 catch m h = IdentityT3 $ (runIdentityT3 m) `catch` (h >-> runIdentityT3) -instance MonadTrans3Down IdentityT3 where-    type Trans3Down IdentityT3 = IdentityT2+infixl 3  ***:+(***:) :: (Monad m1, Monad m2, Monad m3) => Identity a -> IdentityT3 m1 m2 m3 a+(***:) = IdentityT3 . (.***) . runIdentity -instance MonadTransFold3 IdentityT3 where-    transfold3 (IdentityT3 x) = IdentityT $ trans2 x-    untransfold3 (IdentityT x) = IdentityT3 $ untrans2 x+infixl 3  --*:, -*-:, *--:+(--*:) :: (Monad m1, Monad m2, Monad m3) => IdentityT2 m1 m2 a -> IdentityT3 m1 m2 m3 a+(--*:) = IdentityT3 . (--*) . runIdentityT2+(-*-:) :: (Monad m1, Monad m2, Monad m3) => IdentityT2 m1 m3 a -> IdentityT3 m1 m2 m3 a+(-*-:) = IdentityT3 . (-*) . runIdentityT2+(*--:) :: (Monad m1, Monad m2, Monad m3) => IdentityT2 m2 m3 a -> IdentityT3 m1 m2 m3 a+(*--:) = IdentityT3 . (.*) . runIdentityT2 -instance MonadTransCover3 IdentityT3 where-    (|--*|) = IdentityT3 . (--*) . runIdentityT2-    (|-*-|) = IdentityT3 . (-*) . runIdentityT2-    (|*--|) = IdentityT3 . (*:) . runIdentityT2+infixl 3  -**:, *-*:, **-:+(-**:) :: (Monad m1, Monad m2, Monad m3) => IdentityT m1 a -> IdentityT3 m1 m2 m3 a+(-**:) = (--*:) . (-*:)+(*-*:) :: (Monad m1, Monad m2, Monad m3) => IdentityT m2 a -> IdentityT3 m1 m2 m3 a+(*-*:) = (--*:) . (*-:)+(**-:) :: (Monad m1, Monad m2, Monad m3) => IdentityT m3 a -> IdentityT3 m1 m2 m3 a+(**-:) = (-*-:) . (*-:)  ---------------------------------------------------------------------- -- Level-4@@ -172,32 +247,31 @@ newtype IdentityT4 f1 f2 f3 f4 a = IdentityT4 { runIdentityT4 :: f1 (f2 (f3 (f4 a))) }     deriving (Functor, Eq, Ord, Read, Show, Foldable, Traversable) -instance (Commutative f1, Commutative f2, Commutative f3, Commutative f4) => Commutative (IdentityT4 f1 f2 f3 f4) where-    commute = (IdentityT4|$>) . float4 . runIdentityT4- instance (Applicative m1, Applicative m2, Applicative m3, Applicative m4) => Applicative (IdentityT4 m1 m2 m3 m4) where-    pure x = IdentityT4 $ (****:) x-    (<*>) = lift4IdentityT4 (|*>>>>)-instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => Monad (IdentityT4 m1 m2 m3 m4) where-    return = IdentityT4 . (****:)+    pure x = IdentityT4 $ (.****) x+    (<*>) = lift2IdentityT4 (|*>>>>)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => Monad (IdentityT4 m1 m2 m3 m4) where+    return = IdentityT4 . (.****)     m >>= f = IdentityT4 $ runIdentityT4 m >>>>== (f >-> runIdentityT4)  instance (Alternative m1, Alternative m2, Alternative m3, Alternative m4) => Alternative (IdentityT4 m1 m2 m3 m4) where     empty = IdentityT4 empty-    (<|>) = lift4IdentityT4 (<|>)-instance (MonadPlus m1, Alternative m2, Monad m2, Commutative m2, Alternative m3, Monad m3, Commutative m3, Alternative m4, Monad m4, Commutative m4) => MonadPlus (IdentityT4 m1 m2 m3 m4) where+    (<|>) = lift2IdentityT4 (<|>)+instance (MonadPlus m1, Alternative m2, Monad m2, Traversable m2, Alternative m3, Monad m3, Traversable m3, Alternative m4, Monad m4, Traversable m4) => MonadPlus (IdentityT4 m1 m2 m3 m4) where     mzero = IdentityT4 mzero-    mplus = lift4IdentityT4 mplus+    mplus = lift2IdentityT4 mplus -instance MonadTrans4 IdentityT4 where-    liftT4 = IdentityT4-instance (MonadIO m1, Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4) => MonadIO (IdentityT4 m1 m2 m3 m4) where-    liftIO = liftT4 . (-***) . liftIO+instance (MonadIO m1, Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4) => MonadIO (IdentityT4 m1 m2 m3 m4) where+    liftIO = IdentityT4 . (-***) . liftIO -lift4IdentityT4 ::-    (m1 (m2 (m3 (m4 a))) -> n1 (n2 (n3 (n4 b))) -> p1 (p2 (p3 (p4 c)))) -> IdentityT4 m1 m2 m3 m4 a -> IdentityT4 n1 n2 n3 n4 b -> IdentityT4 p1 p2 p3 p4 c-lift4IdentityT4 f a b = IdentityT4 (f (runIdentityT4 a) (runIdentityT4 b))+transrollI4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4) => IdentityT4 m1 m2 m3 m4 a -> IdentityT (t4 (t3 (t2 m1))) a+transrollI4 = IdentityT . transroll4 . runIdentityT4+untransrollI4 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4) => IdentityT (t4 (t3 (t2 m1))) a -> IdentityT4 m1 m2 m3 m4 a+untransrollI4 = IdentityT4 . untransroll4 . runIdentityT +lift2IdentityT4 :: (m1 (m2 (m3 (m4 a))) -> n1 (n2 (n3 (n4 b))) -> p1 (p2 (p3 (p4 c)))) -> IdentityT4 m1 m2 m3 m4 a -> IdentityT4 n1 n2 n3 n4 b -> IdentityT4 p1 p2 p3 p4 c+lift2IdentityT4 f a b = IdentityT4 (f (runIdentityT4 a) (runIdentityT4 b))+ mapIdentityT4 :: (m1 (m2 (m3 (m4 a))) -> n1 (n2 (n3 (n4 b)))) -> IdentityT4 m1 m2 m3 m4 a -> IdentityT4 n1 n2 n3 n4 b mapIdentityT4 f = IdentityT4 . f . runIdentityT4 @@ -207,51 +281,77 @@ liftCatch4 :: Catch4 e m1 m2 m3 m4 a -> Catch e (IdentityT4 m1 m2 m3 m4) a liftCatch4 catch m h = IdentityT4 $ (runIdentityT4 m) `catch` (h >-> runIdentityT4) -instance MonadTrans4Down IdentityT4 where-    type Trans4Down IdentityT4 = IdentityT3+infixl 3  ****:+(****:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => Identity a -> IdentityT4 m1 m2 m3 m4 a+(****:) = IdentityT4 . (.****) . runIdentity -instance MonadTransFold4 IdentityT4 where-    transfold4 (IdentityT4 x) = IdentityT $ trans3 x-    untransfold4 (IdentityT x) = IdentityT4 $ untrans3 x+infixl 3  ---*:, --*-:, -*--:, *---:+(---*:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT3 m1 m2 m3 a -> IdentityT4 m1 m2 m3 m4 a+(---*:) = IdentityT4 . (---*) . runIdentityT3+(--*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT3 m1 m2 m4 a -> IdentityT4 m1 m2 m3 m4 a+(--*-:) = IdentityT4 . (--*) . runIdentityT3+(-*--:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT3 m1 m3 m4 a -> IdentityT4 m1 m2 m3 m4 a+(-*--:) = IdentityT4 . (-*) . runIdentityT3+(*---:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT3 m2 m3 m4 a -> IdentityT4 m1 m2 m3 m4 a+(*---:) = IdentityT4 . (.*) . runIdentityT3 -instance MonadTransCover4 IdentityT4 where-    (|---*|) = IdentityT4 . (---*) . runIdentityT3-    (|--*-|) = IdentityT4 . (--*) . runIdentityT3-    (|-*--|) = IdentityT4 . (-*) . runIdentityT3-    (|*---|) = IdentityT4 . (*:) . runIdentityT3+infixl 3  --**:, -*-*:, -**-:, *-*-:, **--:, *--*:+(--**:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m1 m2 a -> IdentityT4 m1 m2 m3 m4 a+(--**:) = (---*:) . (--*:)+(-*-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m1 m3 a -> IdentityT4 m1 m2 m3 m4 a+(-*-*:) = (---*:) . (-*-:)+(-**-:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m1 m4 a -> IdentityT4 m1 m2 m3 m4 a+(-**-:) = (--*-:) . (-*-:)+(*-*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m2 m4 a -> IdentityT4 m1 m2 m3 m4 a+(*-*-:) = (--*-:) . (*--:)+(**--:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m3 m4 a -> IdentityT4 m1 m2 m3 m4 a+(**--:) = (-*--:) . (*--:)+(*--*:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT2 m2 m3 a -> IdentityT4 m1 m2 m3 m4 a+(*--*:) = (---*:) . (*--:) +infixl 3  -***:, *-**:, **-*:, ***-: +(-***:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT m1 a -> IdentityT4 m1 m2 m3 m4 a+(-***:) = (---*:) . (-**:)+(*-**:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT m2 a -> IdentityT4 m1 m2 m3 m4 a+(*-**:) = (---*:) . (*-*:)+(**-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT m3 a -> IdentityT4 m1 m2 m3 m4 a+(**-*:) = (---*:) . (**-:)+(***-:) :: (Monad m1, Monad m2, Monad m3, Monad m4) => IdentityT m4 a -> IdentityT4 m1 m2 m3 m4 a+(***-:) = (--*-:) . (**-:)+ ---------------------------------------------------------------------- -- Level-5  newtype IdentityT5 f1 f2 f3 f4 f5 a = IdentityT5 { runIdentityT5 :: f1 (f2 (f3 (f4 (f5 a)))) }     deriving (Functor, Eq, Ord, Read, Show, Foldable, Traversable) -instance (Commutative f1, Commutative f2, Commutative f3, Commutative f4, Commutative f5) => Commutative (IdentityT5 f1 f2 f3 f4 f5) where-    commute = (IdentityT5|$>) . float5 . runIdentityT5- instance (Applicative m1, Applicative m2, Applicative m3, Applicative m4, Applicative m5) => Applicative (IdentityT5 m1 m2 m3 m4 m5) where-    pure x = IdentityT5 $ (*****:) x-    (<*>) = lift5IdentityT5 (|*>>>>>)-instance (Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => Monad (IdentityT5 m1 m2 m3 m4 m5) where-    return = IdentityT5 . (*****:)+    pure x = IdentityT5 $ (.*****) x+    (<*>) = lift2IdentityT5 (|*>>>>>)+instance (Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => Monad (IdentityT5 m1 m2 m3 m4 m5) where+    return = IdentityT5 . (.*****)     m >>= f = IdentityT5 $ runIdentityT5 m >>>>>== (f >-> runIdentityT5)  instance (Alternative m1, Alternative m2, Alternative m3, Alternative m4, Alternative m5) => Alternative (IdentityT5 m1 m2 m3 m4 m5) where     empty = IdentityT5 empty-    (<|>) = lift5IdentityT5 (<|>)-instance (MonadPlus m1, Alternative m2, Monad m2, Commutative m2, Alternative m3, Monad m3, Commutative m3, Alternative m4, Monad m4, Commutative m4, Alternative m5, Monad m5, Commutative m5) => MonadPlus (IdentityT5 m1 m2 m3 m4 m5) where+    (<|>) = lift2IdentityT5 (<|>)+instance (MonadPlus m1, Alternative m2, Monad m2, Traversable m2, Alternative m3, Monad m3, Traversable m3, Alternative m4, Monad m4, Traversable m4, Alternative m5, Monad m5, Traversable m5) => MonadPlus (IdentityT5 m1 m2 m3 m4 m5) where     mzero = IdentityT5 mzero-    mplus = lift5IdentityT5 mplus+    mplus = lift2IdentityT5 mplus -instance MonadTrans5 IdentityT5 where-    liftT5 = IdentityT5-instance (MonadIO m1, Monad m1, Monad m2, Commutative m2, Monad m3, Commutative m3, Monad m4, Commutative m4, Monad m5, Commutative m5) => MonadIO (IdentityT5 m1 m2 m3 m4 m5) where-    liftIO = liftT5 . (-****) . liftIO+instance (MonadIO m1, Monad m1, Monad m2, Traversable m2, Monad m3, Traversable m3, Monad m4, Traversable m4, Monad m5, Traversable m5) => MonadIO (IdentityT5 m1 m2 m3 m4 m5) where+    liftIO = IdentityT5 . (-****) . liftIO -lift5IdentityT5 ::-    (m1 (m2 (m3 (m4 (m5 a)))) -> n1 (n2 (n3 (n4 (n5 b)))) -> p1 (p2 (p3 (p4 (p5 c))))) -> IdentityT5 m1 m2 m3 m4 m5 a -> IdentityT5 n1 n2 n3 n4 n5 b -> IdentityT5 p1 p2 p3 p4 p5 c-lift5IdentityT5 f a b = IdentityT5 (f (runIdentityT5 a) (runIdentityT5 b))+transrollI5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4, MonadTrans_ m5 t5) => +                IdentityT5 m1 m2 m3 m4 m5 a -> IdentityT (t5 (t4 (t3 (t2 m1)))) a+transrollI5 = IdentityT . transroll5 . runIdentityT5+untransrollI5 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)), Monad (t4 (t3 (t2 m1))), MonadTrans_ m2 t2, MonadTrans_ m3 t3, MonadTrans_ m4 t4, MonadTrans_ m5 t5) => +                  IdentityT (t5 (t4 (t3 (t2 m1)))) a -> IdentityT5 m1 m2 m3 m4 m5 a+untransrollI5 = IdentityT5 . untransroll5 . runIdentityT +lift2IdentityT5 :: (m1 (m2 (m3 (m4 (m5 a)))) -> n1 (n2 (n3 (n4 (n5 b)))) -> p1 (p2 (p3 (p4 (p5 c))))) -> IdentityT5 m1 m2 m3 m4 m5 a -> IdentityT5 n1 n2 n3 n4 n5 b -> IdentityT5 p1 p2 p3 p4 p5 c+lift2IdentityT5 f a b = IdentityT5 (f (runIdentityT5 a) (runIdentityT5 b))+ mapIdentityT5 :: (m1 (m2 (m3 (m4 (m5 a)))) -> n1 (n2 (n3 (n4 (n5 b))))) -> IdentityT5 m1 m2 m3 m4 m5 a -> IdentityT5 n1 n2 n3 n4 n5 b mapIdentityT5 f = IdentityT5 . f . runIdentityT5 @@ -261,17 +361,114 @@ liftCatch5 :: Catch5 e m1 m2 m3 m4 m5 a -> Catch e (IdentityT5 m1 m2 m3 m4 m5) a liftCatch5 catch m h = IdentityT5 $ (runIdentityT5 m) `catch` (h >-> runIdentityT5) -instance MonadTrans5Down IdentityT5 where-    type Trans5Down IdentityT5 = IdentityT4+infixl 3  *****:+(*****:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => Identity a -> IdentityT5 m1 m2 m3 m4 m5 a+(*****:) = IdentityT5 . (.*****) . runIdentity -instance MonadTransFold5 IdentityT5 where-    transfold5 (IdentityT5 x) = IdentityT $ trans4 x-    untransfold5 (IdentityT x) = IdentityT5 $ untrans4 x+infixl 3  ----*:, ---*-:, --*--:, -*---:, *----:+(----*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT4 m1 m2 m3 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(----*:) = IdentityT5 . (----*) . runIdentityT4+(---*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT4 m1 m2 m3 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(---*-:) = IdentityT5 . (---*) . runIdentityT4+(--*--:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT4 m1 m2 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(--*--:) = IdentityT5 . (--*) . runIdentityT4+(-*---:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT4 m1 m3 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-*---:) = IdentityT5 . (-*) . runIdentityT4+(*----:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT4 m2 m3 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*----:) = IdentityT5 . (.*) . runIdentityT4 -instance MonadTransCover5 IdentityT5 where-    (|----*|) = IdentityT5 . (----*) . runIdentityT4-    (|---*-|) = IdentityT5 . (---*) . runIdentityT4-    (|--*--|) = IdentityT5 . (--*) . runIdentityT4-    (|-*---|) = IdentityT5 . (-*) . runIdentityT4-    (|*----|) = IdentityT5 . (*:) . runIdentityT4+infixl 3  ---**:, --*-*:, -*--*:, *---*:, *--*-:, -*-*-:, --**-:, -**--:, *-*--:, **---:+(---**:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m2 m3 a -> IdentityT5 m1 m2 m3 m4 m5 a+(---**:) = (----*:) . (---*:)+(--*-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m2 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(--*-*:) = (----*:) . (--*-:)+(-*--*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m3 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-*--*:) = (----*:) . (-*--:)+(*---*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m2 m3 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*---*:) = (----*:) . (*---:)+(*--*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m2 m3 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*--*-:) = (---*-:) . (*---:)+(-*-*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m3 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-*-*-:) = (---*-:) . (-*--:)+(--**-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m2 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(--**-:) = (---*-:) . (--*-:)+(-**--:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m1 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-**--:) = (--*--:) . (-*--:)+(*-*--:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m2 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*-*--:) = (*----:) . (-*--:)+(**---:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT3 m3 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(**---:) = (-*---:) . (*---:)+infixl 3  --***:, -*-**:, *--**:, *-*-*:, -**-*:, **--*:, **-*-:, *-**-:, -***-:, ***--:+(--***:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m1 m2 a -> IdentityT5 m1 m2 m3 m4 m5 a+(--***:) = (----*:) . (--**:)+(-*-**:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m1 m3 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-*-**:) = (----*:) . (-*-*:)+(*--**:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m2 m3 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*--**:) = (----*:) . (*--*:)+(*-*-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m2 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*-*-*:) = (----*:) . (*-*-:)+(-**-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m1 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-**-*:) = (----*:) . (-**-:)+(**--*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m3 m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(**--*:) = (----*:) . (**--:)+(**-*-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m3 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(**-*-:) = (---*-:) . (**--:)+(*-**-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m2 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*-**-:) = (*----:) . (-**-:)+(-***-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m1 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-***-:) = (---*-:) . (-**-:)+(***--:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT2 m4 m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(***--:) = (--*--:) . (**--:)+infixl 3  -****:, *-***:, **-**:, ***-*:, ****-:+(-****:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT m1 a -> IdentityT5 m1 m2 m3 m4 m5 a+(-****:) = (----*:) . (-***:)+(*-***:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT m2 a -> IdentityT5 m1 m2 m3 m4 m5 a+(*-***:) = (----*:) . (*-**:)+(**-**:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT m3 a -> IdentityT5 m1 m2 m3 m4 m5 a+(**-**:) = (----*:) . (**-*:)+(***-*:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT m4 a -> IdentityT5 m1 m2 m3 m4 m5 a+(***-*:) = (----*:) . (***-:)+(****-:) :: (Monad m1, Monad m2, Monad m3, Monad m4, Monad m5) => IdentityT m5 a -> IdentityT5 m1 m2 m3 m4 m5 a+(****-:) = (---*-:) . (***-:) +{- $Example_Level2+Here is an example showing how to use identity-cover functions++>import DeepControl.Applicative ((|$>))+>import DeepControl.Monad (Monad)+>import DeepControl.Monad.Morph (generalize, (|*|), (|>|))+>import DeepControl.Monad.Trans.Identity (IdentityT(..), IdentityT2(..), (-*:), (*-:))+>import Control.Monad.Writer+>import Control.Monad.State+>+>tick :: State Int ()+>tick = modify (+1)+>+>tock                         ::                   StateT Int IO ()+>tock = do+>    generalize |>| tick      :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous to (|$>)+>    (|*|) $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- (|*|) is the level-1 trans-lift function, alias to 'lift'+>+>-- λ> runStateT tock 0+>-- Tock!+>-- ((),1)+>+>save :: StateT Int (Writer [Int]) ()+>save = do+>    n <- get+>    (|*|) $ tell [n]+>+>program ::                             StateT Int (IdentityT2 IO (Writer [Int])) () -- StateT-IdentityT2-IO-Writer monad, a level-2 monad-transform+>program = replicateM_ 4 $ do+>    ((-*:) . IdentityT) |>| tock                                                    -- (-*:) is a level-2 identity-cover function, analogous to (-*)+>        :: (Monad m, Traversable m) => StateT Int (IdentityT2 IO m             ) ()+>    ((*-:) . IdentityT) |>| save                                                    -- (*-:) is a level-2 identity-cover function, analogous to (.*)+>        :: (Monad m               ) => StateT Int (IdentityT2 m  (Writer [Int])) ()+>+>-- λ> execWriter |$> runIdentityT2 (runStateT program 0)+>-- Tock!+>-- Tock!+>-- Tock!+>-- Tock!+>-- [1,2,3,4]+-}

@@ -1,6 +1,6 @@ {-| Module      : DeepControl.Monad.Trans.Writer-Description : Extension for mtl's Contrl.Monad.Writer.+Description : Deepened the usual Control.Monad.Writer module. Copyright   : (c) Andy Gill 2001,               (c) Oregon Graduate Institute of Science and Technology, 2001,               (c) 2015 KONISHI Yohsuke,

@@ -0,0 +1,135 @@+{-|+Module      : DeepControl.Traversable+Description : Deepened the usual Data.Traversable module.+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+Portability : ---++This module is deepened of @'Data.Traversable'@.+-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}+module DeepControl.Traversable (+    -- * Utility functions+    -- ** Level-1+    sink, sinkmap,+    -- ** Level-2+    sink2, float2,+    -- ** Level-3+    sink3, float3,+    -- ** Level-4+    sink4, float4,+    -- ** Level-5+    sink5, float5,++    ) where++import DeepControl.Applicative++------------------------------------------------------------------------------+-- Level-1++-- | Alias to @'Data.Traversable.sequenceA'@.+-- +-- >>> sink $ Just [1]+-- [Just 1]+--+-- >>> sink $ Right (Just 1)+-- Just (Right 1)+--+-- >>> sink [[1,2],[3,4]]+-- [[1,3],[1,4],[2,3],[2,4]]+-- >>> sink . sink $ [[1,2],[3,4]]+-- [[1,1,2,2],[1,1,2,4],[1,1,3,2],[1,1,3,4],[1,4,2,2],[1,4,2,4],[1,4,3,2],[1,4,3,4],[3,1,2,2],[3,1,2,4],[3,1,3,2],[3,1,3,4],[3,4,2,2],[3,4,2,4],[3,4,3,2],[3,4,3,4]]+--+sink :: (Traversable t, Applicative f) => t (f a) -> f (t a)+sink = sequenceA++{-+instance Traversable ((->) r) where+    -- TODO: If GHC could parse this expression, maybe I could write up DeepControl.Monad.+    sequence ((r->) mv) = (r->) |$> mv+-}++-- | Alias to @'Data.Traversable.traversable'@.+sinkmap :: (Applicative f, Traversable c) => (a -> f b) -> c a -> f (c b)+sinkmap f = sink . (f |$>)++------------------------------------------------------------------------------+-- Level-2++-- | Definition: @ sink2 = (sink|$>) . sink @+--+-- >>> sink2 $ Just [[1]]+-- [[Just 1]]+--+-- >>> sink2 $ Right (Just [1])+-- Just [Right 1]+--+sink2 :: (Traversable m1, Applicative m2, Applicative m3) =>+         m1 (m2 (m3 a)) -> m2 (m3 (m1 a))+sink2 = (sink|$>) . sink++-- | Definition: @ float2 = sink . (sink|$>) @+--+-- >>> float2 $ [[Just 1]]+-- Just [[1]]+--+-- >>> float2 $ Just [Right 1]+-- Right (Just [1])+--+float2 :: (Applicative m1, Traversable m2, Traversable m3) =>+          m2 (m3 (m1 a)) -> m1 (m2 (m3 a))+float2 = sink . (sink|$>)++------------------------------------------------------------------------------+-- Level-3++-- | Definition: @ sink3 = (sink2|$>) . sink @+--+-- >>> sink3 $ Just [[[1]]]+-- [[[Just 1]]]+--+-- >>> sink3 $ Right [Just [1]]+-- [Just [Right 1]]+--+sink3 :: (Traversable m1, Applicative m2, Applicative m3, Applicative m4) =>+         m1 (m2 (m3 (m4 a))) -> m2 (m3 (m4 (m1 a)))+sink3 = (sink2|$>) . sink++-- | Definition: @ float3 = sink . (float2|$>) @+--+-- >>> float3 $ [[[Just 1]]]+-- Just [[[1]]]+--+-- >>> float3 $ [Just [Right 1]]+-- Right [Just [1]]+--+float3 :: (Applicative m1, Traversable m2, Traversable m3, Traversable m4) =>+          m2 (m3 (m4 (m1 a))) -> m1 (m2 (m3 (m4 a)))+float3 = sink . (float2|$>)++------------------------------------------------------------------------------+-- Level-4++sink4 :: (Traversable m1, Applicative m2, Applicative m3, Applicative m4, Applicative m5) =>+         m1 (m2 (m3 (m4 (m5 a)))) -> m2 (m3 (m4 (m5 (m1 a))))+sink4 = (sink3|$>) . sink++float4 :: (Applicative m1, Traversable m2, Traversable m3, Traversable m4, Traversable m5) =>+          m2 (m3 (m4 (m5 (m1 a)))) -> m1 (m2 (m3 (m4 (m5 a))))+float4 = sink . (float3|$>)++------------------------------------------------------------------------------+-- Level-5++sink5 :: (Traversable m1, Applicative m2, Applicative m3, Applicative m4, Applicative m5, Applicative m6) =>+         m1 (m2 (m3 (m4 (m5 (m6 a))))) -> m2 (m3 (m4 (m5 (m6 (m1 a)))))+sink5 = (sink4|$>) . sink++float5 :: (Applicative m1, Traversable m2, Traversable m3, Traversable m4, Traversable m5, Traversable m6) =>+          m2 (m3 (m4 (m5 (m6 (m1 a))))) -> m1 (m2 (m3 (m4 (m5 (m6 a)))))+float5 = sink . (float4|$>)

@@ -4,7 +4,7 @@  ## Examples -### [Applicative](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Applicative.html)+### [Applicative](https://hackage.haskell.org/package/deepcontrol-0.5.1.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.@@ -49,9 +49,9 @@     > [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]+    > 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]+    > foldr (\x acc -> x <$|(:)|*> acc) ((.*) []) [Just 1, Nothing, Just 3]     Nothing      > filter (even <$|(&&)|*> (10 >)) [1..100]@@ -61,14 +61,14 @@  cover notation: -    > :t (*:)-    (*:) :: Applicative f => a -> f a+    > :t (.*)+    (.*) :: Applicative f => a -> f a -    > (*:) 1 :: Maybe Int+    > (.*) 1 :: Maybe Int     Just 1-    > (*:) 1 :: [Int]+    > (.*) 1 :: [Int]     [1]-    > (*:) 1 :: Either () Int+    > (.*) 1 :: Either () Int     Right 1  cover-braket notation:@@ -119,25 +119,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 ()  cover notation: -    > :t (**:)-    (**:) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a)+    > :t (.**)+    (.**) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a)     > :t (-*)     (-*) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 a) -    > (**:) 1 :: Maybe [Int]+    > (.**) 1 :: Maybe [Int]     Just [1]     > (-*) (Just 1) :: Maybe [Int]     Just [1]-    > (*:) [1] :: Maybe [Int]+    > (.*) [1] :: Maybe [Int]     Just [1]  cover-braket notation:@@ -182,28 +182,28 @@  Work well likewise. -### [Commutative](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Commutative.html)+### [Traversable](https://hackage.haskell.org/package/deepcontrol-0.5.1.0/docs/DeepControl-Traversable.html) -    Prelude> :m DeepControl.Commutative+    Prelude> :m DeepControl.Traversable -[], Maybe, Either, Except and Writer monads are all commutative each other.+List, Maybe, Either, Except and Writer monads are all sinkable infinitely. -    > :t commute-    commute :: (Applicative f, Commutative c) => c (f a) -> f (c a)+    > :t sink+    sink :: (Applicative f, Traversable c) => c (f a) -> f (c a) -    > commute $ Just [1]+    > sink $ Just [1]     [Just 1]-    > commute $ [Just 1]-    Just [1]+    > sink2 $ Just (Right [1])+    Right [Just 1] -    > commute $ Right (Just 1)-    Just (Right 1)-    > commute $ Just (Right 1)-    Right (Just 1)+    > sink $ Right [Just 1]+    [Right (Just 1)]+    > sink2 $ Right [Just 1]+    [Just (Right 1)] -So these monads can be deepened freely.+So these monads can be deepened. -### [Monad](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Monad.html)+### [Monad](https://hackage.haskell.org/package/deepcontrol-0.5.1.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.@@ -215,7 +215,7 @@  plus :: Int -> Int -> Int plus x y = -    x >- \a ->   -- (>-) is the level-0 bind function, analogous for (>>=)+    x >- \a ->   -- (>-) is the level-0 bind function, analogous to (>>=)     y >- \b ->     a + b @@ -226,50 +226,52 @@ #### Level-2  ```haskell-import DeepControl.Applicative ((**:))+import DeepControl.Applicative ((.**)) import DeepControl.Monad ((>>==))  listlist :: [[String]]             -- List-List monad-listlist = [["a","b"]] >>== \x ->  -- (>>==) is the level-2 bind function, analogous for (>>=)+listlist = [["a","b"]] >>== \x ->  -- (>>==) is the level-2 bind function, analogous to (>>=)            [[0],[1,2]] >>== \y ->-           (**:) $ x ++ show y+           (.**) $ x ++ show y  -- > listlist -- [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]] ```  ```haskell-import DeepControl.Applicative ((|$>), (-*), (*:), (**:))+import DeepControl.Applicative ((|$>), (.*), (.**)) import DeepControl.Monad ((>>), (>>==), (->~)) import Control.Monad.Writer  factorial :: Int ->              Maybe (Writer [Int] Int)               -- Maybe-Writer monad-factorial n | n < 0  = (-*) Nothing-            | n == 0 = (*:) $ tell [0] >> (*:) 1+factorial n | n < 0  = Nothing+            | n == 0 = (.*) $ tell [0] >> (.*) 1             | n > 0  = factorial (n-1) >>== \v ->   -                       tell [v] ->~                 -- (->~) is a level-2 cover-sequence function, analogous for (>>)-                       (**:) (n * v)+                       tell [v] ->~                 -- (->~) is a level-2 cover-sequence function, analogous to (>>)+                       (.**) (n * v)  -- > runWriter |$> factorial 5 -- Just (120,[0,1,1,2,6,24])+-- > factorial (-1)+-- Nothing ```  #### Level-3  ```haskell-import DeepControl.Applicative ((|$>>), (*-*), (*:), (**:), (***:))+import DeepControl.Applicative ((|$>>), (.*), (.**), (.***)) import DeepControl.Monad ((>>), (>>>==), (>--~), (-->~)) import Control.Monad.Writer  factorial :: Int ->              IO (Maybe (Writer [Int] Int))            -- IO-Maybe-Writer monad-factorial n | n < 0  = (*-*) Nothing                  -- (*-*) is a level-3 cover function-            | n == 0 = (**:) $ tell [0] >> (*:) 1-            | n > 0  = factorial (n-1) >>>== \v ->    -- (>>>==) is the level-3 bind function, analogous for (>>=)-                       print v >--~                   -- (>--~) is a level-3 cover-sequence function, analogous for (>>)-                       tell [v] -->~                  -- (-->~) is a level-3 cover-sequence function too, analogous for (>>)-                       (***:) (n * v)+factorial n | n < 0  = (.*) Nothing                  +            | n == 0 = (.**) $ tell [0] >> (.*) 1+            | n > 0  = factorial (n-1) >>>== \v ->    -- (>>>==) is the level-3 bind function, analogous to (>>=)+                       print v >--~                   -- (>--~) is a level-3 cover-sequence function, analogous to (>>)+                       tell [v] -->~                  -- (-->~) is a level-3 cover-sequence function too, analogous to (>>)+                       (.***) (n * v)  -- > runWriter |$>> factorial 5 -- 1@@ -278,24 +280,26 @@ -- 6 -- 24 -- Just (120,[0,1,1,2,6,24])+-- > factorial (-1)+-- Nothing ``` #### Level-4 and Level-5  Work well likewise. -### [Monad-Transformer](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Monad-Trans.html)+### [Monad-Transformer](https://hackage.haskell.org/package/deepcontrol-0.5.1.0/docs/DeepControl-Monad-Trans.html)  #### Level-2 -Here is a monad transformer example how to implement Ackermann function, improved to stop within a certain limit of time, with ReaderT-IdentityT2-IO-Maybe monad, a level-2 monad-transformation.+Here is a monad transformer example how to implement Ackermann function improved to stop within a certain limit of time, with ReaderT-IdentityT2-IO-Maybe monad, a level-2 monad-transformation.  ```haskell import DeepControl.Applicative-import DeepControl.Commutative (commute)+import DeepControl.Traversable (sink) import DeepControl.Monad ((>-))-import DeepControl.Monad.Morph ((|>|))-import DeepControl.Monad.Trans (liftTT2, transfold2, untransfold2)-import DeepControl.Monad.Trans.Identity+import DeepControl.Monad.Morph ((|*|), (|>|))+import DeepControl.Monad.Trans (transroll2, untransroll2)+import DeepControl.Monad.Trans.Identity (Identity(..), IdentityT(..), IdentityT2(..)) import Control.Monad.Reader import Control.Monad.Trans.Maybe @@ -304,86 +308,68 @@ type TimeLimit = Int  ackermannTimeLimit :: TimeLimit -> Int -> Int -> -                      IO (Maybe Int)                     -- IO-Maybe monad+                      IO (Maybe Int)                       -- IO-Maybe Monad ackermannTimeLimit timelimit x y = timeout timelimit (ackermannIO x y)   where     ackermannIO :: Int -> Int -> IO Int-    ackermannIO 0 n = (*:) $ n + 1+    ackermannIO 0 n = (.*) $ n + 1     ackermannIO m n | m > 0 && n == 0 = ackermannIO (m-1) 1                     | m > 0 && n > 0  = ackermannIO m (n-1) >>= ackermannIO (m-1)   ackermann :: Int -> Int -> -             ReaderT TimeLimit (IdentityT2 IO Maybe) Int -- ReaderT-IdentityT2-IO-Maybe monad+             ReaderT TimeLimit (IdentityT2 IO Maybe) Int   -- ReaderT-IdentityT2-IO-Maybe monad ackermann x y = do     timelimit <- ask-    liftTT2 $ ackermannTimeLimit timelimit x y           -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function+    (|*|) . IdentityT2 $ ackermannTimeLimit timelimit x y  -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function  calc_ackermann :: TimeLimit -> Int -> Int -> IO (Maybe Int) calc_ackermann timelimit x y = ackermann x y >- \r -> runReaderT r timelimit                                              >- runIdentityT2 --- λ> commute $ calc_ackermann 1000 |$> [0..4] |* 4+-- λ> sink $ calc_ackermann 1000 |$> [0..4] |* 4 -- [Just 5,Just 6,Just 11,Just 125,Nothing]  ackermann' :: Int -> Int -> -              ReaderT TimeLimit (MaybeT IO) Int                -- ReaderT-MaybeT-IO monad-ackermann' x y = (runIdentityT . transfold2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function+              ReaderT TimeLimit (MaybeT IO) Int                 -- ReaderT-MaybeT-IO monad+ackermann' x y = (transroll2 . runIdentityT2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function  ackermann'' :: Int -> Int -> -               ReaderT TimeLimit (IdentityT2 IO Maybe) Int      -- ReaderT-IdentityT2-IO-Maybe monad-ackermann'' x y = (untransfold2 . IdentityT) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function+               ReaderT TimeLimit (IdentityT2 IO Maybe) Int       -- ReaderT-IdentityT2-IO-Maybe monad+ackermann'' x y = (IdentityT2 . untransroll2) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function ```--Here is a monad transformer example showing how to use trans-cover functions.--```haskell-import DeepControl.Applicative ((|$>))-import DeepControl.Commutative (Commutative)-import DeepControl.Monad (Monad)-import DeepControl.Monad.Morph ((|>|))-import DeepControl.Monad.Trans (liftT, (|*|), (|-*|), (|*-|))-import DeepControl.Monad.Trans.Identity-import Control.Monad.Writer-import Control.Monad.State+#### Level-3, Level-4 and Level-5 -tick :: State Int ()-tick = modify (+1)+Work well likewise. -tock                         ::                   StateT Int IO ()-tock = do-    (|*|) tick               :: (Monad      m) => StateT Int m  ()  -- (|*|) is the level-1 trans-cover function, analogous for (*:)-    liftT $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- 'liftT' is the level-1 trans-lift function, alias to 'lift'+transroll and untransroll: --- λ> runStateT tock 0--- Tock!--- ((),1)+    Prelude> :m DeepControl.Monad.Trans +    > :m + Control.Monad.Trans.List Control.Monad.Trans.Maybe+    > :m + DeepControl.Monad.Trans.Identity DeepControl.Monad.Trans.Except DeepControl.Monad.Trans.Writer -save :: StateT Int (Writer [Int]) ()-save = do-    n <- get-    liftT $ tell [n]+    > transroll3 $ ExceptT (Identity (Right [Just 1]))    -- note: type Except e = ExceptT e Identity+    MaybeT (ListT (ExceptT (Identity (Right [Just 1])))) -program ::                             StateT Int (IdentityT2 IO (Writer [Int])) () -- StateT-IdentityT2-IO-Writer monad, a level-2 monad-transform-program = replicateM_ 4 $ do-    ((|-*|).liftT) |>| tock                                                         -- (|-*|) is a level-2 trans-cover function, analogous for (-*)-        :: (Monad m, Commutative m) => StateT Int (IdentityT2 IO m             ) ()-    ((|*-|).liftT) |>| save                                                         -- (|*-|) is a level-2 trans-cover function, analogous for (*:)-        :: (Monad m               ) => StateT Int (IdentityT2 m  (Writer [Int])) ()+    > :t ExceptT (Identity (Right [Just 1]))+    ExceptT (Identity (Right [Just 1]))+      :: Num a => ExceptT e Identity [Maybe a]+    > :t transroll3 $ ExceptT (Identity (Right [Just 1]))+    transroll3 $ ExceptT (Identity (Right [Just 1]))+      :: Num a => MaybeT (ListT (ExceptT e Identity)) a --- λ> execWriter |$> runIdentityT2 (runStateT program 0)--- Tock!--- Tock!--- Tock!--- Tock!--- [1,2,3,4]-```-#### Level-3, Level-4 and Level-5+    > untransroll3 $ MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+    ExceptT (Identity (Right [Just 1])) -Work well likewise.+    > :t MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+    MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+      :: Num a => MaybeT (ListT (ExceptT e Identity)) a+    > :t untransroll3 $ MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+    untransroll3 $ MaybeT (ListT (ExceptT (Identity (Right [Just 1]))))+      :: Num a => ExceptT e Identity [Maybe a] -### [Monad-Morph](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Monad-Morph.html)+### [Monad-Morph](https://hackage.haskell.org/package/deepcontrol-0.5.1.0/docs/DeepControl-Monad-Morph.html) -Here is a monad-morph example, a level-2 monad-morph.+Here is a monad morph example how to use trans-map functions.  ```haskell import DeepControl.Monad.Morph@@ -396,7 +382,7 @@  tock                        ::                   StateT Int IO () tock = do-    generalize |>| tick     :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous for (|$>)+    generalize |>| tick     :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous to (|$>)     lift $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- λ> runStateT tock 0@@ -413,7 +399,7 @@ program = replicateM_ 4 $ do     lift |>| tock         :: (MonadTrans t) => StateT Int (t             IO) ()-    generalize |>>| save                                        -- (|>>|) is the level-2 trans-map function, analogous for (|$>>)+    generalize |>>| save                                        -- (|>>|) is the level-2 trans-map function, analogous to (|$>>)         :: (Monad      m) => StateT Int (WriterT [Int] m ) ()  -- λ> execWriterT (runStateT program 0)@@ -424,8 +410,64 @@ -- [1,2,3,4] ``` +Here is a monad morph example how to use trans-cover and trans-bind functions.++```haskell+import DeepControl.Monad.Morph ((|>=), (|>>=), (|*|), (|-*|))+import DeepControl.Monad.Trans.Except++import Control.Monad.Trans.Maybe+import Control.Exception (IOException, try)++-----------------------------------------------+-- Level-1 ++catchIOError :: IO a -> +                ExceptT IOException IO a   -- ExceptT-IO monad+catchIOError io = ExceptT $ (try io)++viewFile :: IO ()                          -- IO monad+viewFile = do+    str <- readFile "test.txt"+    putStr str++program :: ExceptT IOException IO ()       -- ExceptT-IO monad+program = (|*|) viewFile |>= catchIOError  -- (|*|) is the level-1 trans-cover function, alias to 'lift' and analogous to (.*)+                                           -- (|>=) is the level-1 trans-bind function, analogous to (>>=)++calc_program :: IO (Either IOException ())+calc_program = runExceptT $ program++-- > calc_program+-- Left test.txt: openFile: does not exist (No such file or directory)++-----------------------------------------------+-- Level-2++viewFile2 :: String -> +             MaybeT IO ()                        -- MaybeT-IO monad+viewFile2 filename = do+    guard (filename /= "")+    str <- (|*|) $ readFile "test.txt"+    (|*|) $ putStr str++program2 :: String -> +            (ExceptT IOException (MaybeT IO)) () -- ExceptT-MaybeT-IO monad+program2 filename = +    (|*|) (viewFile2 filename) |>>= \x ->        -- (|>>=) is the level-2 trans-bind function, analogous to (>>=)+    (|-*|) $ catchIOError x                      -- (|-*|) is a level-2 trans-cover function, analogous to (-*)++calc_program2 :: String -> IO (Maybe (Either IOException ())) +calc_program2 filename = runMaybeT . runExceptT $ program2 filename++-- > calc_program "test.txt"+-- Just (Left test.txt: openFile: does not exist (No such file or directory))+-- > calc_program ""+-- Nothing+```+ #### Level-3, Level-4 and Level-5  Work well likewise. -### [Arrow](https://hackage.haskell.org/package/deepcontrol-0.4.3.0/docs/DeepControl-Arrow.html)+### [Arrow](https://hackage.haskell.org/package/deepcontrol-0.5.1.0/docs/DeepControl-Arrow.html)

@@ -1,5 +1,5 @@ name:                deepcontrol-version:             0.4.3.0+version:             0.5.1.0 synopsis:            Provide 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 express, especially for Applicative and Monad. license:             BSD3@@ -23,14 +23,14 @@ library   exposed-modules:     DeepControl.Arrow                      , DeepControl.Applicative-                     , DeepControl.Commutative+                     , DeepControl.Traversable                      , DeepControl.Monad+                     , DeepControl.Monad.Trans.Except+                     , DeepControl.Monad.Trans.Writer                      , DeepControl.Monad.Morph                      , DeepControl.Monad.Signatures                      , DeepControl.Monad.Trans                      , DeepControl.Monad.Trans.Identity-                     , DeepControl.Monad.Trans.Except-                     , DeepControl.Monad.Trans.Writer   -- other-modules:          other-extensions:    MultiParamTypeClasses                      , FlexibleInstances@@ -68,12 +68,12 @@   Build-Depends:        base                       , HUnit >= 1.3.0                       , deepcontrol-Test-Suite unit_Commutative+Test-Suite unit_Traversable   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell2010   HS-Source-Dirs:       test   -- Ghc-Options:          -threaded -Wall-  Main-Is:              unit_Commutative.hs+  Main-Is:              unit_Traversable.hs   Build-Depends:        base                       , HUnit >= 1.3.0                       , deepcontrol@@ -157,5 +157,15 @@   Build-Depends:        base                       , HUnit >= 1.3.0                       , mtl+                      , deepcontrol+Test-Suite unit_MonadMorph-bind+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  HS-Source-Dirs:       test+  -- Ghc-Options:          -threaded -Wall+  Main-Is:              unit_MonadMorph-bind.hs+  Build-Depends:        base+                      , HUnit >= 1.3.0+                      , mtl, transformers                       , deepcontrol 

@@ -1,13 +1,16 @@ module Main where -import Test.DocTest+import           Test.DocTest --import Test.QuickCheck  main :: IO () main = doctest [ "DeepControl/Applicative.hs"-               , "DeepControl/Commutative.hs"+               , "DeepControl/Traversable.hs"                , "DeepControl/Monad.hs"-               , "DeepControl/Monad/Trans.hs"                , "DeepControl/Monad/Morph.hs"+               , "DeepControl/Monad/Trans.hs"+               , "DeepControl/Monad/Trans/Except.hs"+               , "DeepControl/Monad/Trans/Writer.hs"+               , "DeepControl/Monad/Trans/Identity.hs"                , "DeepControl/Arrow.hs"                ]

@@ -98,11 +98,11 @@          ]     , TestList $ ("<$|, |*> and higher-order-function" ~:) |$> [ -          foldr (\n acc -> n <$|(+)|*> acc) ((*:) 0) [Just 1, Just 2,  Just 3] ~?= Just 6-        , foldr (\n acc -> n <$|(+)|*> acc) ((*:) 0) [Just 1, Nothing, Just 3] ~?= Nothing+          foldr (\n acc -> n <$|(+)|*> acc) ((.*) 0) [Just 1, Just 2,  Just 3] ~?= Just 6+        , foldr (\n acc -> n <$|(+)|*> acc) ((.*) 0) [Just 1, Nothing, Just 3] ~?= Nothing -        , 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+        , 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 ((10 >) <$|(&&)|*> even)                  [1..100] ~?= [2,4,6,8]         , filter ((10 >) <$|(&&)|*> even <$|(&&)|*> (5 <)) [1..100] ~?= [6,8]@@ -141,9 +141,9 @@         , [Just 1] <<$|(,)|*>> [Just 2]              ~?= [Just (1,2)]         ]     , TestList $ ("<<$|, |*>> and higher-order-function" ~:) |$> [ -          foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ((Right . Just) |$> [1,2,3])               ~?= (Right (Just 6) :: Either () (Maybe Int))-        , foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) (Right |$> [Just 1,Nothing,Just 3])        ~?= (Right Nothing :: Either () (Maybe Int))-        , foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right Nothing, Left ()]) ~?= (Left () :: Either () (Maybe Int))+          foldr (\n acc -> n <<$|(+)|*>> acc) ((.**) 0) ((Right . Just) |$> [1,2,3])               ~?= (Right (Just 6) :: Either () (Maybe Int))+        , foldr (\n acc -> n <<$|(+)|*>> acc) ((.**) 0) (Right |$> [Just 1,Nothing,Just 3])        ~?= (Right Nothing :: Either () (Maybe Int))+        , foldr (\n acc -> n <<$|(+)|*>> acc) ((.**) 0) ([Right (Just 1), Right Nothing, Left ()]) ~?= (Left () :: Either () (Maybe Int))         ]     , TestList $ ("|**, |*-, |-*, **|, *-|, -*|" ~:) |$> [            [Just 1] <<$|(+)|** 2          ~?= [Just 3]

@@ -1,30 +0,0 @@-import Test.HUnit--import DeepControl.Applicative-import DeepControl.Monad-import DeepControl.Commutative--main :: IO ()-main = do-    runTestTT $ TestList [-          TestList tTest0-        ]-    runTestTT tests_0-    return ()--------------------------------------------------------------------- unit test-------------------------------------------------------------------tTest0 = ("tTest0" ~:) |$> [-       commute (Just [1]) ~?= [Just 1]-     ]--tests_0 :: Test-tests_0 = test [ -      "IO" ~: do-        actual <- commute ((-*) [1..3])-        actual @?= [1,2,3]-    ]--

@@ -1,7 +1,7 @@ import Test.HUnit hiding (State)  import DeepControl.Applicative -import DeepControl.Commutative (cmap)+import DeepControl.Traversable (sinkmap) import DeepControl.Monad ((>-)) import DeepControl.Monad.Morph import DeepControl.Monad.Trans@@ -51,7 +51,7 @@ poland x = push (read x :: Double)  poland_calc :: [String] -> (Double, [Double])-poland_calc xs = (cmap poland xs >> pop) >- \x -> runState x []+poland_calc xs = (sinkmap poland xs >> pop) >- \x -> runState x []  -- > poland_calc ["1","2","*"] -- (2.0, [])@@ -100,12 +100,12 @@ polandS "/" = do     x <- popS     y <- popS-    liftT $ guard (x /= 0)+    guard (x /= 0)     pushS (y / x) polandS x = pushS (read x :: Double)  poland_calcS :: [String] -> Maybe (Double, [Double])-poland_calcS xs = (cmap polandS xs >> popS) >- \x -> runStateT x []+poland_calcS xs = (sinkmap polandS xs >> popS) >- \x -> runStateT x []  -- > poland_calcS ["1","2","*"] -- Just (2.0, [])@@ -158,7 +158,7 @@ polandMS x = pushMS (read x :: Double)  poland_calcMS :: [String] -> IO (Maybe Double, [Double])-poland_calcMS xs = (cmap polandMS xs >> popMS) >- runMaybeT+poland_calcMS xs = (sinkmap polandMS xs >> popMS) >- runMaybeT                                                >- \x -> runStateT x []  -- > poland_calcS2 ["1","2","*"]@@ -205,7 +205,7 @@ polandSM x = pushSM (read x :: Double)  poland_calcSM :: [String] -> IO (Maybe (Double, [Double]))-poland_calcSM xs = (cmap polandSM xs >> popSM) >- \x -> runStateT x []+poland_calcSM xs = (sinkmap polandSM xs >> popSM) >- \x -> runStateT x []                                                >- runMaybeT  -----------------------------------------------@@ -242,27 +242,26 @@     x <- popSI2     y <- popSI2     liftIO $ putStr (show y ++" / "++ show x ++" = ")-    liftT . liftT2 . (*:) $ guard (x /= 0)+    guard (x /= 0)     liftIO $ putStr (show (y / x) ++"\n")     pushSI2 (y / x) polandSI2 x = pushSI2 (read x :: Double)  poland_calcSI2 :: [String] -> IO (Maybe (Double, [Double]))-poland_calcSI2 xs = (cmap polandSI2 xs >> popSI2) >- \x -> runStateT x []+poland_calcSI2 xs = (sinkmap polandSI2 xs >> popSI2) >- \x -> runStateT x []                                                   >- runIdentityT2  ----------------------------------------------- -- StateT-IdentityT-MaybeT-IO -popSIM :: StateT [a] (IdentityT (MaybeT IO)) a-popSIM = transfold2 |>| popSI2+popSIM :: StateT [a] (MaybeT IO) a+popSIM = (transroll2 . runIdentityT2) |>| popSI2 -polandSIM :: String -> StateT [Double] (IdentityT (MaybeT IO)) Double-polandSIM s = transfold2 |>| polandSI2 s+polandSIM :: String -> StateT [Double] (MaybeT IO) Double+polandSIM s = (transroll2 . runIdentityT2) |>| polandSI2 s  poland_calcSIM :: [String] -> IO (Maybe (Double, [Double]))-poland_calcSIM xs = (cmap polandSIM xs >> popSIM) >- \x -> runStateT x []-                                                  >- runIdentityT+poland_calcSIM xs = (sinkmap polandSIM xs >> popSIM) >- \x -> runStateT x []                                                   >- runMaybeT  -----------------------------------------------@@ -305,7 +304,7 @@ polandSME x = pushSME (read x :: Double)  poland_calcSME :: [String] -> IO (Either () (Maybe (Double, [Double])))-poland_calcSME xs = (cmap polandSME xs >> popSME) >- \x -> runStateT x []+poland_calcSME xs = (sinkmap polandSME xs >> popSME) >- \x -> runStateT x []                                                   >- runMaybeT                                                   >- runExceptT @@ -313,14 +312,14 @@ -- StateT-IdentityT-MaybeT-ExceptT-IO  pushSIME :: a -> StateT [a] (IdentityT (MaybeT (ExceptT () IO))) a-pushSIME x = liftT |>| pushSME x+pushSIME x = IdentityT |>| pushSME x popSIME :: StateT [a] (IdentityT (MaybeT (ExceptT () IO))) a-popSIME = liftT |>| popSME+popSIME = IdentityT |>| popSME polandSIME :: String -> StateT [Double] (IdentityT (MaybeT (ExceptT () IO))) Double-polandSIME x = liftT |>| polandSME x+polandSIME x = IdentityT |>| polandSME x  poland_calcSIME :: [String] -> IO (Either () (Maybe (Double, [Double])))-poland_calcSIME xs = (cmap polandSIME xs >> popSIME) >- \x -> runStateT x []+poland_calcSIME xs = (sinkmap polandSIME xs >> popSIME) >- \x -> runStateT x []                                                      >- runIdentityT                                                      >- runMaybeT                                                      >- runExceptT@@ -329,14 +328,14 @@ -- StateT-IdentityT3-IO-Except-Maybe  pushSI3 :: a -> StateT [a] (IdentityT3 IO (Except ()) Maybe) a-pushSI3 x = untransfold3 |>| pushSIME x+pushSI3 x = (IdentityT3 . untransroll3 . runIdentityT) |>| pushSIME x popSI3 :: StateT [a] (IdentityT3 IO (Except ()) Maybe) a-popSI3 = untransfold3 |>| popSIME+popSI3 = (IdentityT3 . untransroll3 . runIdentityT) |>| popSIME polandSI3 :: String -> StateT [Double] (IdentityT3 IO (Except ()) Maybe) Double-polandSI3 x = untransfold3 |>| polandSIME x+polandSI3 x = (IdentityT3 . untransroll3 . runIdentityT) |>| polandSIME x  poland_calcSI3 :: [String] -> IO (Either () (Maybe (Double, [Double])))-poland_calcSI3 xs = (cmap polandSI3 xs >> popSI3) >- \x -> runStateT x []+poland_calcSI3 xs = (sinkmap polandSI3 xs >> popSI3) >- \x -> runStateT x []                                                   >- runIdentityT3                                                   >- (runExcept|$>) 

@@ -1,20 +1,23 @@ import Test.HUnit hiding (State) -import DeepControl.Applicative ((|$>), (-*), (*:), (**:))+import DeepControl.Applicative ((|$>), (.*), (.**)) import DeepControl.Monad ((>>), (>>==), (->~)) import Control.Monad.Writer  factorial :: Int ->              Maybe (Writer [Int] Int)               -- Maybe-Writer monad-factorial n | n < 0  = (-*) Nothing-            | n == 0 = (*:) $ tell [0] >> (*:) 1+factorial n | n < 0  = Nothing+            | n == 0 = (.*) $ tell [0] >> (.*) 1             | n > 0  = factorial (n-1) >>== \v ->                           tell [v] ->~                 -- (->~) is a level-2 bind-cover function, analogous for (>>)-                       (**:) (n * v)+                       (.**) (n * v)  -- > runWriter |$> factorial 5 -- Just (120,[0,1,1,2,6,24]) +-- > factorial (-1)+-- Nothing+ main :: IO () main = do     runTestTT tests_@@ -25,6 +28,9 @@       "factorial" ~: do         let actual = runWriter |$> factorial 5         actual @?= Just (120,[0,1,1,2,6,24])++        let actual = factorial (-1)+        actual @?= Nothing      ] 

@@ -1,17 +1,17 @@ import Test.HUnit hiding (State) -import DeepControl.Applicative ((|$>>), (*-*), (*:), (**:), (***:))+import DeepControl.Applicative ((|$>>), (.*), (.**), (.***)) import DeepControl.Monad ((>>), (>>>==), (>--~), (-->~)) import Control.Monad.Writer  factorial :: Int ->              IO (Maybe (Writer [Int] Int))            -- IO-Maybe-Writer monad-factorial n | n < 0  = (*-*) Nothing                  -- (*-*) is a level-3 cover function-            | n == 0 = (**:) $ tell [0] >> (*:) 1+factorial n | n < 0  = (.*) Nothing                  +            | n == 0 = (.**) $ tell [0] >> (.*) 1             | n > 0  = factorial (n-1) >>>== \v ->    -- (>>>==) is the level-3 bind function, analogous for (>>=)                        print v >--~                   -- (>--~) is a level-3 bind-cover function, analogous for (>>)                        tell [v] -->~                  -- (-->~) is a level-3 bind-cover function too, analogous for (>>)-                       (***:) (n * v)+                       (.***) (n * v)  -- > runWriter |$>> factorial 5 -- 1@@ -21,6 +21,9 @@ -- 24 -- Just (120,[0,1,1,2,6,24]) +-- > factorial (-1)+-- Nothing+ main :: IO () main = do     runTestTT tests_@@ -31,6 +34,9 @@       "factorial" ~: do         actual <- runWriter |$>> factorial 5         actual @?= Just (120,[0,1,1,2,6,24])+ +        actual <- factorial (-1)+        actual @?= Nothing      ] 

@@ -37,22 +37,22 @@  tLevel2 = ("Level2" ~:) |$> [       ([[1]] >>== \x -> [[x]]) ~?= [[1]]-    , ([[1]] >>== \x -> (**:) x) ~?= [[1]]-    , (Just [1] >>== \x -> (**:) x) ~?= Just [1]-    , ([Just 1] >>== \x -> (**:) x) ~?= [Just 1]-    , (Right [1] >>== \x -> (**:) x) ~?= (Right [1] :: Either () [Int])+    , ([[1]] >>== \x -> (.**) x) ~?= [[1]]+    , (Just [1] >>== \x -> (.**) x) ~?= Just [1]+    , ([Just 1] >>== \x -> (.**) x) ~?= [Just 1]+    , (Right [1] >>== \x -> (.**) x) ~?= (Right [1] :: Either () [Int]) -    , (Right [0] >>== \x -> (**:) (x+1) >>== \x -> (**:) (x+2)) ~?= (Right [3] :: Either () [Int])+    , (Right [0] >>== \x -> (.**) (x+1) >>== \x -> (.**) (x+2)) ~?= (Right [3] :: Either () [Int])     ]  tLevel3 = ("Level3" ~:) |$> [-      ([[[1]]] >>>== \x -> (***:) x) ~?= [[[1]]]-    , ((Just [[1]]) >>>== \x -> (***:) x) ~?= Just [[1]]-    , (([Just [1]]) >>>== \x -> (***:) x) ~?= [Just [1]]-    , (Right (Just [1]) >>>== \x -> (***:) x) ~?= (Right (Just [1]) :: Either () (Maybe [Int]))+      ([[[1]]] >>>== \x -> (.***) x) ~?= [[[1]]]+    , ((Just [[1]]) >>>== \x -> (.***) x) ~?= Just [[1]]+    , (([Just [1]]) >>>== \x -> (.***) x) ~?= [Just [1]]+    , (Right (Just [1]) >>>== \x -> (.***) x) ~?= (Right (Just [1]) :: Either () (Maybe [Int])) -    , (Right (Just [0]) >>>== \x -> (***:) (x+1) >>>== \x -> (***:) (x+2)) ~?= (Right (Just [3]) :: Either () (Maybe [Int]))-    , (Right Nothing    >>>== \x -> (***:) (x+1) >>>== \x -> (***:) (x+2)) ~?= (Right Nothing :: Either () (Maybe [Int]))+    , (Right (Just [0]) >>>== \x -> (.***) (x+1) >>>== \x -> (.***) (x+2)) ~?= (Right (Just [3]) :: Either () (Maybe [Int]))+    , (Right Nothing    >>>== \x -> (.***) (x+1) >>>== \x -> (.***) (x+2)) ~?= (Right Nothing :: Either () (Maybe [Int]))     ]  tests_Level0 :: Test@@ -72,22 +72,22 @@         let actual :: [[String]]             actual = [["a","b"]] >>== \x ->                      [[0],[1,2]] >>== \y ->-                     (**:) $ x ++ show y+                     (.**) $ x ++ show y         actual @?= [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]]      , "List-Maybe" ~: "(>>==), (>>~)" ~: do         let actual :: [Maybe Double]             actual = (readMay |$> ["1", "2", "_"]) >>== \a ->                      (readMay |$> ["0", "2"]) >>== \b ->-                     ((*:) $ guard (b /= 0.0)) >>~-                     (**:) $ a / b+                     ((.*) $ guard (b /= 0.0)) >>~+                     (.**) $ a / b         actual @?= [Just 0.5,Just 1.0,Nothing]     , "List-Maybe" ~: "(->~)" ~: do         let actual :: [Maybe Double]             actual = (readMay |$> ["1", "2", "_"]) >>== \a ->                      (readMay |$> ["0", "2"]) >>== \b ->                      guard (b /= 0.0) ->~-                     (**:) $ a / b+                     (.**) $ a / b         actual @?= [Just 0.5,Just 1.0,Nothing]      , "(->)-Maybe" ~: "(>-==)" ~: do@@ -98,7 +98,7 @@             averageM =                  sum >-== \s ->                 lengthM >>== \l ->-                (**:) $ fromIntegral s / fromIntegral l+                (.**) $ fromIntegral s / fromIntegral l         averageM [10, 25, 70] @?= Just 35.0         averageM []           @?= Nothing     , "Reader-Maybe" ~: do@@ -112,17 +112,17 @@             averageRM =                  sumR >-== \s ->                 lengthRM >>== \l ->-                (**:) $ fromIntegral s / fromIntegral l+                (.**) $ fromIntegral s / fromIntegral l         runReader averageRM [10, 25, 70] @?= Just 35.0         runReader averageRM []           @?= Nothing      , "Maybe-Writer" ~: "(-*)" ~: do         let factorial :: Int -> Maybe (Writer [Int] Int)             factorial n | n < 0  = (-*) Nothing-                        | n == 0 = (*:) $ tell [0] >> return 1+                        | n == 0 = (.*) $ tell [0] >> return 1                         | n > 0  = factorial (n-1) >>== \v ->                                    tell [v] ->~-                                   (**:) (n * v)+                                   (.**) (n * v)         (runWriter |$> factorial 5) @?= Just (120,[0,1,1,2,6,24])      ]@@ -132,11 +132,11 @@       "IO-Maybe-Writer" ~: "(>>>==), (-->~), (*-*)" ~: do         let factorial :: Int -> IO (Maybe (Writer [Int] Int))             factorial n | n < 0  = (*-*) Nothing-                        | n == 0 = (**:) $ tell [0] >> return 1+                        | n == 0 = (.**) $ tell [0] >> return 1                         | n > 0  = factorial (n-1) >>>== \v ->                                    print v >--~                                    tell [v] -->~-                                   (***:) (n * v)+                                   (.***) (n * v)         actual <- factorial 5         (runWriter |$> actual) @?= Just (120,[0,1,1,2,6,24])     ]

@@ -0,0 +1,82 @@+import Test.HUnit hiding (State)++import DeepControl.Monad.Morph ((|>=), (|>>=), (|*|), (|-*|))+import DeepControl.Monad.Trans.Except++import Control.Exception (IOException, try)+import Control.Monad.Trans.Maybe++-----------------------------------------------+-- Level-1 ++catchIOError :: IO a -> +                ExceptT IOException IO a   -- ExceptT-IO monad+catchIOError io = ExceptT $ (try io)++viewFile :: IO ()                          -- IO monad+viewFile = do+    str <- readFile "test.txt"        +    putStr str++program :: ExceptT IOException IO ()       -- ExceptT-IO monad+program = (|*|) viewFile |>= catchIOError  -- (|*|) is the level-1 trans-cover function, alias to 'lift', analogous to (.*)+                                           -- (|>=) is the level-1 trans-bind function, analogous to (>>=)++calc_program :: IO (Either IOException ())+calc_program = runExceptT $ program        ++-- > calc_program+-- Left test.txt: openFile: does not exist (No such file or directory)++-----------------------------------------------+-- Level-2++viewFile2 :: String -> +             MaybeT IO ()                        -- MaybeT-IO monad+viewFile2 filename = do+    guard (filename /= "")+    str <- (|*|) $ readFile "test.txt"        +    (|*|) $ putStr str++program2 :: String -> +            (ExceptT IOException (MaybeT IO)) () -- ExceptT-MaybeT-IO monad+program2 filename = +    (|*|) (viewFile2 filename) |>>= \x ->        -- (|>>=) is the level-2 trans-bind function, analogous to (>>=)+    (|-*|) $ catchIOError x                      -- (|-*|) is a level-2 trans-cover function, analogous to (-*)++calc_program2 :: String -> IO (Maybe (Either IOException ())) +calc_program2 filename = runMaybeT . runExceptT $ program2 filename++-- > calc_program "test.txt"+-- Just (Left test.txt: openFile: does not exist (No such file or directory))+-- > calc_program ""+-- Nothing++------------------------------------------------------+--++main :: IO ()+main = do+    runTestTT tests_+    runTestTT tests2_+    return ()++tests_ :: Test+tests_ = test [ +      "1" ~: do+        actual <- calc_program +        print actual+        return ()+    ]++tests2_ :: Test+tests2_ = test [ +      "2" ~: do+        actual <- calc_program2 "test.txt"+        print actual+        return ()+        actual <- calc_program2 ""+        actual @?= Nothing++    ]+

@@ -1,11 +1,11 @@ import Test.HUnit  import DeepControl.Applicative-import DeepControl.Commutative (commute)+import DeepControl.Traversable (sink) import DeepControl.Monad ((>-))-import DeepControl.Monad.Morph ((|>|))-import DeepControl.Monad.Trans (liftTT2, transfold2, untransfold2)-import DeepControl.Monad.Trans.Identity+import DeepControl.Monad.Morph ((|*|), (|>|))+import DeepControl.Monad.Trans (transroll2, untransroll2)+import DeepControl.Monad.Trans.Identity (Identity(..), IdentityT(..), IdentityT2(..)) import Control.Monad.Reader import Control.Monad.Trans.Maybe @@ -14,38 +14,38 @@ type TimeLimit = Int  ackermannTimeLimit :: TimeLimit -> Int -> Int -> -                      IO (Maybe Int)                     -- IO-Maybe Monad+                      IO (Maybe Int)                      -- IO-Maybe Monad ackermannTimeLimit timelimit x y = timeout timelimit (ackermannIO x y)   where     ackermannIO :: Int -> Int -> IO Int-    ackermannIO 0 n = (*:) $ n + 1+    ackermannIO 0 n = (.*) $ n + 1     ackermannIO m n | m > 0 && n == 0 = ackermannIO (m-1) 1                     | m > 0 && n > 0  = ackermannIO m (n-1) >>= ackermannIO (m-1)   ackermann :: Int -> Int -> -             ReaderT TimeLimit (IdentityT2 IO Maybe) Int -- ReaderT-IdentityT2-IO-Maybe monad+             ReaderT TimeLimit (IdentityT2 IO Maybe) Int  -- ReaderT-IdentityT2-IO-Maybe monad ackermann x y = do     timelimit <- ask-    liftTT2 $ ackermannTimeLimit timelimit x y           -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function+    (|*|) . IdentityT2 $ ackermannTimeLimit timelimit x y -- lift IO-Maybe function to ReaderT-IdentityT2-IO-Maybe function  calc_ackermann :: TimeLimit -> Int -> Int -> IO (Maybe Int) calc_ackermann timelimit x y = ackermann x y >- \r -> runReaderT r timelimit                                              >- runIdentityT2 --- λ> commute $ calc_ackermann 1000 |$> [0..4] |* 4+-- λ> sink $ calc_ackermann 1000 |$> [0..4] |* 4 -- [Just 5,Just 6,Just 11,Just 125,Nothing]  ackermann' :: Int -> Int -> -              ReaderT TimeLimit (MaybeT IO) Int                -- ReaderT-MaybeT-IO monad-ackermann' x y = (runIdentityT . transfold2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function+              ReaderT TimeLimit (MaybeT IO) Int                 -- ReaderT-MaybeT-IO monad+ackermann' x y = (transroll2 . runIdentityT2) |>| ackermann x y -- You can get usual ReaderT-MaybeT-IO function from ReaderT-IdentityT2-IO-Maybe function  calc_ackermann' :: TimeLimit -> Int -> Int -> IO (Maybe Int) calc_ackermann' timelimit x y = ackermann' x y >- \r -> runReaderT r timelimit                                                >- runMaybeT  ackermann'' :: Int -> Int -> -               ReaderT TimeLimit (IdentityT2 IO Maybe) Int      -- ReaderT-IdentityT2-IO-Maybe monad-ackermann'' x y = (untransfold2 . IdentityT) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function+               ReaderT TimeLimit (IdentityT2 IO Maybe) Int       -- ReaderT-IdentityT2-IO-Maybe monad+ackermann'' x y = (IdentityT2 . untransroll2) |>| ackermann' x y -- You can get ReaderT-IdentityT2-IO-Maybe function from usual ReaderT-MaybeT-IO function  calc_ackermann'' :: TimeLimit -> Int -> Int -> IO (Maybe Int) calc_ackermann'' timelimit x y = ackermann'' x y >- \r -> runReaderT r timelimit@@ -65,21 +65,21 @@ tests_1 :: Test tests_1 = test [        "calc" ~: do-        actual <- commute $ calc_ackermann 1000 |$> [0..4] |* 4+        actual <- sink $ calc_ackermann 1000 |$> [0..4] |* 4         actual @?= [Just 5,Just 6,Just 11,Just 125,Nothing]     ]  tests_2 :: Test tests_2 = test [        "calc" ~: do-        actual <- commute $ calc_ackermann' 1000 |$> [0..4] |* 4+        actual <- sink $ calc_ackermann' 1000 |$> [0..4] |* 4         actual @?= [Just 5,Just 6,Just 11,Just 125,Nothing]     ]  tests_3 :: Test tests_3 = test [        "calc" ~: do-        actual <- commute $ calc_ackermann'' 1000 |$> [0..4] |* 4+        actual <- sink $ calc_ackermann'' 1000 |$> [0..4] |* 4         actual @?= [Just 5,Just 6,Just 11,Just 125,Nothing]     ] 

@@ -1,11 +1,9 @@ import Test.HUnit hiding (State)  import DeepControl.Applicative ((|$>))-import DeepControl.Commutative (Commutative) import DeepControl.Monad (Monad)-import DeepControl.Monad.Morph ((|>|))-import DeepControl.Monad.Trans (liftT, (|*|), (|-*|), (|*-|))-import DeepControl.Monad.Trans.Identity+import DeepControl.Monad.Morph (generalize, (|*|), (|>|))+import DeepControl.Monad.Trans.Identity (IdentityT(..), IdentityT2(..), (-*:), (*-:)) import Control.Monad.Writer import Control.Monad.State @@ -14,8 +12,8 @@  tock                         ::                   StateT Int IO () tock = do-    (|*|) tick               :: (Monad      m) => StateT Int m  ()  -- (|*|) is the level-1 trans-cover function, analogous for (*:)-    liftT $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- 'liftT' is the level-1 trans-lift function, alias to 'lift'+    generalize |>| tick      :: (Monad      m) => StateT Int m  ()  -- (|>|) is the level-1 trans-map function, analogous to (|$>)+    (|*|) $ putStrLn "Tock!" :: (MonadTrans t) => t          IO ()  -- (|*|) is the level-1 trans-lift function, alias to 'lift'  -- λ> runStateT tock 0 -- Tock!@@ -24,13 +22,13 @@ save :: StateT Int (Writer [Int]) () save = do     n <- get-    liftT $ tell [n]+    (|*|) $ tell [n]  program ::                             StateT Int (IdentityT2 IO (Writer [Int])) () -- StateT-IdentityT2-IO-Writer monad, a level-2 monad-transform program = replicateM_ 4 $ do-    ((|-*|).liftT) |>| tock                                                         -- (|-*|) is a level-2 trans-cover function, analogous for (-*)-        :: (Monad m, Commutative m) => StateT Int (IdentityT2 IO m             ) ()-    ((|*-|).liftT) |>| save                                                         -- (|*-|) is a level-2 trans-cover function, analogous for (*:)+    ((-*:) . IdentityT) |>| tock                                                    -- (-*:) is a level-2 trans-cover function, analogous to (-*)+        :: (Monad m, Traversable m) => StateT Int (IdentityT2 IO m             ) ()+    ((*-:) . IdentityT) |>| save                                                    -- (*-:) is a level-2 trans-cover function, analogous to (.*)         :: (Monad m               ) => StateT Int (IdentityT2 m  (Writer [Int])) ()  -- λ> execWriter |$> runIdentityT2 (runStateT program 0)

@@ -0,0 +1,30 @@+import Test.HUnit++import DeepControl.Applicative+import DeepControl.Monad+import DeepControl.Traversable++main :: IO ()+main = do+    runTestTT $ TestList [+          TestList tTest0+        ]+    runTestTT tests_0+    return ()++----------------------------------------------------------------+-- unit test+----------------------------------------------------------------++tTest0 = ("tTest0" ~:) |$> [+       sink (Just [1]) ~?= [Just 1]+     ]++tests_0 :: Test+tests_0 = test [ +      "IO" ~: do+        actual <- sink ((-*) [1..3])+        actual @?= [1,2,3]+    ]++