diff --git a/DeepControl/Applicative.hs b/DeepControl/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Applicative.hs
@@ -0,0 +1,421 @@
+{-|
+Module      : DeepControl.Applicative
+Description : Enable deep level Applicative style programming.
+Copyright   : KONISHI Yohuske 2015
+License     : BSD-style (see the LICENSE file in the distribution)
+Maintainer  : ocean0yohsuke@gmail.com
+Stability   : experimental
+Portability : ---
+
+This module enables you to program in applicative style for more __deeper__ level than the usual 'Control.Applicative' module expresses.
+You would soon realize exactly what __/more deeper level/__ means by reading the example codes in order, which are attached on the functions below.
+Note: all braket-cover notation for Level-4 and Level-5 is not written yet.
+-}
+module DeepControl.Applicative (
+    module Control.Applicative,
+
+    -- * Level-0
+    -- ** bra-ket notation
+    (|>), (<|),
+
+    -- * Level-1
+    -- ** cover notation
+    (*:),
+    -- ** bra-ket notation
+    (|$>), (<$|), (|*>), (<*|),
+    -- ** braket-cover notation
+    (|*), (*|),
+
+    -- * Level-2
+    -- ** cover notation
+    (**:), (*-), (-*),
+    -- ** bra-ket notation
+    (|$>>), (<<$|), (|*>>), (<<*|),
+    -- ** braket-cover notation
+    (|**), (**|), (|-*), (|*-), (-*|), (*-|),
+
+    -- * Level-3
+    -- ** cover notation
+    (***:), (**-), (*-*), (-**), (--*), (-*-), (*--),
+    -- ** bra-ket notation
+    (|$>>>), (<<<$|), (|*>>>), (<<<*|),
+    -- ** braket-cover notation
+    (|***), (***|),
+    (|-**), (|*-*), (|**-), (|--*), (|-*-), (|*--),
+    (-**|), (*-*|), (**-|), (--*|), (-*-|), (*--|),
+
+    -- * Level-4
+    -- ** cover notation
+    (****:), 
+    -- ** bra-ket notation
+    (|$>>>>), (<<<<$|), (|*>>>>), (<<<<*|),
+
+    -- * Level-5
+    -- ** cover notation
+    (*****:), 
+    -- ** bra-ket notation
+    (|$>>>>>), (<<<<<$|), (|*>>>>>), (<<<<<*|),
+
+    ) where 
+
+import Control.Applicative
+
+-- -----------------------------------------------------------------------------
+-- Level-0 functions
+
+infixl 4  |>, <|
+-- | Alias for @'$'@. 
+-- 
+-- >>> (1+) |> 2
+-- 3
+(|>) :: (a -> b) -> a -> b
+(|>) = ($)
+
+-- | The auguments-flipped function for @'|>'@. 
+-- 
+-- >>> 1 <| (+2) 
+-- 3 
+-- >>> 1 <|(+)|> 2 
+-- 3 
+-- >>> 1 <|(+)|> 2 <|(*)|> 3
+-- 9
+--
+-- >>> 1 <|(,)|> 2
+-- (1,2)
+(<|) :: a -> (a -> b) -> b
+(<|) = flip (|>)
+
+-- -----------------------------------------------------------------------------
+-- Level-1 functions
+
+infixl 5  *:
+-- | Alias for @'pure'@.
+(*:) :: (Applicative f) => a -> f a
+(*:) = pure
+
+infixl 4 |$>
+-- | Alias for @'<$>'@.
+--
+-- >>> (1+) |$> [2] 
+-- [3]
+(|$>) :: Functor f => (a -> b) -> f a -> f b
+(|$>) = (<$>)
+
+infixl 3  <$|, |*>, <*|, |*, *|
+-- | The auguments-flipped function for @'|$>'@.
+--
+-- >>> [1] <$| (+2) 
+-- [3]
+--
+-- >>> ("<"++)|$> ["a","b"] <$|(++">")
+-- ["<a>","<b>"]
+(<$|) :: Functor f => f a -> (a -> b) -> f b
+(<$|) = flip (|$>)
+
+-- | Alias for @'<*>'@.
+-- 
+-- >>> [(1+)] |*> [2]
+-- [3]
+--
+-- >>> [1] <$|(+)|*> [2]
+-- [3]
+-- >>> [1] <$|(+)|*> [0,1,2] 
+-- [1,2,3]
+-- >>> [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]
+-- Just [1,2,3]
+-- >>> foldr (\x acc -> x <$|(:)|*> acc) ((*:) []) [Just 1, Nothing, Just 3]
+-- Nothing
+--
+-- >>> filter (even <$|(&&)|*> (10 >)) [1..100]
+-- [2,4,6,8]
+-- >>> filter (even <$|(&&)|*> (10 >) <$|(&&)|*> (5 <)) [1..100]
+-- [6,8]
+(|*>) :: Applicative f => f (a -> b) -> f a -> f b
+(|*>) = (<*>)
+
+-- | The auguments-flipped function for @'|*>'@. 
+(<*|) :: Applicative f => f a -> f (a -> b) -> f b
+(<*|) = flip (|*>)
+
+-- | Combination consisted of ket @'|*>'@ and cover @'*:'@, defined as @f |* x = f |*> ((*:) x)@.
+--
+-- >>> [(1+)] |* 2
+-- [3]
+-- >>> [1] <$|(+)|* 2 
+-- [3]
+-- >>> [1] <$|(+)|* 2 <$|(*)|* 3
+-- [9]
+--
+-- >>> Just 1 <$|(,)|* 2 
+-- Just (1,2)
+(|*) :: Applicative f => f (a -> b) -> a -> f b
+f |* x = f |*> ((*:) x)
+
+-- | The auguments-flipped function for @'|*'@. 
+--
+-- >>> 1 *| [(+2)]
+-- [3]
+-- >>> 1 *| [(+)] |* 2
+-- [3]
+-- >>> 1 *|[(+),(-),(*),(^)]|* 2
+-- [3,-1,2,1]
+-- 
+-- >>> 1 *|Just (,)|* 2
+-- Just (1,2)
+--
+(*|) :: Applicative f => a -> f (a -> b) -> f b
+(*|) = flip (|*)
+
+-- -----------------------------------------------------------------------------
+-- Level-2 functions
+
+infixl 5  **:
+infixl 5  -*, *-
+-- | Combination consisted of cover @'*:'@ twice, defined as @(**:) = (*:) . (*:)@.
+(**:) :: (Applicative f1, Applicative f2) => a -> f1 (f2 a)
+(**:) = (*:) . (*:)
+
+-- | Combination consisted of cover @'*:'@ and ket @'|$>'@, defined as @(-*) = ((*:)|$>)@.
+(-*) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 a)
+(-*) = ((*:)|$>) 
+
+(*-) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 a)
+-- | Alias for @'*:'@. 
+(*-) = (*:)
+
+infixl 4  |$>>
+-- | Combination consisted of cover @'|$>'@ twice, defined as @(|$>>) = (|$>) . (|$>)@.
+--
+-- >>> (+1) |$>> [[2]]
+-- [[3]]
+(|$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
+(|$>>) = (|$>) . (|$>)
+
+infixl 3  <<$|, |*>>, <<*|
+infixl 3  |**, **|
+infixl 3  |-*, |*-, -*|, *-|
+-- | The auguments-flipped function for @'|$>>'@
+--
+-- >>> [[2]] <<$| (+1)
+-- [[3]]
+(<<$|) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b)
+(<<$|) = flip (|$>>)
+
+-- | The lifted function of @'|*>'@, defined as @(|*>>) = liftA2 (|*>)@.
+--
+-- >>> [Just 1] <<$|(+)|*>> [Just 2] 
+-- [Just 3]
+--
+-- >>> [Just 1] <<$|(,)|*>> [Just 2]
+-- [Just (1,2)]
+--
+-- >>> [[1]] <<$|(+)|*>> [[2]] <<$|(-)|*>> [[3]]
+-- [[0]]
+--
+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right (Just 2), Right (Just 3)]) :: Either () (Maybe Int)
+-- Right (Just 6)
+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right Nothing, Right (Just 3)]) :: Either () (Maybe Int)
+-- Right Nothing
+-- >>> foldr (\n acc -> n <<$|(+)|*>> acc) ((**:) 0) ([Right (Just 1), Right Nothing, Left ()])
+-- Left ()
+(|*>>) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f1 (f2 a) -> f1 (f2 b)
+(|*>>) = liftA2 (|*>)
+
+-- | The auguments-flipped function for @'|*>>'@.
+(<<*|) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 (a -> b)) -> f1 (f2 b)
+(<<*|) = flip (|*>>)
+
+-- | Combination consisted of ket @'|*>>'@ and cover @'**:'@, defined as @f |** x = f |*>> ((**:) x)@.
+--
+-- >>> [Just 1] <<$|(+)|** 2
+-- [Just 3]
+(|**) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> a -> f1 (f2 b)
+f |** x = f |*>> ((**:) x)
+
+-- | The auguments-flipped function for @'|**'@.
+--
+-- >>> 1 **|(+)|$>> [Just 2]
+-- [Just 3]
+--
+-- >>> 1 **|[Just (+)]|**  2
+-- [Just 3]
+-- >>> 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)
+(**|)  = flip (|**)
+
+-- | Combination consisted of ket @'|*>>'@ and cover @'-*'@, defined as @f |-* x = f |*>> ((-*) x)@.
+--
+-- >>> [Just 1] <<$|(+)|-* [2]
+-- [Just 3]
+(|-*) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f1 a -> f1 (f2 b)
+f |-* x = f |*>> ((-*) x)
+
+-- | Combination consisted of ket @'|*>>'@ and cover @'*-'@, defined as @f |-* x = f |*>> ((*-) x)@.
+--
+-- >>> [Just 1] <<$|(+)|*- Just 2 
+-- [Just 3]
+(|*-) :: (Applicative f1, Applicative f2) => f1 (f2 (a -> b)) -> f2 a -> f1 (f2 b)
+f |*- x = f |*>> ((*-) x)
+
+-- | The auguments-flipped function for @'|-*'@.
+--
+-- >>> [1] -*|(+)|$>> [Just 2]
+-- [Just 3]
+(-*|) :: (Applicative f1, Applicative f2) => f1 a -> f1 (f2 (a -> b)) -> f1 (f2 b)
+(-*|) = flip (|-*)
+-- | The auguments-flipped function for @'|*-'@.
+--
+-- >>> Just 1 *-|(+)|$>> [Just 2]
+-- [Just 3]
+-- >>> Just 1 *-|[Just (+)]|** 2
+-- [Just 3]
+-- >>> Just 1 *-|[Just (+)]|*- Just 2
+-- [Just 3]
+-- >>> [1] -*|[Just (+)]|*- Just 2
+-- [Just 3]
+-- >>> [1] -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2
+-- [Just 3,Just (-1),Just 2,Nothing]
+-- >>> [0,1] -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2
+-- [Just 2,Just 3,Just (-2),Just (-1),Just 0,Just 2,Nothing,Nothing]
+(*-|) :: (Applicative f1, Applicative f2) => f2 a -> f1 (f2 (a -> b)) -> f1 (f2 b)
+(*-|) = flip (|*-)
+
+{-
+infixl 3  <<*, *>>
+(*>>) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 b)
+(*>>) = liftA2 (*>)
+(<<*) :: (Applicative f1, Applicative f2) => f1 (f2 a) -> f1 (f2 b) -> f1 (f2 a)
+(<<*) = liftA2 (<*)
+-}
+
+-- -----------------------------------------------------------------------------
+-- Level-3 functions
+
+infixl 5  ***:
+infixl 5  -**, *-*, **-, --*, -*-, *--
+(***:) :: (Applicative f1, Applicative f2, Applicative f3) => 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))
+(*-*) = (*:) . ((*:)|$>) 
+(**-) :: (Applicative f1, Applicative f2, Applicative f3) => f3 a -> f1 (f2 (f3 a))
+(**-) = (**:)
+(--*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 a) -> f1 (f2 (f3 a))
+(--*) = ((*:)|$>>)
+(-*-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f3 a) -> f1 (f2 (f3 a))
+(-*-) = ((*:)|$>)
+(*--) :: (Applicative f1, Applicative f2, Applicative f3) => f2 (f3 a) -> f1 (f2 (f3 a))
+(*--) = (*:)
+
+infixl 4  |$>>>
+(|$>>>) :: (Functor f1, Functor f2, Functor f3) => (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))
+(|$>>>) = (|$>) . (|$>>)
+
+infixl 3  <<<$|, |*>>>, <<<*|
+infixl 3  |***, ***|
+infixl 3  |-**, |*-*, |**-, |--*, |-*-, |*--
+infixl 3  -**|, *-*|, **-|, --*|, -*-|, *--|
+(<<<$|) :: (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 (|*>>)
+(<<<*|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))
+(<<<*|) = flip (|*>>>)
+
+(|***) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> a -> f1 (f2 (f3 b))
+f |*** x = f |*>>> ((***:) x)
+(***|) :: (Applicative f1, Applicative f2, Applicative f3) => a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))
+(***|)  = flip (|***)
+
+(|-**) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 a -> f1 (f2 (f3 b))
+f |-** x = f |*>>> ((-**) x)
+(|*-*) :: (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)
+(|--*) :: (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)
+(|-*-) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 (a -> b))) -> f1 (f3 a) -> f1 (f2 (f3 b))
+f |-*- x = f |*>>> ((-*-) x)
+
+(-**|) :: (Applicative f1, Applicative f2, Applicative f3) => f1 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))
+(-**|) = flip (|-**)
+(*-*|) :: (Applicative f1, Applicative f2, Applicative f3) => f2 a -> f1 (f2 (f3 (a -> b))) -> f1 (f2 (f3 b))
+(*-*|) = flip (|*-*)
+(**-|) :: (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 (|-*-)
+
+{-
+infixl 3  <<<*, *>>>
+(*>>>) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 b))
+(*>>>) = liftA2 (*>>)
+(<<<*) :: (Applicative f1, Applicative f2, Applicative f3) => f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) -> f1 (f2 (f3 a))
+(<<<*) = liftA2 (<<*)
+-}
+
+-- -----------------------------------------------------------------------------
+-- Level-4 functions
+
+infixl 5  ****:
+(****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => 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)))
+(|$>>>>) = (|$>) . (|$>>>)
+
+infixl 3  <<<<$|, |*>>>>, <<<<*|
+(<<<<$|) :: (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 (|*>>>)
+(<<<<*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 (a -> b)))) -> f1 (f2 (f3 (f4 b)))
+(<<<<*|) = flip (|*>>>>)
+
+{-
+infixl 3  <<<<*, *>>>>
+(*>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 b)))
+(*>>>>) = liftA2 (*>>>)
+(<<<<*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4) => f1 (f2 (f3 (f4 a))) -> f1 (f2 (f3 (f4 b))) -> f1 (f2 (f3 (f4 a)))
+(<<<<*) = liftA2 (<<<*)
+-}
+
+-- -----------------------------------------------------------------------------
+-- Level-5 functions
+
+infixl 5  *****:
+(*****:) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => 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))))
+(|$>>>>>) = (|$>) . (|$>>>>)
+
+infixl 3  <<<<<$|, |*>>>>>, <<<<<*|
+(<<<<<$|) :: (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 (|*>>>>)
+(<<<<<*|) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 (a -> b))))) -> f1 (f2 (f3 (f4 (f5 b))))
+(<<<<<*|) = flip (|*>>>>>)
+
+{-
+infixl 3  <<<<<*, *>>>>>
+(*>>>>>) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 b))))
+(*>>>>>) = liftA2 (*>>>>)
+(<<<<<*) :: (Applicative f1, Applicative f2, Applicative f3, Applicative f4, Applicative f5) => f1 (f2 (f3 (f4 (f5 a)))) -> f1 (f2 (f3 (f4 (f5 b)))) -> f1 (f2 (f3 (f4 (f5 a))))
+(<<<<<*) = liftA2 (<<<<*)
+-}
diff --git a/DeepControl/Arrow.hs b/DeepControl/Arrow.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Arrow.hs
@@ -0,0 +1,84 @@
+{-|
+Module      : DeepControl.Commutative
+Description : Enable deep level Arrow programming.
+Copyright   : KONISHI Yohuske 2015,
+License     : BSD-style (see the LICENSE file in the distribution)
+Maintainer  : ocean0yohsuke@gmail.com
+Stability   : experimental
+Portability : ---
+
+-}
+{-# LANGUAGE Arrows #-}
+module DeepControl.Arrow (
+    module Control.Arrow,
+    
+    Kleisli2(..),
+    Kleisli3(..),
+    Kleisli4(..),
+    Kleisli5(..),
+
+    ) where 
+
+import DeepControl.Applicative
+import DeepControl.Monad
+import Control.Arrow
+import Prelude hiding (id, (.))
+import Control.Category
+
+----------------------------------------------------------------------
+-- Kleisli2
+
+newtype Kleisli2 m1 m2 a b = Kleisli2 { runKleisli2 :: a -> m1 (m2 b) }
+
+instance (Applicative m1, Monad m1, Monad2 m2) => Category (Kleisli2 m1 m2) where
+    id = Kleisli2 $ (**:) 
+    (Kleisli2 g) . (Kleisli2 f) = Kleisli2 $ f >==> g
+
+instance (Applicative m1, Monad m1, Monad2 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 (Applicative m1, Monad m1, Monad2 m2, Monad3 m3) => Category (Kleisli3 m1 m2 m3) where
+    id = Kleisli3 $ (***:) 
+    (Kleisli3 g) . (Kleisli3 f) = Kleisli3 $ f >===> g
+
+instance (Applicative m1, Monad m1, Monad2 m2, Monad3 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 (Applicative m1, Monad m1, Monad2 m2, Monad3 m3, Monad4 m4) => Category (Kleisli4 m1 m2 m3 m4) where
+    id = Kleisli4 $ (****:) 
+    (Kleisli4 g) . (Kleisli4 f) = Kleisli4 $ f >====> g
+
+instance (Applicative m1, Monad m1, Monad2 m2, Monad3 m3, Monad4 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 (Applicative m1, Monad m1, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 m5) => Category (Kleisli5 m1 m2 m3 m4 m5) where
+    id = Kleisli5 $ (*****:)
+    (Kleisli5 g) . (Kleisli5 f) = Kleisli5 $ f >=====> g
+
+instance (Applicative m1, Monad m1, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 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)
+
+
diff --git a/DeepControl/Commutative.hs b/DeepControl/Commutative.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Commutative.hs
@@ -0,0 +1,88 @@
+{-|
+Module      : DeepControl.Commutative
+Description : Commutative Functor, Applicative, Monad.
+Copyright   : KONISHI Yohuske 2015,
+              Conor McBride and Ross Paterson 2005
+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.
+Another reason I put this module is for the case if GHC would parse @((->) r)@ as a data constructor someday.
+
+-}
+module DeepControl.Commutative (
+    -- * The 'Commutative' class
+    Commutative(..),
+    -- * Utility functions
+    commuteMap,
+    commuteFor,
+    -- * General definitions for superclass methods
+    fmapDefault,
+    foldMapDefault,
+    ) where 
+
+import DeepControl.Applicative
+
+------------------------------------------------------------------------------
+-- Commutative
+
+-- | 
+-- 
+class (Functor c) => Commutative c where
+  -- | This method is the same for @'Data.Traversable.sequenceA'@ just except the name.
+  --   The only difference is the name "commute", that is to say from which no action kind of concepts smell.
+  commute :: Applicative f => c (f a) -> f (c a)
+
+-- | Do @fmap f@ then commute, the same for @'Data.Traversable.traverse'@.
+commuteMap :: (Applicative f, Commutative c) => (a -> f b) -> c a -> f (c b)
+commuteMap f = commute . (f |$>)
+-- | The auguments-flipped function for @'commuteMap'@, the same for @'Data.Traversable.for'@.
+commuteFor :: (Applicative f, Commutative c) => c a -> (a -> f b) -> f (c b)
+commuteFor = flip commuteMap
+
+instance Commutative Maybe where
+    commute (Just fa) = Just |$> fa
+    commute Nothing = (*:) Nothing
+
+instance Commutative [] where
+    commute = foldr (\x acc -> x <$|(:)|*> acc) ((*:) [])
+  
+instance Commutative (Either a) where
+    commute (Right x) = Right |$> x
+    commute (Left x) = (*:) $ Left x
+
+instance Commutative ((,) a) where
+    commute (x, y) = x <|(,)|$> y
+
+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 . commuteMap (Id . f)
+
+-- | This function may be used as a value for `Data.Foldable.foldMap`
+--   in a `Foldable` instance.
+foldMapDefault :: (Commutative t, Monoid m) => (a -> m) -> t a -> m
+foldMapDefault f = getConst . commuteMap (Const . f)
+
+-- 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)
+
+
+
diff --git a/DeepControl/Monad.hs b/DeepControl/Monad.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Monad.hs
@@ -0,0 +1,333 @@
+{-|
+Module      : DeepControl.Monad
+Description : Enable deep level Monad programming.
+Copyright   : KONISHI Yohuske 2015
+License     : BSD-style (see the LICENSE file in the distribution)
+Maintainer  : ocean0yohsuke@gmail.com
+Stability   : experimental
+Portability : ---
+
+This module enables you to program in Monad for more __deeper__ level than the usual 'Control.Monad' module expresses.
+You would soon realize exactly what __/more deeper level/__ means by reading the example codes in order, which are attached on the Monadx(Monad2, Monad3, etc) classes below.
+
+Note: 
+
+    * Though this module substitutes for monad-transform consisted of elemental(without-lambda-expression) kind of monad, however, this module is unable to substitute for monad-transform consisted of complicated(tangled-with-lambda-expression) kind of monad at all.
+      So this module does not thoroughly make mlt(monad-transformer-library) unnessasary. 
+      The range in which this module is helpful is confined to the range that single Monad or Monad with Monadx series (namely Monad2, Monad3, etc) defines.
+    
+    * In my opinion the above problem 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.
+      Theoretically it might be impossible though.
+
+-}
+module DeepControl.Monad (
+    module Control.Monad,
+
+    -- * Level-0
+    -- ** bind function
+    (-<), (>-), 
+    -- ** composite function
+    (>->), (<-<),
+
+    -- * Level-1
+    -- ** bind-sequence function
+    (<<),
+
+    -- * Level-2
+    Monad2(..),
+    -- ** bind-sequence function
+    (>>~), (>-==), (->==), (>-~), (->~),
+    -- ** composite function
+    (>==>), 
+
+    -- * Level-3
+    Monad3(..),
+    -- ** bind-sequence function
+    (>>-==), (->>==), (>->==) ,(>--==),(->-==), (-->==), 
+    (>>>~), (->-~), (-->~), (>>-~), (->>~), (>->~), (>--~),
+    -- ** composite function
+    (>===>),
+
+    -- * Level-4
+    Monad4(..),
+    -- ** bind-sequence function
+    (>>>>~), 
+    -- ** composite function
+    (>====>), 
+
+    -- * Level-5
+    Monad5(..),
+    -- ** bind-sequence function
+    (>>>>>~), 
+    -- ** composite function
+    (>=====>), 
+    
+    ) where 
+
+import DeepControl.Applicative
+import Control.Monad
+
+-- -----------------------------------------------------------------------------
+-- Level-0 functions
+
+infixl 1  -<, >-
+-- | Alias for @'$'@.
+--
+-- >>> Just -< 3
+-- Just 3
+(-<) :: (a -> b) -> a -> b
+(-<) = ($)
+-- | The auguments-flipped function for @'-<'@.
+--
+-- >>> 3 >- Just
+-- Just 3
+(>-) :: a -> (a -> b) -> b
+(>-) = flip (-<)
+
+infixr 1  <-<, >->
+-- | Alias for @'.'@. 
+--
+-- >>> ((3+) <-< (2*) <-< (1+)) -< 1
+-- 7
+(<-<) :: (b -> c) -> (a -> b) -> a -> c
+(<-<) = (.)
+-- | The auguments-flipped function for @'<-<'@. 
+--
+-- >>> 1 >- ((+1) >-> (*2) >-> (+3))
+-- 7
+(>->) :: (a -> b) -> (b -> c) -> a -> c
+(>->) = flip (<-<)
+
+-- -----------------------------------------------------------------------------
+-- Level-1 functions
+
+infixr 1  <<
+-- | The auguments-flipped function for @'>>'@. 
+(<<) :: Monad m => m b -> m a -> m b 
+(<<) = flip (>>)
+
+-- -----------------------------------------------------------------------------
+-- Level-2 functions
+
+infixr 1  >==>
+infixr 1  >>~, >>==
+infixr 1  ->==, >-==
+infixr 1  ->~, >-~
+
+-- | The 'Monad2' class defines the Monad functions for level-2 types @m1 (m2 a)@; such as [[a]], Maybe [a], Either () (Maybe a), a -> [b], IO [a], etc.
+-- 
+-- >>> :{
+--  [["a","b"]] >>== \x -> 
+--  [[0],[1,2]] >>== \y -> 
+--  (**:) $ x ++ show y
+-- :}
+-- [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]]
+--
+-- >>> :{
+--  let 
+--    isJust (Just _) = True
+--    isJust _        = False
+--    pythagorean_triple :: [Maybe (Int, Int, Int)]  -- List-Maybe Monad
+--    pythagorean_triple = filter isJust $
+--        [1..10] >-== \x ->
+--        [1..10] >-== \y ->
+--        [1..10] >-== \z ->
+--        guard (x < y && x*x + y*y == z*z) ->~
+--        (**:) (x,y,z)
+--  in pythagorean_triple
+-- :}
+-- [Just (3,4,5),Just (6,8,10)]
+-- 
+-- 
+class (Monad m2) => Monad2 m2 where
+  -- | Bind function of level-2.
+  (>>==) :: (Monad m1) => m1 (m2 a) -> (a -> m1 (m2 b)) -> m1 (m2 b)
+
+-- | Composite function of level-2.
+(>==>) :: (Monad m1, Monad2 m2) => (a -> m1 (m2 b)) -> (b -> m1 (m2 c)) -> a -> m1 (m2 c)
+f >==> g = \x -> f x >>== g
+-- | Sequence function of level-2.
+(>>~) :: (Monad m1, Monad2 m2) => m1 (m2 a) -> m1 (m2 b) -> m1 (m2 b)
+m >>~ k = m >>== \_ -> k
+-- | Bind-cover function made of bind @'>>=='@ and cover @'-*'@, defined as @m >-== k = (-*) m >>== k@.
+(>-==) :: (Monad m1, Monad2 m2) => m1 a -> (a -> m1 (m2 b)) -> m1 (m2 b)
+m >-== k = (-*) m >>== k
+-- | Bind-cover function made of bind @'>>=='@ and cover @'*-'@, defined as @m >-== k = (*-) m >>== k@.
+(->==) :: (Monad m1, Monad2 m2) => m2 a -> (a -> m1 (m2 b)) -> m1 (m2 b)
+m ->== k = (*-) m >>== k
+-- | Sequence-cover function made of sequence @'>>~'@ and cover @'-*'@, defined as @m >-~ k = (-*) m >>~ k@.
+(>-~) :: (Monad m1, Monad2 m2) => m1 a -> m1 (m2 b) -> m1 (m2 b)
+m >-~ k = (-*) m >>~ k
+-- | Sequence-cover function made of sequence @'>>~'@ and cover @'*-'@, defined as @m >-~ k = (*-) m >>~ k@.
+(->~) :: (Monad m1, Monad2 m2) => m2 a -> m1 (m2 b) -> m1 (m2 b)
+m ->~ k = (*-) m >>~ k
+
+instance Monad2 Maybe where
+    mmv >>== f = 
+        mmv >>= \mv ->
+        case mv of 
+            Nothing -> (*:) Nothing
+            Just a  -> f a
+
+instance Monad2 [] where
+    mmv >>== f = 
+        mmv >>= \xs -> 
+        foldr (\x acc -> f x <$|(++)|*> acc) ((*:) []) xs
+
+instance Monad2 (Either e) where
+    mmv >>== f = 
+        mmv >>= \mv -> 
+        case mv of
+            Left l  -> (*:) (Left l)
+            Right r -> f r
+
+-- -----------------------------------------------------------------------------
+-- Level-3 functions
+
+infixr 1  >===>
+infixr 1  >>>~, >>>==
+infixr 1  >--==, ->-==, -->==, >>-==, >->==, ->>==
+infixr 1  >--~, ->-~, -->~, >>-~, >->~, ->>~
+
+-- | The 'Monad3' class defines the Monad functions for level-3 types @m1 (m2 (m3 a)@.
+-- 
+-- >>> :{
+--  let 
+--    isJust (Just _) = True
+--    isJust _        = False
+--    pythagorean_triple :: IO [Maybe (Int, Int, Int)]  -- IO-List-Maybe Monad
+--    pythagorean_triple = filter isJust |$> (
+--        [1..10] ->-== \x ->
+--        [1..10] ->-== \y ->
+--        [1..10] ->-== \z ->
+--        guard (x < y && x*x + y*y == z*z) -->~
+--        print (x,y,z) >--~
+--        (***:) (x,y,z)
+--      )
+--  in pythagorean_triple
+-- :}
+-- (3,4,5)
+-- (6,8,10)
+-- [Just (3,4,5),Just (6,8,10)]
+--
+class (Monad m3) => Monad3 m3 where
+  (>>>==) :: (Monad m1, Monad2 m2) => m1 (m2 (m3 a)) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+
+(>===>) :: (Monad m1, Monad2 m2, Monad3 m3) => (a -> m1 (m2 (m3 b))) -> (b -> m1 (m2 (m3 c))) -> a -> m1 (m2 (m3 c))
+f >===> g = \x -> f x >>>== g
+(>>>~) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 (m3 a)) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m >>>~ k = m >>>== \_ -> k
+(>--==) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m >--== k = (-**) m >>>== k
+(->-==) :: (Monad m1, Monad2 m2, Monad3 m3) => m2 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m ->-== k = (*-*) m >>>== k
+(-->==) :: (Monad m1, Monad2 m2, Monad3 m3) => m3 a -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m -->== k = (**-) m >>>== k
+(>>-==) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m >>-== k = (--*) m >>>== k
+(->>==) :: (Monad m1, Monad2 m2, Monad3 m3) => m2 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m ->>== k = (*--) m >>>== k
+(>->==) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m3 a) -> (a -> m1 (m2 (m3 b))) -> m1 (m2 (m3 b))
+m >->== k = (-*-) m >>>== k
+(>--~) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m >--~ k = (-**) m >>>~ k
+(->-~) :: (Monad m1, Monad2 m2, Monad3 m3) => m2 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m ->-~ k = (*-*) m >>>~ k
+(-->~) :: (Monad m1, Monad2 m2, Monad3 m3) => m3 a -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m -->~ k = (**-) m >>>~ k
+(>>-~) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m >>-~ k = (--*) m >>>~ k
+(->>~) :: (Monad m1, Monad2 m2, Monad3 m3) => m2 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m ->>~ k = (*--) m >>>~ k
+(>->~) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m3 a) -> m1 (m2 (m3 b)) -> m1 (m2 (m3 b))
+m >->~ k = (-*-) m >>>~ k
+
+instance Monad3 Maybe where
+    mmmv >>>== f = 
+        mmmv >>== \mv ->
+        case mv of 
+            Nothing -> (**:) Nothing
+            Just a  -> f a
+
+instance Monad3 [] where
+    mmmv >>>== f = 
+        mmmv >>== \xs -> 
+        foldr (\x acc -> f x <<$|(++)|*>> acc) ((**:) []) xs 
+
+instance Monad3 (Either e) where
+    mmmv >>>== f = 
+        mmmv >>== \mv -> 
+        case mv of
+            Left l  -> (**:) (Left l)
+            Right r -> f r
+
+-- -----------------------------------------------------------------------------
+-- Level-4 functions
+
+infixr 1  >====>
+infixr 1  >>>>~, >>>>==
+-- TODO: >>>>~
+
+class (Monad m4) => Monad4 m4 where
+  (>>>>==) :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 (m3 (m4 a))) -> (a -> m1 (m2 (m3 (m4 b)))) -> m1 (m2 (m3 (m4 b)))
+
+(>====>) :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 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, Monad2 m2, Monad3 m3, Monad4 m4) => m1 (m2 (m3 (m4 a))) -> m1 (m2 (m3 (m4 b))) -> m1 (m2 (m3 (m4 b)))
+m >>>>~ k = m >>>>== \_ -> k
+
+
+instance Monad4 Maybe where
+    mmmmv >>>>== f = 
+        mmmmv >>>== \mv ->
+        case mv of 
+            Nothing -> (***:) Nothing
+            Just a  -> f a
+
+instance Monad4 [] where
+    mmmmv >>>>== f = 
+        mmmmv >>>== \xs -> 
+        foldr (\x acc -> f x <<<$|(++)|*>>> acc) ((***:) []) xs 
+
+instance Monad4 (Either e) where
+    mmmmv >>>>== f = 
+        mmmmv >>>== \mv -> 
+        case mv of
+            Left l  -> (***:) (Left l)
+            Right r -> f r
+
+-- -----------------------------------------------------------------------------
+-- Level-5 functions
+
+infixr 1  >=====>
+infixr 1  >>>>>~, >>>>>== 
+-- TODO: >>>>>~
+
+class (Monad m5) => Monad5 m5 where
+  (>>>>>==) :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4) => m1 (m2 (m3 (m4 (m5 a)))) -> (a -> m1 (m2 (m3 (m4 (m5 b))))) -> m1 (m2 (m3 (m4 (m5 b))))
+
+(>=====>) :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 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, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 m5) => m1 (m2 (m3 (m4 (m5 a)))) -> m1 (m2 (m3 (m4 (m5 b)))) -> m1 (m2 (m3 (m4 (m5 b))))
+m >>>>>~ k = m >>>>>== \_ -> k
+
+instance Monad5 Maybe where
+    mmmmmv >>>>>== f = 
+        mmmmmv >>>>== \mv ->
+        case mv of 
+            Nothing -> (****:) Nothing
+            Just a  -> f a
+
+instance Monad5 [] where
+    mmmmmv >>>>>== f = 
+        mmmmmv >>>>== \xs -> 
+        foldr (\x acc -> f x <<<<$|(++)|*>>>> acc) ((****:) []) xs 
+
+instance Monad5 (Either e) where
+    mmmmmv >>>>>== f = 
+        mmmmmv >>>>== \mv -> 
+        case mv of
+            Left l  -> (****:) (Left l)
+            Right r -> f r
+
diff --git a/DeepControl/Monad/RWS.hs b/DeepControl/Monad/RWS.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Monad/RWS.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE MultiParamTypeClasses, 
+             FlexibleInstances #-}
+module DeepControl.Monad.RWS (
+    MonadReader(..), MonadWriter(..), MonadState(..),
+
+    RWS(..), rws, evalRWS, execRWS, 
+
+    ) where 
+
+import DeepControl.Applicative
+import DeepControl.Monad
+
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.Writer (MonadWriter(..))
+import Control.Monad.State (MonadState(..))
+
+----------------------------------------------------------------------
+-- RWS
+
+newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) }
+
+instance Functor (RWS r w s) where
+    fmap f m = RWS $ \r s ->
+        (\(a, s', w) -> (f a, s', w)) $ runRWS m r s
+instance (Monoid w) => Applicative (RWS r w s) where
+    pure a = RWS $ \_ s -> (a, s, mempty)
+    (<*>)  = ap
+instance (Monoid w) => Monad (RWS r w s) where
+    return  = (*:)
+    m >>= k = RWS $ \r s -> 
+        runRWS m r s >- \(a, s', w) ->
+        runRWS (k a) r s' >- \(b, s'',w') ->
+        (b, s'', w `mappend` w')
+instance (Monoid w) => MonadReader r (RWS r w s) where
+    ask       = RWS $ \r s -> (r, s, mempty)
+    local f m = RWS $ \r s -> runRWS m (f r) s
+instance (Monoid w) => MonadWriter w (RWS r w s) where
+    writer (a, w) = RWS $ \_ s -> (a, s, w)
+    tell w        = RWS $ \_ s -> ((),s,w)
+    listen m      = RWS $ \r s -> 
+        runRWS m r s >- \(a, s', w) ->
+        ((a, w), s', w)
+    pass m        = RWS $ \r s ->
+        runRWS m r s >- \((a, f), s', w) ->
+        (a, s', f w)
+instance (Monoid w) => MonadState s (RWS r w s) where
+    get   = RWS $ \_ s -> (s, s, mempty)
+    put s = RWS $ \_ _ -> ((), s, mempty)
+
+rws :: (r -> s -> (a, s, w)) -> RWS r w s a
+rws = RWS
+evalRWS :: RWS r w s a -> r -> s -> (a, w)
+evalRWS m r s =
+    runRWS m r s >- \(a, _, w) ->
+    (a, w)
+execRWS :: RWS r w s a -> r -> s -> (s, w)
+execRWS m r s =
+    runRWS m r s >- \(_, s', w) ->
+    (s', w)
+
+
diff --git a/DeepControl/Monad/Reader.hs b/DeepControl/Monad/Reader.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Monad/Reader.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE MultiParamTypeClasses, 
+             FlexibleInstances #-}
+module DeepControl.Monad.Reader (
+    MonadReader(..),
+    asks,
+
+    Reader(..),
+
+    ) where 
+
+import DeepControl.Applicative
+import DeepControl.Monad
+
+import Control.Monad.Reader (MonadReader(..))
+
+asks :: MonadReader r m => (r -> a) -> m a
+asks = reader
+
+----------------------------------------------------------------------
+-- Reader
+
+newtype Reader r a = Reader { runReader :: r -> a }
+
+instance Functor (Reader r) where
+    fmap f v = Reader $ \r -> 
+        f $ runReader v r 
+instance Applicative (Reader r) where
+    pure a = Reader $ \_ -> a
+    (<*>) = ap
+instance Monad (Reader r) where
+    return = (*:)
+    mv >>= f = mv >- \(Reader v) -> Reader $ \r ->
+        v r >- \a -> 
+        runReader (f a) r
+
+{-
+instance Monad2 (Reader r) where
+    -- TODO: Reader を Commutative にできていないため、これは無理
+    mmv >>== f = mmv >>= \(Reader v) -> commute $ Reader $ \r ->
+        v r >- \a ->
+        runReader |$> f a |* r
+-}  
+
+instance MonadReader r (Reader r) where
+    ask       = Reader id
+    local f m = Reader $ runReader m . f
+
+
diff --git a/DeepControl/Monad/State.hs b/DeepControl/Monad/State.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Monad/State.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE MultiParamTypeClasses,
+             FlexibleInstances,
+             UndecidableInstances #-}
+module DeepControl.Monad.State (
+    MonadState(..),
+    modify, gets,
+
+    State(..), evalState, execState, 
+
+    ) where 
+
+import DeepControl.Applicative
+import DeepControl.Monad
+
+import Control.Monad.State (MonadState(..))
+
+modify :: MonadState s m => (s -> s) -> m ()
+modify f = state $ \s -> ((), f s)
+
+gets :: MonadState s m => (s -> a) -> m a
+gets f = state $ \s -> (f s, s)
+
+----------------------------------------------------------------------
+-- State
+
+newtype State s a = State { runState :: s -> (a, s) }
+
+instance Functor (State s) where
+    fmap f v = State $ \s ->
+        (\(a, s') -> (f a, s')) $ runState v s
+instance Applicative (State s) where
+    pure a = State $ \s -> (a,s) 
+    (<*>) = ap
+instance Monad (State s) where  
+    return          = (*:)
+    (State v) >>= f = 
+        State $ \s -> 
+            v s >- \(a, s') ->
+            runState (f a) s'
+
+instance MonadState s (State s) where
+    get   = State $ \s -> (s, s)
+    put s = State $ \_ -> ((), s)
+
+evalState :: State s a -> s -> a
+evalState m s = 
+    let (a, _) = runState m s
+    in a
+execState :: State s a -> s -> s
+execState m s = 
+    let (_, s') = runState m s
+    in s'
+
+
diff --git a/DeepControl/Monad/Writer.hs b/DeepControl/Monad/Writer.hs
new file mode 100644
--- /dev/null
+++ b/DeepControl/Monad/Writer.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE MultiParamTypeClasses, 
+             FlexibleInstances #-}
+module DeepControl.Monad.Writer (
+    MonadWriter(..),
+    listens, censor,
+
+    Writer(..), execWriter,
+
+    ) where 
+
+import DeepControl.Applicative
+import DeepControl.Monad
+
+import Control.Monad.Writer (MonadWriter(..))
+
+listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b)
+listens f m = do
+    (a, w) <- listen m
+    return (a, f w)
+
+censor :: MonadWriter w m => (w -> w) -> m a -> m a
+censor f m = pass $ do
+    a <- m
+    return (a, f)
+
+----------------------------------------------------------------------
+-- Writer
+
+newtype Writer w a = Writer { runWriter :: (a, w) }
+
+instance Functor (Writer w) where
+    fmap f v = Writer $ (\(a, w) -> (f a, w)) $ (runWriter v)
+instance (Monoid w) => Applicative (Writer w) where
+    pure a = Writer $ (a, mempty)
+    (<*>) = \(Writer (f, w)) (Writer (a, w')) ->
+        Writer (f a, w' `mappend` w)
+
+instance (Monoid w) => Monad (Writer w) where
+    return   = (*:)
+    mv >>= f = 
+        mv >- \(Writer (a, w)) -> 
+        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) $ f a
+instance (Monoid w) => Monad2 (Writer w) where
+    mmv >>== f = 
+        mmv >>= \(Writer (a, w)) -> 
+        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$> f a
+instance (Monoid w) => Monad3 (Writer w) where
+    mmv >>>== f = 
+        mmv >>== \(Writer (a, w)) -> 
+        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>> f a
+instance (Monoid w) => Monad4 (Writer w) where
+    mmv >>>>== f = 
+        mmv >>>== \(Writer (a, w)) -> 
+        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>>> f a
+instance (Monoid w) => Monad5 (Writer w) where
+    mmv >>>>>== f = 
+        mmv >>>>== \(Writer (a, w)) -> 
+        (\(Writer (b, w')) -> Writer (b, w `mappend` w')) |$>>>> f a
+
+instance (Monoid w) => MonadWriter w (Writer w) where
+    writer   = Writer
+    tell w   = writer ((), w)
+    listen m = Writer $ 
+        runWriter m >- \(a, w) ->
+        ((a, w), w) 
+    pass m   = Writer $ 
+        runWriter m >- \((a, f), w) ->
+        (a, f w)
+
+execWriter :: Writer w a -> w
+execWriter m =
+    runWriter m >- \(_, w) ->
+    w
+
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2015, KONISHI Yohsuke
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of KONISHI Yohsuke nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/deepcontrol.cabal b/deepcontrol.cabal
new file mode 100644
--- /dev/null
+++ b/deepcontrol.cabal
@@ -0,0 +1,60 @@
+name:                deepcontrol
+version:             0.1.0.0
+synopsis:            Enable deeper level style of programming than the usual control provides
+description:         This module enables deeper level style of programming than the usual control provides, especially for Applicative and Monad.
+license:             BSD3
+license-file:        LICENSE
+author:              KONISHI Yohsuke
+maintainer:          ocean0yohsuke@gmail.com
+homepage:            https://github.com/ocean0yohsuke/deepcontrol
+copyright:           KONISHI Yohsuke
+category:            Control
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     DeepControl.Arrow
+                     , DeepControl.Applicative
+                     , DeepControl.Commutative
+                     , DeepControl.Monad
+                     , DeepControl.Monad.RWS
+                     , DeepControl.Monad.Reader
+                     , DeepControl.Monad.State
+                     , DeepControl.Monad.Writer
+  -- other-modules:       
+  other-extensions:    Arrows
+  build-depends:       base >=4.8 && <4.9, mtl >=2.2 && <2.3
+  --hs-source-dirs:      
+  default-language:    Haskell2010
+  Ghc-Options:         -Wall -O2
+
+Test-Suite doctest
+  Type:                 exitcode-stdio-1.0
+  Default-Language:     Haskell2010
+  HS-Source-Dirs:       test
+  Ghc-Options:          -threaded -Wall
+  Main-Is:              doctests.hs
+  Build-Depends:        base
+                      , doctest >= 0.9.3
+                      , QuickCheck >= 2.8.1
+
+Test-Suite UnitTest_Applicative
+  Type:                 exitcode-stdio-1.0
+  Default-Language:     Haskell2010
+  HS-Source-Dirs:       test
+  -- Ghc-Options:          -threaded -Wall
+  Main-Is:              UnitTest_Applicative.hs
+  Build-Depends:        base
+                      , HUnit >= 1.3.0
+                      , deepcontrol
+Test-Suite UnitTest_Monad
+  Type:                 exitcode-stdio-1.0
+  Default-Language:     Haskell2010
+  HS-Source-Dirs:       test
+  -- Ghc-Options:          -threaded -Wall
+  Main-Is:              UnitTest_Monad.hs
+  Build-Depends:        base
+                      , HUnit >= 1.3.0
+                      , deepcontrol
+
diff --git a/test/UnitTest_Applicative.hs b/test/UnitTest_Applicative.hs
new file mode 100644
--- /dev/null
+++ b/test/UnitTest_Applicative.hs
@@ -0,0 +1,179 @@
+module Main where
+import Test.HUnit
+
+import DeepControl.Applicative
+
+main :: IO ()
+main = run >> return ()
+
+-- | Run Unit-Test of this module. 
+run = runTestTT $ TestList 
+        [ TestList tLevel0
+        , TestList tLevel1
+        , TestList tLevel2
+        , TestList tLevel3
+
+        ]
+
+----------------------------------------------------------------
+-- unit test
+----------------------------------------------------------------
+
+tLevel0 = ("Level0" ~:) |$> [ 
+      TestList $ ("|>" ~:) |$> [ 
+          (1+) |> 2  ~?= 3
+        , (1:) |> [] ~?= [1]
+        , ("a"++) |> "b" ~?= "ab"
+        , (True &&) |> False ~?= False
+        , (True ||) |> False ~?= True
+        ]
+
+    , TestList $ ("<|" ~:) |$> [ 
+          1 <| (+2)  ~?= 3
+        , 1 <| (:[]) ~?= [1]
+        , "a" <| (++"b")  ~?= "ab"
+        , True <| (&& False) ~?= False
+        , True <| (|| False) ~?= True
+        ]
+
+    , TestList $ ("<| and |>" ~:) |$> [ 
+          1 <|(+)|> 2               ~?= 3
+        , 1 <|(+)|> 2 <|(-)|> 3     ~?= 0
+        , 1 <|(+)|> 2 <|(*)|> 3     ~?= 9
+
+        , 1 <|(:)|> []             ~?= [1]
+        , 1 <|(:)|> (2 <|(:)|> []) ~?= [1,2]
+
+        , "a" <|(++)|> "b"              ~?= "ab"
+        , "a" <|(++)|> "b" <|(++)|> "c" ~?= "abc"
+
+        , True <|(&&)|> False ~?= False
+        , True <|(||)|> False ~?= True
+
+        , 1 <|(,)|> 2             ~?= (1,2)
+        , 1 <|(,)|> 2 <|(,)|> 3   ~?= ((1,2),3)
+        , 1 <|(,)|> (2 <|(,)|> 3) ~?= (1,(2,3))
+        ]
+    ]
+
+tLevel1 = ("Level1" ~:) |$> [
+      (+) |$> [1] |*> [2]      ~?= [3]
+
+    , TestList $ ("|$>" ~:) |$> [ 
+          (1+) |$> [2] ~?= [3]
+        , (1:) |$> [[]] ~?= [[1]]
+        , ("a"++) |$> ["b"] ~?= ["ab"]
+        , (True &&) |$> [False] ~?= [False]
+        , (True ||) |$> [False] ~?= [True]
+    
+        , (1+) |$> [0,1,2] ~?= [1,2,3]
+        , (1+) |$> Just 0  ~?= Just 1
+        , (1+) |$> Nothing ~?= Nothing
+        , (1+) |$> Right 1  ~?= (Right 2 :: Either () Int)
+        , (1+) |$> Left ()  ~?= (Left () :: Either () Int)
+        ]
+    , TestList $ ("|*>" ~:) |$> [ 
+          [(1+)] |*> [0,1,2] ~?= [1,2,3]
+        , Just (1+) |*> Just 0  ~?= Just 1
+        , Just (1+) |*> Nothing ~?= Nothing
+        , Right (1+) |*> Right 1 ~?= (Right 2 :: Either () Int)
+        , Right (1+) |*> Left () ~?= (Left () :: Either () Int)
+
+        ]
+    , TestList $ ("<$|" ~:) |$> [ 
+          [1] <$| (+2)  ~?= [3]
+
+        , ("("++)|$> ["a","b"] <$|(++")") ~?= ["(a)", "(b)"]
+        ]
+    , TestList $ ("<$| and |*>" ~:) |$> [ 
+          [1] <$|(+)|*> [0,1,2] ~?= [1,2,3]
+        , Just 1 <$|(+)|*> Just 0  ~?= Just 1
+        , Just 1 <$|(+)|*> Nothing ~?= Nothing
+        , Right 1 <$|(+)|*> Right 1 ~?= (Right 2 :: Either () Int)
+        , Right 1 <$|(+)|*> Left () ~?= (Left () :: Either () Int)
+
+        , [1,11] <$|(+)|*> [0,1,2]              ~?= [1,2,3,11,12,13]
+        , [0,1] <$|(+)|*> [2,3] <$|(^)|*> [4,5] ~?= [16,32,81,243,81,243,256,1024]
+
+        , getZipList (ZipList ['a'..'e'] <$|(,)|*> ZipList [1..]) ~?= [('a',1),('b',2),('c',3),('d',4),('e',5)]
+
+        ]
+    , 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 (\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]
+        ]
+    , TestList $ ("|*, *|" ~:) |$> [ 
+          [1] <$|(+)|*  2           ~?= [3]
+        , 1    *|(+)|$> [2]         ~?= [3]
+
+        , [(1+)] |* 2               ~?= [3]
+        , 1 *| [(+2)]               ~?= [3]
+        , 1 *| [(+)] |* 2           ~?= [3]
+
+       , [1] <$|(+)|* 2 <$|(-)|* 3 ~?= [0]
+       , 1 *|(+)|$> [2] <$|(-)|* 3 ~?= [0]
+
+        , Just 1 <$|(,)|* 2  ~?= Just (1,2)
+        , 1 *|Just (,)|* 2 ~?= Just (1,2)
+        
+        , 1 *|[(+),(-),(*),(^)]|* 2     ~?= [3,-1,2,1]
+        ]
+
+   , TestList $ ("other" ~:) |$> [ 
+          [1] <$|(+)|> 2      ~?= [3]
+        --, [2] <*| [1] <$| (+) ~?= [3]  -- invalid form
+        , [2] <*|(+)|$> [1]   ~?= [3]
+        ]
+     ]
+
+tLevel2 = ("Level2" ~:) |$> [
+      (+) |$>> [Just 1] |*>> [Just 2]      ~?= [Just 3]
+
+    , TestList $ ("<<$| and |*>>" ~:) |$> [ 
+          [Just 1] <<$|(+)|*>> [Just 2]              ~?= [Just 3]
+        , [[1]] <<$|(+)|*>> [[2]] <<$|(-)|*>> [[3]]  ~?= [[0]]
+
+        , [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))
+        ]
+    , TestList $ ("|**, |*-, |-*, **|, *-|, -*|" ~:) |$> [ 
+          [Just 1] <<$|(+)|** 2          ~?= [Just 3]
+        , [Just 1] <<$|(+)|*- Just 2     ~?= [Just 3]
+        , [Just 1] <<$|(+)|-* [2]        ~?= [Just 3]
+        , 1      **|(+)|$>> [Just 2]     ~?= [Just 3]
+        , Just 1 *-|(+)|$>> [Just 2]     ~?= [Just 3]
+        , [1]    -*|(+)|$>> [Just 2]     ~?= [Just 3]
+        , 1 **|[Just (+)]|** 2        ~?= [Just 3]
+        , 1 **|[Just (+), Just (-), Just (*), Nothing]|** 2 ~?= [Just 3,Just (-1),Just 2,Nothing]
+        , [0,1] -*|[Just (+), Just (-), Just (*), Nothing]|*- Just 2 ~?= [Just 2,Just 3,Just (-2),Just (-1),Just 0,Just 2,Nothing,Nothing]
+
+        , [[1]] <<$|(+)|** 2 <<$|(-)|** 3    ~?= [[0]]
+        , 1 **|(+)|$>> [[2]] <<$|(-)|** 3    ~?= [[0]]
+
+
+        ]
+
+    ]
+
+tLevel3 = ("Level3" ~:) |$> [
+      (+) |$>>> Right [Just 1] |*>>> Right [Just 2]      ~?= (Right [Just 3] :: Either () [Maybe Int])
+
+    , TestList $ ("<<<$| and |*>>>" ~:) |$> [ 
+          Right [Just 1] <<<$|(+)|*>>> Right [Just 2]         ~?= (Right [Just 3] :: Either () [Maybe Int])
+        , [[[1]]] <<<$|(+)|*>>> [[[2]]] <<<$|(-)|*>>> [[[3]]] ~?= [[[0]]]
+
+        , Right [Just 1] <<<$|(,)|*>>> Right [Just 2]       ~?= (Right [Just (1,2)] :: Either () [Maybe (Int,Int)])
+        ]
+    ]
+
+
diff --git a/test/UnitTest_Monad.hs b/test/UnitTest_Monad.hs
new file mode 100644
--- /dev/null
+++ b/test/UnitTest_Monad.hs
@@ -0,0 +1,130 @@
+module Main where
+import Test.HUnit
+
+import DeepControl.Applicative
+import DeepControl.Monad
+
+import DeepControl.Monad.Writer
+import DeepControl.Monad.Reader
+
+main :: IO ()
+main = do
+    runTestTT $ TestList [
+          TestList tLevel0
+        , TestList tLevel2
+        , TestList tLevel3
+        ]
+    runTestTT tests_Level2
+    runTestTT tests_Level3
+    return ()
+
+tLevel0 = ("Level0" ~:) |$>
+    [ (3 >- Just)    ~?= (Just 3)
+    , (Just -< 3)    ~?= (Just 3)
+
+    , (1 >- (+1) >- (*2) >- (+3))     ~?= 7
+    , (1 >- ((+1) >-> (*2) >-> (+3))) ~?= 7
+    , (((3+) <-< (2*) <-< (1+)) -< 1) ~?= 7
+
+-- invalid forms
+-- ((3+) -< (2*) -< (1+) -< 1)
+    ]
+
+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])
+
+    , (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]))
+
+    , (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_Level2 :: Test
+tests_Level2 = test [ 
+      "List-List" ~: "(>>==)" ~: do
+        let actual = [["a","b"]] >>== \x ->
+                     [[0],[1,2]] >>== \y ->
+                     (**:) $ x ++ show y
+        actual @?= [["a0","b0"],["a0","b1","b2"],["a1","a2","b0"],["a1","a2","b1","b2"]]
+
+    , "List-Maybe" ~: "(>>==), (>>~)" ~: do
+        let actual = (Just |$> [1..10]) >>== \x ->
+                     (Just |$> [1..10]) >>== \y ->
+                     (Just |$> [1..10]) >>== \z -> 
+                     ((*:) $ guard (x < y && x*x + y*y == z*z)) >>~
+                     (**:) (x,y,z)
+        filter isJust actual @?= [Just (3,4,5),Just (6,8,10)]
+    , "List-Maybe" ~: "(>-==), (->~)" ~: do
+        let actual = [1..10] >-== \x ->
+                     [1..10] >-== \y ->
+                     [1..10] >-== \z -> 
+                     guard (x < y && x*x + y*y == z*z) ->~
+                     (**:) (x,y,z)
+        filter isJust actual @?= [Just (3,4,5),Just (6,8,10)]
+
+    , "(->)-Maybe" ~: do
+        let lengthM :: [Int] -> Maybe Int
+            lengthM [] = Nothing
+            lengthM xs = Just (length xs) 
+            averageM :: [Int] -> Maybe Double
+            averageM = 
+                sum >-== \s ->
+                lengthM >>== \l ->
+                (**:) $ fromIntegral s / fromIntegral l
+        averageM [10, 25, 70] @?= Just 35.0
+        averageM []           @?= Nothing
+    , "Reader-Maybe" ~: do
+        let sumR :: Reader [Int] Int
+            sumR = sum |$> ask
+            lengthRM :: Reader [Int] (Maybe Int)
+            lengthRM = Reader $ \r -> case r of
+                                        [] -> Nothing
+                                        xs -> Just (length xs) 
+            averageRM :: Reader [Int] (Maybe Double)
+            averageRM = 
+                sumR >-== \s ->
+                lengthRM >>== \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
+            factorial n | n == 0 = (*:) $ tell [0] >> return 1
+            factorial n | n > 0  = 
+                factorial (n-1) >>== \v ->
+                tell [v] ->~
+                (**:) (n * v)
+        (runWriter |$> factorial 5) @?= Just (120,[0,1,1,2,6,24])
+
+    ]
+  where
+    isJust (Just _) = True
+    isJust _        = False
+
+tests_Level3 :: Test
+tests_Level3 = test [ 
+      "IO-Maybe-Writer" ~: "(>>>==), (-->~), (*-*)" ~: do
+        let factorial :: Int -> IO (Maybe (Writer [Int] Int))
+            factorial n | n < 0  = (*-*) Nothing
+            factorial n | n == 0 = (**:) $ tell [0] >> return 1
+            factorial n | n > 0  = 
+                factorial (n-1) >>>== \v ->
+                tell [v] -->~
+                (***:) (n * v)
+        actual <- factorial 5
+        (runWriter |$> actual) @?= Just (120,[0,1,1,2,6,24])
+    ]
+
diff --git a/test/doctests.hs b/test/doctests.hs
new file mode 100644
--- /dev/null
+++ b/test/doctests.hs
@@ -0,0 +1,10 @@
+module Main where
+
+import Test.DocTest
+--import Test.QuickCheck
+
+main :: IO ()
+main = doctest [ "DeepControl/Applicative.hs"
+               , "DeepControl/Monad.hs"
+               , "DeepControl/Arrow.hs"
+               ]