flexiwrap (empty) → 0.0.1

raw patch · 24 files changed

+2654/−0 lines, 24 filesdep +basedep +data-typedep +mtlsetup-changed

Dependencies added: base, data-type, mtl, special-functors

Files

• .ghci +3/−0
• Data/Flex/Applicative.hs +21/−0
• Data/Flex/Compose.hs +281/−0
• Data/Flex/Examples/Lex/Simple.hs +43/−0
• Data/Flex/Examples/Lex/Strict.hs +319/−0
• Data/Flex/FlipT.hs +83/−0
• Data/Flex/Functor.hs +15/−0
• Data/Flex/Monad.hs +33/−0
• Data/Flex/MonadPlus.hs +18/−0
• Data/Flex/MonadState.hs +22/−0
• Data/Flex/MonadTrans.hs +16/−0
• Data/Flex/SmallCheck/Wrap.hs +51/−0
• Data/Flex/Test/Compose.hs +267/−0
• Data/Flex/Test/Wrap.hs +43/−0
• Data/Flex/Test/WrappedMonad.hs +52/−0
• Data/Flex/Utils.hs +27/−0
• Data/Flex/Wrap.hs +178/−0
• Data/Flex/WrapCTC.hs +142/−0
• Data/Flex/WrapT.hs +287/−0
• Data/Flex/WrappedMonad.hs +49/−0
• Data/Wrap.hs +626/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• flexiwrap.cabal +46/−0

@@ -0,0 +1,3 @@+let extensions= (const . return $ let version = Data.Version.versionBranch System.Info.compilerVersion in if version < [6, 6] then ":set -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances" else if version >= [6, 8] then ":set -XTypeOperators -XKindSignatures" else "") :: String -> IO String
+:def extensions extensions
+:extensions

@@ -0,0 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolymorphicComponents #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Applicative.hs,v 1.1 2010/03/10 01:56:44 dosuser Exp dosuser $
+module Data.Flex.Applicative where
+
+class FWApplicative (f :: * -> *) r | f -> r
+
+data FWDefaultApplicative = FWDefaultApplicative
+
+data FWPure t (f :: * -> *) = FWPure
+
+newtype WrapPure f = WrapPure {unwrapPure :: forall a. a -> f a}
+
+data FWCombine t (f :: * -> *) = FWCombine
+
+newtype WrapCombine f =
+    WrapCombine {unwrapCombine :: forall a b. f (a -> b) -> (f a -> f b)}
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,281 @@+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverlappingInstances #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Compose.hs,v 1.14 2010/12/04 01:40:54 dosuser Exp dosuser $
+module Data.Flex.Compose where
+
+import Control.Monad (liftM, liftM2, join, MonadPlus(..))
+import Control.Monad.Error (Error)
+import Control.Monad.Writer (Writer, tell, runWriter)
+
+import Data.Monoid (Monoid)
+
+import Data.Type.Apply
+import Data.Type.TList
+
+import Data.Flex.FlipT (FlipT(..))
+import Data.Flex.Monad (
+        FWMonad, FWReturn, FWBind,
+        WrapReturn(..), WrapBind(..), wrapReturn, wrapBind
+    )
+import Data.Flex.MonadPlus (FWMonadPlus,
+        FWMZero, WrapMZero(..),
+        FWMPlus, WrapMPlus(..)
+    )
+import Data.Flex.MonadTrans (FWMonadTrans, FWLift, WrapLift(..))
+import Data.Flex.Utils (inCompose)
+import Data.Flex.Wrap (FlexiWrap(..), FW)
+import Data.Flex.WrapCTC (FlexiWrapCTC(..), FWCTC, inFlexiWrapCTC2)
+
+newtype (f :. g) a = O {unO :: f (g a)}
+
+type O = (:.)
+
+inO :: (f (g a) -> f' (g' b)) -> ((f :. g) a -> (f' :. g') b)
+inO = inCompose unO O
+
+inO2 :: (f (g a) -> f' (g' b) -> f'' (g'' c)) ->
+    ((f :. g) a -> (f' :. g') b -> (f'' :. g'') c)
+inO2 = inCompose unO $ inCompose unO O
+
+flexiCompose :: s -> (forall b. b -> f b) -> g a -> FWCTC s O f g a
+flexiCompose _ f ga = FlexiWrapCTC . O $ f ga
+
+-- Jones/Duponcheel's composition utilities
+
+returnC :: (Monad m, Monad n) => a -> m (n a)
+returnC  = return . return
+
+liftMC :: (Monad f, Monad g) => (a -> b) -> (f (g a) -> f (g b))
+liftMC  = liftM . liftM
+
+open :: FWCTC t O m n a -> m (n a)
+open = unO . unFlexiWrapCTC
+
+close :: m (n a) -> FWCTC t O m n a
+close = FlexiWrapCTC . O
+
+fmapC :: (Monad f, Monad g) =>
+    (a -> b) -> (FWCTC t O f g a -> FWCTC t O f g b)
+fmapC f = close . liftMC f . open
+
+wrapM  :: (Monad m, Monad n) =>
+           (m (n (m (n a))) -> m (n a)) ->
+             (FWCTC t O m n (FWCTC t O m n a) -> FWCTC t O m n a)
+wrapM j = close . j . liftMC open . open
+
+-- and our own utility
+
+wrapFW :: (Monad m, Monad n) =>
+    (forall a. (m (n (m (n a))) -> m (n a))) ->
+    WrapBind (FWCTC t O m n)
+wrapFW j = wrapBind ((wrapM j .) . flip fmapC)
+
+-- Jones/Duponcheel's prod construction
+
+class (Monad m, Monad n) => PComposable m n where
+    prod :: n (m (n a)) -> m (n a)
+
+joinP :: PComposable m n => m (n (m (n a))) -> m (n a)
+joinP  = join . liftM prod
+
+instance Monad m => PComposable m Maybe where
+    prod (Just m) = m
+    prod Nothing  = return Nothing
+
+data FWCompP = FWCompP
+
+instance FWMonad (FWCTC (FWCompP :*: s) O m n) FWCompP
+
+instance PComposable m n =>
+    Apply (FWReturn t (O m n)) FWCompP (WrapReturn (FWCTC t O m n))
+  where
+    apply _ _ = wrapReturn (close . returnC)
+
+instance PComposable m n =>
+    Apply (FWBind t (O m n)) FWCompP (WrapBind (FWCTC t O m n))
+  where
+    apply _ _ = wrapFW joinP
+    -- apply _ _ = wrapBind ((wrapM joinP .) . flip fmapC)
+
+-- Jones/Duponcheel's dorp construction
+
+class (Monad m, Monad n) => DComposable m n where
+    dorp :: m (n (m a)) -> m (n a)
+
+joinD :: DComposable m n => m (n (m (n a))) -> m (n a)
+joinD  = liftM join . dorp
+
+data FWCompD = FWCompD
+
+instance FWMonad (FWCTC (FWCompD :*: s) O m n) FWCompD
+
+instance DComposable m n =>
+    Apply (FWReturn t (O m n)) FWCompD (WrapReturn (FWCTC t O m n))
+  where
+    apply _ _ = wrapReturn (close . returnC)
+
+instance DComposable m n =>
+    Apply (FWBind t (O m n)) FWCompD (WrapBind (FWCTC t O m n))
+  where
+    apply _ _ = wrapFW joinD
+    -- apply _ _ = wrapBind ((wrapM joinD .) . flip fmapC)
+
+instance Monad n => DComposable ((->)r) n where
+    dorp f r = f r >>= \g -> return (g r)
+          -- = [ g r | g <- f r ]
+
+-- Jones/Duponcheel's swap construction
+
+-- TODO: Left- and right-biased variants (FWCompS{L,R}, SComposable{L,R})
+-- to help reduce boiler-plate instances
+
+class (Monad m, Monad n) => SComposable m n where
+    swap :: n (m a) -> m (n a)
+
+joinS :: SComposable m n => m (n (m (n a))) -> m (n a)
+joinS  = liftM join . join . liftM swap
+
+data FWCompS = FWCompS
+
+instance FWMonad (FWCTC (FWCompS :*: s) O m n) FWCompS
+
+instance SComposable m n =>
+    Apply (FWReturn t (O m n)) FWCompS (WrapReturn (FWCTC t O m n))
+  where
+    apply _ _ = wrapReturn (close . returnC)
+
+instance SComposable m n =>
+    Apply (FWBind t (O m n)) FWCompS (WrapBind (FWCTC t O m n))
+  where
+    apply _ _ = wrapFW joinS
+    -- apply _ _ = wrapBind ((wrapM joinS .) . flip fmapC)
+
+instance Monad m => SComposable m [] where
+    swap []     = return []
+    swap (x:xs) = x       >>= \y  ->
+                  swap xs >>= \ys ->
+                  return (y:ys)
+             -- = [ y:ys | y<-x, ys<-swap xs ]
+
+instance (Monad m, Monoid s) => SComposable m (Writer s) where
+    swap wm = do
+        a <- ma
+        return $ do
+            tell s
+            return a
+      where
+        (ma, s) = runWriter wm
+    {-
+    swap (Writer (ma, s)) = ma >>= \a -> return (Writer (a, s))
+                    -- = [ Result s a | a <- ma ]
+    -}
+
+-- TODO: Generalise to ... what?
+-- MonadError e m => m
+-- (doesn't have a sufficiently powerful interface)
+instance (Monad m, Error e) => SComposable m (Either e) where
+    swap (Right m)      = liftM Right m
+    swap (Left msg) = return (Left msg)
+
+{-
+instance (Monad m, MonadError e n) => SComposable m n where
+    swap m = catchError n ...
+-}
+
+instance Monad m => SComposable m (FW t) where
+    swap = liftM FlexiWrap . unFlexiWrap
+
+instance Monad m => SComposable (FW t) m where
+    swap = FlexiWrap . liftM unFlexiWrap
+
+-- Resolve overlap
+instance SComposable (FW s) (FW t) where
+    swap = FlexiWrap . liftM unFlexiWrap
+
+instance Monoid s => SComposable (FW t) (Writer s) where
+    swap = FlexiWrap . liftM unFlexiWrap
+
+instance SComposable (FW s) [] where
+    swap = FlexiWrap . liftM unFlexiWrap
+
+instance Error e => SComposable (FW s) (Either e) where
+    swap = FlexiWrap . liftM unFlexiWrap
+
+data FWCompDefaults = FWCompDefaults
+
+-- MonadTrans
+
+data FWCompTrans = FWCompTrans
+
+instance FWMonadTrans (FWCTC (FWCompTrans :*: s) o f) FWCompTrans
+instance FWMonadTrans (FWCTC (FWCompDefaults :*: s) o f) FWCompTrans
+
+-- TODO: Applicative version?
+-- (but *Monad*Trans requires Monad)
+instance Monad m =>
+    Apply (FWLift (FWCTC t O m)) FWCompTrans (WrapLift (FWCTC t O m))
+  where
+    apply _ _ = WrapLift (FlexiWrapCTC . O . return)
+
+instance Monad m =>
+    Apply (FWLift (FWCTC t (FlipT O) m)) FWCompTrans
+        (WrapLift (FWCTC t (FlipT O) m))
+  where
+    apply _ _ = WrapLift (FlexiWrapCTC . FlipT . O . liftM return)
+
+-- --- MonadPlus
+
+data FWCompMonadPlus = FWCompMonadPlus
+data FWCompMonadPlusL = FWCompMonadPlusL
+data FWCompMonadPlusR = FWCompMonadPlusR
+
+instance FWMonadPlus (FWCTC (FWCompMonadPlusR :*: s) O m n) FWCompMonadPlusR
+instance FWMonadPlus (FWCTC (FWCompMonadPlus :*: s) O m n) FWCompMonadPlusR
+instance FWMonadPlus (FWCTC (FWCompDefaults :*: s) O m n) FWCompMonadPlusR
+
+instance (Monad m, MonadPlus n) =>
+    Apply (FWMZero t (O m n)) FWCompMonadPlusR (WrapMZero (FWCTC t O m n))
+  where
+    apply _ _ = WrapMZero (FlexiWrapCTC . O $ return mzero)
+
+instance (Monad m, MonadPlus n) =>
+    Apply (FWMPlus t (O m n)) FWCompMonadPlusR (WrapMPlus (FWCTC t O m n))
+  where
+    apply _ _ = WrapMPlus (inFlexiWrapCTC2 . inO2 $ liftM2 mplus)
+
+instance FWMonadPlus (FWCTC (FWCompMonadPlusL :*: s) O m n) FWCompMonadPlusL
+
+instance MonadPlus m =>
+    Apply (FWMZero t (O m n)) FWCompMonadPlusL (WrapMZero (FWCTC t O m n))
+  where
+    apply _ _ = WrapMZero (FlexiWrapCTC $ O mzero)
+
+instance MonadPlus m =>
+    Apply (FWMPlus t (O m n)) FWCompMonadPlusL (WrapMPlus (FWCTC t O m n))
+  where
+    apply _ _ = WrapMPlus (inFlexiWrapCTC2 $ inO2 mplus)
+
+-- TODO: Remove this - subsumed by FWCompMonadPlus
+-- TODO: Maybe :. m
+data FWCompMaybeMonadPlus = FWCompMaybeMonadPlus
+
+instance FWMonadPlus (FWCTC (FWCompMaybeMonadPlus :*: s) O m n)
+    FWCompMaybeMonadPlus
+
+instance Monad m =>
+    Apply (FWMZero t (O m Maybe)) FWCompMaybeMonadPlus
+        (WrapMZero (FWCTC t O m Maybe))
+  where
+    apply _ _ = WrapMZero (FlexiWrapCTC . O $ return Nothing)
+
+instance Monad m =>
+    Apply (FWMPlus t (O m Maybe)) FWCompMaybeMonadPlus
+        (WrapMPlus (FWCTC t O m Maybe))
+  where
+    apply _ _ = WrapMPlus (inFlexiWrapCTC2 . inO2 $ liftM2 mplus)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,43 @@+module Data.Flex.Examples.Lex.Simple where
+
+data Basic c = BSimple c
+	-- | range | set | ...
+    deriving Show
+
+data BSingle b = SSimple b | b `SOr` BSingle b
+    deriving Show
+
+infixr 9 `SOr`
+
+type Single c = BSingle (Basic c)
+
+data Simple f c = TSimple {
+        simpleSingle :: (Single c)
+        ,simpleNext :: f
+    }
+    deriving Show
+
+newtype Once f c = SOnce {unSOnce :: Simple f c}
+    deriving Show
+newtype Repeat f c = SRepeat {unSRepeat :: Simple f c}
+    deriving Show
+
+data Lex c a
+    = LNil
+    | LDone a
+    | LRepeat (Repeat (Lex c a) c)
+    | Once (Lex c a) c `LOr` Lex c a
+    deriving Show
+
+infixr 9 `LOr`
+
+type DiffList c = [c] -> [c]
+
+singleMatch :: Eq c => Single c -> c -> Bool
+singleMatch (SSimple c1) c2 = basicMatch c1 c2
+singleMatch (s1 `SOr` s2) c = basicMatch s1 c || singleMatch s2 c
+
+basicMatch :: Eq c => Basic c -> c -> Bool
+basicMatch (BSimple c1) c2 = c1 == c2
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,319 @@+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# OPTIONS_GHC -fcontext-stack=25 #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/Examples/Lex/RCS/Strict.hs,v 1.8 2011/02/16 00:58:48 dosuser Exp dosuser $
+module Data.Flex.Examples.Lex.Strict where
+
+import Control.Applicative (Applicative(..), (<$>), Alternative(..),
+        liftA2
+    )
+import Control.Monad (join, ap, liftM, MonadPlus(..))
+import Control.Monad.State (
+        StateT(..), MonadState(..), modify, gets, evalStateT
+    )
+import Control.Monad.Trans (MonadTrans(..))
+
+import Data.Char (ord)
+import Data.Foldable as F (Foldable(..))
+import Data.Maybe (fromJust)
+-- isJust, catMaybes,
+import Data.List (delete)
+
+import Data.Flex.Compose ((:.)(..), O,
+        FWCompP, FWCompS, FWCompDefaults, FWCompMonadPlusL
+    )
+import Data.Flex.FlipT (FlipT(..), FWFlipDefaults, FWFlipMonad)
+import Data.Flex.Wrap (FW, FlexiWrap(..))
+import Data.Flex.WrapCTC (FlexiWrapCTC(..), FWCTC)
+import Data.Flex.WrappedMonad (FWMonadApplicative, FWWrapMonad)
+import Data.Flex.WrapT (FlexiWrapT(..), FWT, inFlexiWrapT2, FWTDefaultMonadAll)
+
+import Data.Flex.Examples.Lex.Simple
+
+import Data.Type.TList
+
+import Test.QuickCheck
+
+data FWStrict = FWStrict
+
+type Strict = FW (FWStrict :*: TNil)
+
+strict :: a -> Strict a
+strict = FlexiWrap
+
+type StrictT = FWCTC
+    (FWFlipDefaults :*:
+        FWCompMonadPlusL :*: FWCompDefaults :*: FWCompS :*: TNil
+    )
+    (FlipT O) Strict
+
+strictT :: f (Strict a) -> StrictT f a
+strictT = FlexiWrapCTC . FlipT . O
+
+unStrictT :: StrictT f a -> f (Strict a)
+unStrictT = unO . unFlipT . unFlexiWrapCTC
+
+type MaybeT = FWCTC
+    (FWFlipDefaults :*: FWCompDefaults :*: FWCompP :*: TNil)
+    (FlipT O) Maybe
+
+-- maybeT :: Monad f => f (Maybe a) -> MaybeT f a
+maybeT :: f (Maybe a) -> MaybeT f a
+maybeT = FlexiWrapCTC . FlipT . O
+
+unMaybeT :: MaybeT f a -> f (Maybe a)
+unMaybeT = unO . unFlipT . unFlexiWrapCTC
+
+type StrictMaybeT f = StrictT (MaybeT f)
+
+{-
+    StrictMaybeT f x ==
+    StrictT (MaybeT f) x ==
+    FWCTC tag (FlipT O) Strict (MaybeT f) x ~
+    O (MaybeT f) Strict x ~
+    MaybeT f (Strict x) ==
+    FWCTC tag (FlipT O) Maybe f (Strict x) ~
+    O f Maybe (Strict x) ~
+    f (Maybe (Strict x))
+-}
+
+type WStateT s m =
+    FWT (FWWrapMonad :*: FWTDefaultMonadAll :*: TNil) (StateT s m)
+
+type StrictMaybeStateGen s = WStateT s (StrictMaybeT Gen)
+
+{-
+instance Monad m => Applicative (WStateT s m) where
+    pure = FlexiWrapT . return
+    (<*>) = inFlexiWrapT2 ap
+-}
+
+-- instance (MonadPlus m, Applicative (WStateT s m)) =>
+instance MonadPlus m =>
+        Alternative (WStateT s m) where
+    empty = FlexiWrapT . StateT $ \s -> flip (,) s `liftM` mzero
+    -- a <|> b = (<|>) <$> a <*> b
+    a <|> b = FlexiWrapT . StateT $ \s ->
+        runStateT (unFlexiWrapT a) s `mplus` runStateT (unFlexiWrapT b) s
+
+{-
+-- instance (Monad m, Monad (WStateT s m)) => MonadState s (WStateT s m) where
+instance Monad m => MonadState s (WStateT s m) where
+        -- and/or Monad (WStateT s m), Monad m
+    get = lift get
+    put = lift . put
+-}
+
+-- class Monad m => MonadGen m where
+class MonadGen m where
+    liftGen :: Gen a -> m a
+
+instance MonadGen Gen where
+    liftGen = id
+
+-- instance (MonadTrans t, MonadGen m, Monad (t m)) => MonadGen (t m) where
+instance (MonadTrans t, Monad m, MonadGen m) => MonadGen (t m) where
+    liftGen = lift . liftGen
+
+{-
+-- instance (MonadGen m, Monad (WStateT s m)) =>  MonadGen (WStateT s m) where
+instance (Monad m, MonadGen m) =>  MonadGen (WStateT s m) where
+    liftGen = lift . lift . liftGen
+-}
+
+class MonadMaybe m where
+    liftMaybe :: Maybe a -> m a
+
+instance MonadMaybe Maybe where
+    liftMaybe = id
+
+instance Monad m => MonadMaybe (MaybeT m) where
+    liftMaybe = maybeT . return
+
+instance (Monad m, MonadMaybe m) => MonadMaybe (StrictT m) where
+    liftMaybe = lift . liftMaybe
+
+instance (Monad m, MonadMaybe m) => MonadMaybe (WStateT s m) where
+    liftMaybe = lift . lift . liftMaybe
+
+lexAlphabet = "abcde"
+lexIndex :: Char -> Int
+lexIndex c
+    | 'a' <= c && c <= 'e' = ord c - ord 'a'
+    | otherwise = error "lexAlphabet character out of range"
+
+-- strictMaybeBasic :: (Eq c, MonadState [c] (StrictMaybeStateGen [c])) =>
+strictMaybeBasic :: Eq c =>
+    StrictMaybeStateGen [c] (Basic c)
+strictMaybeBasic = do
+    c <- join $ gets select
+    modify $ delete c
+    return $ BSimple c
+ where
+    -- select :: (Eq c, Monad (StrictMaybeStateGen [c])) =>
+    -- select :: Eq c =>
+    select ::
+        [c] -> StrictMaybeStateGen [c] c
+    select [] = liftMaybe Nothing
+    select l = liftGen $ elements l
+
+{-
+-- This clashes with any generic Arbitrary (Maybe a) instance
+instance Arbitrary (Maybe (Strict (Basic Char))) where
+    arbitrary = unMaybeT . unStrictT $ evalStateT strictMaybeBasic lexAlphabet
+    coarbitrary Nothing = variant 0
+    coarbitrary (Just (FlexiWrap (BSimple c))) = variant $ 1 + lexIndex c
+-}
+
+instance Arbitrary ((Maybe :. Strict) (Basic Char)) where
+    arbitrary = fmap O . unMaybeT . unStrictT $
+        evalStateT (unFlexiWrapT strictMaybeBasic) lexAlphabet
+    coarbitrary (O Nothing) = variant 0
+    coarbitrary (O (Just (FlexiWrap (BSimple c)))) = variant $ 1 + lexIndex c
+
+{-
+sizedStrictMaybeBSingle :: (
+        Eq c, Applicative (StrictMaybeStateGen [c]),
+        Monad (StrictMaybeStateGen [c])
+    ) =>
+-}
+sizedStrictMaybeBSingle :: Eq c => Int -> StrictMaybeStateGen [c] (Single c)
+sizedStrictMaybeBSingle 0 = SSimple <$> strictMaybeBasic
+sizedStrictMaybeBSingle n | n > 0 =
+    (SOr <$> strictMaybeBasic <*> sizedStrictMaybeBSingle (n - 1))
+    <|>
+    sizedStrictMaybeBSingle 0
+
+{-
+-- This clashes with any generic Arbitrary (Maybe a) instance
+instance Arbitrary (Maybe (Strict (Single Char))) where
+    arbitrary = sized $ unMaybeT . unStrictT .
+        flip evalStateT lexAlphabet . unFlexiWrapT . sizedStrictMaybeBSingle
+    coarbitrary Nothing = variant 0
+    coarbitrary (Just (FlexiWrap (SSimple b))) =
+        variant 1 . coarbitrary (O . Just $ strict b)
+    coarbitrary (Just (FlexiWrap (b `SOr` c))) = variant 2 .
+        coarbitrary (O . Just $ strict b) . coarbitrary (O . Just $ strict c)
+-}
+
+instance Arbitrary ((Maybe :. Strict) (Single Char)) where
+    arbitrary = fmap O . sized $ unMaybeT . unStrictT .
+        flip evalStateT lexAlphabet . unFlexiWrapT . sizedStrictMaybeBSingle
+    coarbitrary (O Nothing) = variant 0
+    coarbitrary (O (Just (FlexiWrap (SSimple b)))) =
+        variant 1 . coarbitrary (O . Just $ strict b)
+    coarbitrary (O (Just (FlexiWrap (b `SOr` c)))) = variant 2 .
+        coarbitrary (O . Just $ strict b) . coarbitrary (O . Just $ strict c)
+
+liftStrictMaybe :: (
+            MonadTrans t, MonadTrans u, Monad f, Monad (u (StrictT (MaybeT f)))
+        ) =>
+    f (Maybe (Strict a)) -> t (u (StrictT (MaybeT f))) a
+liftStrictMaybe = lift . lift . strictT . maybeT
+
+{-
+sizedStrictMaybeSimple :: (Eq c,
+        -- Arbitrary (Maybe (Strict s))
+        Arbitrary (Strict s),
+        Applicative (StrictMaybeStateGen [c]),
+        Monad (StrictMaybeStateGen [c])
+    ) =>
+-}
+sizedStrictMaybeSimple :: (Eq c,
+        -- Arbitrary (Maybe (Strict s))
+        Arbitrary (Strict s)
+    ) =>
+    Int -> StrictMaybeStateGen [c] (Simple s c)
+sizedStrictMaybeSimple n = TSimple <$> sizedStrictMaybeBSingle n2 <*>
+    liftStrictMaybe (fmap Just $ resize n2 arbitrary)
+  where n2 = n `div` 2
+
+{-
+-- This clashes with any generic Arbitrary (Maybe a) instance
+instance
+    -- Arbitrary (Maybe (Strict s))
+    Arbitrary (Strict s)
+  =>
+    Arbitrary (Maybe (Strict (Simple s Char)))
+  where
+    arbitrary = sized $ unMaybeT . unStrictT .
+        flip evalStateT lexAlphabet . sizedStrictMaybeSimple
+    coarbitrary Nothing = variant 0
+    coarbitrary (Just (FlexiWrap (TSimple b l))) = variant 1 .
+        coarbitrary (O . Just $ strict b) . coarbitrary (strict l)
+-}
+
+instance
+    Arbitrary (Strict s)
+  =>
+    Arbitrary ((Maybe :. Strict) (Simple s Char))
+  where
+    arbitrary = fmap O . sized $ unMaybeT . unStrictT .
+        flip evalStateT lexAlphabet . unFlexiWrapT . sizedStrictMaybeSimple
+    coarbitrary (O Nothing) = variant 0
+    coarbitrary (O (Just (FlexiWrap (TSimple b l)))) = variant 1 .
+        coarbitrary (O . Just $ strict b) . coarbitrary (strict l)
+
+{-
+sizedStrictMaybeLex :: (
+        Eq c, Arbitrary a,
+        -- Arbitrary (Maybe (Strict (Lex c a)))
+        Arbitrary (Strict (Lex c a)),
+        Applicative (StrictMaybeStateGen [c]),
+        Monad (StrictMaybeStateGen [c])
+    ) =>
+-}
+sizedStrictMaybeLex :: (
+        Eq c, Arbitrary a,
+        -- Arbitrary (Maybe (Strict (Lex c a)))
+        Arbitrary (Strict (Lex c a))
+    ) =>
+    Int -> StrictMaybeStateGen [c] (Lex c a)
+sizedStrictMaybeLex 0 = sequence [
+        return LNil
+        , LDone <$> liftGen arbitrary
+    ] >>= liftGen . elements
+sizedStrictMaybeLex n | n > 0 = catAlternatives [
+        LRepeat . SRepeat <$> sizedStrictMaybeSimple (n - 1)
+        , LOr . SOnce <$> sizedStrictMaybeSimple n2 <*>
+            sizedStrictMaybeLex n2
+    ] >>= select
+  where
+    n2 = n `div` 2
+    select [] = sizedStrictMaybeLex 0
+    select l = liftGen $ elements l
+
+catAlternatives :: (Foldable f, Alternative g) => f (g b) -> g [b]
+catAlternatives = F.foldr merge (pure []) where
+    merge b bs = liftA2 (:) b bs <|> bs
+
+instance Arbitrary a => Arbitrary (Strict (Lex Char a)) where
+    arbitrary = alphabetSizedStrictLex lexAlphabet
+    coarbitrary (FlexiWrap LNil) = variant 0
+    coarbitrary (FlexiWrap (LDone a)) = variant 1 . coarbitrary a
+    coarbitrary (FlexiWrap (LRepeat (SRepeat s))) = variant 2 .
+        coarbitrary (O . Just $ strict s)
+    coarbitrary (FlexiWrap (SOnce s `LOr` l)) = variant 3 .
+        coarbitrary (O . Just $ strict s) . coarbitrary (strict l)
+
+{-
+alphabetSizedStrictLex :: (
+        Eq c, Arbitrary a,
+        -- Arbitrary (Maybe (Strict (Lex c a)))
+        Arbitrary (Strict (Lex c a)),
+        Applicative (StrictMaybeStateGen [c]),
+        Monad (StrictMaybeStateGen [c])
+    ) =>
+-}
+alphabetSizedStrictLex :: (
+        Eq c, Arbitrary a,
+        -- Arbitrary (Maybe (Strict (Lex c a)))
+        Arbitrary (Strict (Lex c a))
+    ) =>
+    [c] -> Gen (Strict (Lex c a))
+alphabetSizedStrictLex alphabet = sized $ fmap fromJust .
+    unMaybeT . unStrictT . flip evalStateT alphabet .
+    unFlexiWrapT . sizedStrictMaybeLex
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,83 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/FlipT.hs,v 1.8 2010/11/27 00:41:20 dosuser Exp dosuser $
+module Data.Flex.FlipT where
+
+import Control.Monad (MonadPlus(..))
+
+import Data.Type.Apply (Apply(..))
+import Data.Type.TList ((:*:))
+
+import Data.Flex.Monad (
+        FWMonad, FWReturn, WrapReturn, wrapReturn, FWBind, WrapBind, wrapBind
+    )
+import Data.Flex.MonadPlus (FWMonadPlus,
+        FWMZero, WrapMZero(..), FWMPlus, WrapMPlus(..)
+    )
+import Data.Flex.WrapCTC (FWCTC, inFlexiWrapCTC)
+
+import Data.Flex.Utils (bindWrapper, inCompose)
+
+newtype FlipT (*.) (f :: * -> *) (g :: * -> *) a =
+    FlipT {unFlipT :: (g *. f) a}
+
+inFlipT :: ((g *. f) a -> (g' ?. f') a') ->
+    (FlipT (*.) f g a -> FlipT (?.) f' g' a')
+inFlipT = inCompose unFlipT FlipT
+
+inFlipT2 :: ((g *. f) a -> (g' ?. f') a' -> (g'' @. f'') a'') ->
+    (FlipT (*.) f g a -> FlipT (?.) f' g' a' -> FlipT (@.) f'' g'' a'')
+inFlipT2 = inCompose unFlipT inFlipT
+-- inFlipT2 = inCompose unFlipT $ inCompose unFlipT FlipT
+
+data FWFlipDefaults = FWFlipDefaults
+
+data FWFlipMonad = FWFlipMonad
+
+instance FWMonad (FWCTC (FWFlipMonad :*: s) (FlipT o) f g) FWFlipMonad
+instance FWMonad (FWCTC (FWFlipDefaults :*: s) (FlipT o) f g) FWFlipMonad
+
+instance Monad (FWCTC t o g f) =>
+    Apply (FWReturn t (FlipT o f g)) FWFlipMonad
+        (WrapReturn (FWCTC t (FlipT o) f g))
+  where
+    apply _ _ = wrapReturn (inFlexiWrapCTC FlipT . return)
+
+instance Monad (FWCTC t o g f) =>
+    Apply (FWBind t (FlipT o f g)) FWFlipMonad
+        (WrapBind (FWCTC t (FlipT o) f g))
+  where
+    apply _ _ = wrapBind (
+            bindWrapper (inFlexiWrapCTC unFlipT) (inFlexiWrapCTC FlipT) (>>=)
+        )
+
+data FWFlipMonadPlus = FWFlipMonadPlus
+
+instance FWMonadPlus (FWCTC (FWFlipMonadPlus :*: s) (FlipT o) f g)
+    FWFlipMonadPlus
+instance FWMonadPlus (FWCTC (FWFlipDefaults :*: s) (FlipT o) f g)
+    FWFlipMonadPlus
+
+instance MonadPlus (FWCTC t o g f) =>
+    Apply (FWMZero t (FlipT o f g)) FWFlipMonadPlus
+        (WrapMZero (FWCTC t (FlipT o) f g))
+  where
+    apply _ _ = WrapMZero (inFlexiWrapCTC FlipT mzero)
+
+instance MonadPlus (FWCTC t o g f) =>
+    Apply (FWMPlus t (FlipT o f g)) FWFlipMonadPlus
+        (WrapMPlus (FWCTC t (FlipT o) f g))
+  where
+    apply _ _ = WrapMPlus
+        (inCompose2R (inFlexiWrapCTC unFlipT) (inFlexiWrapCTC FlipT) mplus)
+      where
+        inCompose2R :: (forall a. p a -> q a) -> (q d -> e) ->
+            (q b -> q c -> q d) ->
+            (p b -> p c -> e)
+        inCompose2R down up = inCompose down $ inCompose down up
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,15 @@+{-# LANGUAGE ScopedTypeVariables, PolymorphicComponents #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Functor.hs,v 1.2 2010/03/12 23:46:00 dosuser Exp dosuser $
+module Data.Flex.Functor where
+
+class FWFunctor (f :: * -> *) r | f -> r
+
+data FWDefaultFunctor = FWDefaultFunctor
+
+data FWFmap t (f :: * -> *) = FWFmap
+
+newtype WrapFmap f =
+    WrapFmap {unwrapFmap :: forall a b. (a -> b) -> (f a -> f b)}
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,33 @@+{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Monad.hs,v 1.1 2010/03/10 01:57:35 dosuser Exp dosuser $
+module Data.Flex.Monad where
+
+-- import Data.Flex.Applicative (WrapPure(..))
+
+class FWMonad (m :: * -> *) r | m -> r
+
+data FWDefaultMonad = FWDefaultMonad
+
+data FWReturn t (m :: * -> *) = FWReturn
+
+newtype WrapReturn m = WrapReturn {unwrapReturn :: forall a. a -> m a}
+wrapReturn :: (forall a. a -> m a) -> WrapReturn m
+wrapReturn = WrapReturn
+{- GHC 6.6.1 can't cope with this version of unwrapReturn
+type WrapReturn = WrapPure
+wrapReturn :: (forall a. a -> m a) -> WrapReturn m
+wrapReturn = WrapPure
+unwrapReturn :: WrapReturn m -> (forall a. a -> m a)
+unwrapReturn = unwrapPure
+-}
+
+data FWBind t (m :: * -> *) = FWBind
+
+newtype WrapBind m =
+    WrapBind {unwrapBind :: forall a b. m a -> (a -> m b) -> m b}
+
+wrapBind :: (forall a b. m a -> (a -> m b) -> m b) -> WrapBind m
+wrapBind = WrapBind
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,18 @@+{-# LANGUAGE ScopedTypeVariables, PolymorphicComponents #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-- .$Header$
+module Data.Flex.MonadPlus where
+
+class FWMonadPlus (m :: * -> *) r | m -> r
+
+data FWDefaultMonadPlus = FWDefaultMonadPlus
+
+data FWMZero t (m :: * -> *) = FWMZero
+
+newtype WrapMZero m = WrapMZero {unwrapMZero :: forall a. m a}
+
+data FWMPlus t (m :: * -> *) = FWMPlus
+
+newtype WrapMPlus m = WrapMPlus {unwrapMPlus :: forall a. m a -> m a -> m a}
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,22 @@+{-# LANGUAGE ScopedTypeVariables, PolymorphicComponents #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-- .$Header$
+module Data.Flex.MonadState where
+
+class FWMonadState (m :: * -> *) r | m -> r
+
+data FWDefaultMonadState = FWDefaultMonadState
+
+data FWGet t s (m :: * -> *) = FWGet
+
+{-
+newtype WrapGet s m = WrapGet {unwrapGet :: m s}
+-}
+
+data FWPut t s (m :: * -> *) = FWPut
+
+{-
+newtype WrapPut s m = WrapPut {unwrapPut :: s -> m ()}
+-}
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,16 @@+{-# LANGUAGE ScopedTypeVariables, PolymorphicComponents #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/MonadTrans.hs,v 1.2 2010/03/12 23:46:34 dosuser Exp dosuser $
+module Data.Flex.MonadTrans where
+
+class FWMonadTrans (f :: (* -> *) -> (* -> *)) a | f -> a
+
+data FWDefaultMonadTrans = FWDefaultMonadTrans
+
+data FWLift (t :: (* -> *) -> (* -> *))
+
+newtype WrapLift t =
+    WrapLift {unwrapLift :: forall m a. Monad m => m a -> t m a}
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+-- $Header: c:/Source/Haskell/Wrapper/Data/Flex/SmallCheck/RCS/Wrap.hs,v 1.2 2010/03/13 00:11:09 dosuser Exp dosuser $
+module Data.Flex.SmallCheck.Wrap where
+
+import Test.SmallCheck
+
+{-
+import Control.Applicative ((<$>))
+
+import Data.Wrap (result, argument)
+-}
+
+import Data.Type.Apply (Apply(..))
+import Data.Type.Eq (TypeCast)
+import Data.Type.TList ((:*:), TNil)
+
+import Data.Flex.Wrap
+
+{-
+import Data.Flex.SmallCheck.Instances
+-}
+
+data X = X
+
+prop_default_Eq_is_Eq x y = (x == y) == (w x == w y) where
+    w = fWrap X :: Bool -> FW (X :*: TNil) Bool
+    types = x :: Bool
+
+data FWEqFirst = FWEqFirst
+
+instance TypeCast r FWEqFirst => FWEq (FW (FWEqFirst :*: s) a) r
+
+instance Eq a =>
+    Apply (FWEquals t (a, b)) FWEqFirst (FW t (a, b) -> FW t (a, b) -> Bool)
+  where
+    apply _ _ = (==) `on` fst . unFlexiWrap
+
+instance Eq a =>
+    Apply (FWNotEquals t (a, b)) FWEqFirst (FW t (a, b) -> FW t (a, b) -> Bool)
+  where
+    apply _ _ = (/=) `on` fst `on` unFlexiWrap
+
+prop_EqFirst_is_Eq_fst x y = (x `eqFst` y) == (w x == w y) where
+    eqFst = (==) `on` fst
+    w = FlexiWrap :: (Bool, Bool) -> FW (FWEqFirst :*: TNil) (Bool, Bool)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,267 @@+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/Test/RCS/Compose.hs,v 1.5 2010/04/24 00:59:15 dosuser Exp dosuser $
+module Data.Flex.Test.Compose where
+
+import Control.Monad (MonadPlus(..))
+import Control.Monad.Trans (lift)
+import Control.Monad.Writer (Writer)
+
+import Data.Char (chr)
+
+import Data.Type.TList ((:*:), TNil)
+
+import Data.Flex.Compose
+import Data.Flex.FlipT (FlipT(..), FWFlipMonad, FWFlipMonadPlus)
+import Data.Flex.Wrap (FW, FlexiWrap(..), fWrap)
+import Data.Flex.WrapCTC (FWCTC)
+
+chrM :: Monad m => Int -> m Char
+chrM = return . chr
+
+data Tag1 = Tag1
+type Tag1W = FW (Tag1 :*: TNil)
+
+type Tag1T = FWCTC (FWCompMonadPlus :*: FWCompTrans :*: FWCompS :*: TNil)
+    O Tag1W
+
+type M1 = Tag1T Maybe
+-- Monad
+t0 :: M1 Int
+t0 = return 65
+t1 :: M1 Int -> (Int -> M1 Char) -> M1 Char
+t1 = (>>=)
+t2 :: M1 Char
+t2 = t1 t0 $ return . chr
+
+-- MonadTrans
+t3 :: M1 Int
+t3 = lift $ Just 0
+
+-- MonadPlus
+t3a :: M1 Int
+t3a = mzero
+t3b :: M1 Int
+t3b = t3a `mplus` t0
+
+type ReaderT1 r = FWCTC (FWCompDefaults :*: FWCompD :*: TNil) O ((->) r)
+type ReaderT2 = ReaderT1 Int
+
+type M2 = ReaderT2 Maybe
+-- Monad
+t4 :: M2 Int
+t4 = return 65
+t5 :: M2 Int -> (Int -> M2 Char) -> M2 Char
+t5 = (>>=)
+t6 :: M2 Char
+t6 = t5 t4 $ return . chr
+
+-- MonadTrans
+t7 :: M2 Int
+t7 = lift $ Just 0
+
+-- MonadPlus
+t7a :: M2 Int
+t7a = mzero
+t7b :: M2 Int
+t7b = t7a `mplus` t4
+
+data Tag2 = Tag2
+type Tag2W = FW (Tag2 :*: TNil)
+
+type M3 = Tag1T Tag2W
+-- Monad
+t8 :: M3 Int
+t8 = return 65
+t9 :: M3 Int -> (Int -> M3 Char) -> M3 Char
+t9 = (>>=)
+t10 :: M3 Char
+t10 = t9 t8 $ return . chr
+
+-- MonadTrans
+t11 :: Tag2W Int
+t11 = FlexiWrap 0
+t12 :: M3 Int
+t12 = lift t11
+
+-- PComposable m Maybe
+type M4 = FWCTC (FWCompMaybeMonadPlus :*: FWCompP :*: TNil) O Tag1W Maybe
+-- Monad
+t13 :: M4 Int
+t13 = return 65
+t14 :: M4 Int -> (Int -> M4 Char) -> M4 Char
+t14 = (>>=)
+t15 :: M4 Char
+t15 = t14 t13 $ return . chr
+
+-- MonadPlus
+t15a :: M4 Int
+t15a = mzero
+t15b :: M4 Int
+t15b = t15a `mplus` t13
+
+type M5 = Tag1T []
+-- Monad
+t16 :: M5 Int
+t16 = return 65
+t17 :: M5 Int -> (Int -> M5 Char) -> M5 Char
+t17 = (>>=)
+t18 :: M5 Char
+t18 = t17 t16 $ return . chr
+
+-- MonadTrans
+t18a :: M5 Int
+t18a = lift []
+
+-- MonadPlus
+t18b :: M5 Int
+t18b = mzero
+t18c :: M5 Int
+t18c = t18b `mplus` t16
+
+type M6 = Tag1T (Either String)
+-- Monad
+t19 :: M6 Int
+t19 = return 65
+t20 :: M6 Int -> (Int -> M6 Char) -> M6 Char
+t20 = (>>=)
+t21 :: M6 Char
+t21 = t20 t19 $ return . chr
+
+-- MonadTrans
+t21a :: M6 Int
+t21a = lift $ Right 0
+
+-- MonadPlus
+t21b :: M6 Int
+t21b = mzero
+t21c :: M6 Int
+t21c = t21b `mplus` t19
+
+type M7 = Tag1T (Writer [String])
+-- Monad
+t22 :: M7 Int
+t22 = return 65
+t23 :: M7 Int -> (Int -> M7 Char) -> M7 Char
+t23 = (>>=)
+t24 :: M7 Char
+t24 = t23 t22 $ return . chr
+
+-- MonadTrans
+t25 :: M7 Int
+t25 = lift $ return 0
+
+-- Flip(ped) instances
+type MaybeT = FWCTC
+    (FWFlipMonadPlus :*: FWFlipMonad :*:
+        FWCompMonadPlus :*: FWCompTrans :*: FWCompP :*: TNil
+    )
+    (FlipT O) Maybe
+
+type M8 = MaybeT Tag1W
+-- Monad
+t26 :: M8 Int
+t26 = return 65
+t27 :: M8 Int -> (Int -> M8 Char) -> M8 Char
+t27 = (>>=)
+t28 :: M8 Char
+t28 = t27 t26 $ return . chr
+
+-- MonadTrans
+t29 :: Tag1W Int
+t29 = FlexiWrap 0
+t30 :: M8 Int
+t30 = lift t29
+
+-- MonadPlus
+t30a :: M8 Int
+t30a = mzero
+t31a :: M8 Int
+t31a = t30a `mplus` t26
+
+type ListT =
+    FWCTC (FWFlipMonad :*: FWCompTrans :*: FWCompS :*: TNil) (FlipT O) []
+
+type M9 = ListT Tag1W
+-- Monad
+t31 :: M9 Int
+t31 = return 65
+t32 :: M9 Int -> (Int -> M9 Char) -> M9 Char
+t32 = (>>=)
+t33 :: M9 Char
+t33 = t32 t31 $ return . chr
+
+-- MonadTrans
+t34 :: Tag1W Int
+t34 = return 0
+t35 :: M9 Int
+t35 = lift t34
+
+type WriterT = FWCTC (FWFlipMonad :*: FWCompTrans :*: FWCompS :*: TNil)
+    (FlipT O) (Writer [String])
+
+type M10 = WriterT Tag1W
+-- Monad
+t36 :: M10 Int
+t36 = return 65
+t37 :: M10 Int -> (Int -> M10 Char) -> M10 Char
+t37 = (>>=)
+t38 :: M10 Char
+t38 = t37 t36 chrM
+
+-- MonadTrans
+t39 :: Tag1W Int
+t39 = t34
+t40 :: M10 Int
+t40 = lift t39
+
+type EitherT = FWCTC (FWFlipMonad :*: FWCompTrans :*: FWCompS :*: TNil)
+    (FlipT O) (Either String)
+
+type M11 = EitherT Tag1W
+-- Monad
+t41 :: M11 Int
+t41 = return 65
+t42 :: M11 Int -> (Int -> M11 Char) -> M11 Char
+t42 = (>>=)
+t43 :: M11 Char
+t43 = t42 t41 chrM
+
+-- MonadTrans
+t44 :: Tag1W Int
+t44 = t34
+t45 :: M11 Int
+t45 = lift t44
+
+type Tag1FT = FWCTC (FWFlipMonad :*: FWCompTrans :*: FWCompS :*: TNil)
+    (FlipT O) Tag1W
+
+type M12 = Tag1FT Tag2W
+-- Monad
+t46 :: M12 Int
+t46 = return 65
+t47 :: M12 Int -> (Int -> M12 Char) -> M12 Char
+t47 = (>>=)
+t48 :: M12 Char
+t48 = t47 t46 chrM
+
+-- MonadTrans
+t49 :: Tag2W Int
+t49 = return 0
+t50 :: M12 Int
+t50 = lift t49
+
+type M13 = Tag1FT Maybe
+-- Monad
+t51 :: M13 Int
+t51 = return 65
+t52 :: M13 Int -> (Int -> M13 Char) -> M13 Char
+t52 = (>>=)
+t53 :: M13 Char
+t53 = t52 t51 chrM
+
+-- MonadTrans
+t54 :: Maybe Int
+t54 = return 0
+t55 :: M13 Int
+t55 = lift t54
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,43 @@+-- $Header: c:/Source/Haskell/Wrapper/Data/Flex/Test/RCS/Wrap.hs,v 1.4 2010/02/05 00:39:46 dosuser Exp dosuser $
+module Data.Flex.Test.Wrap where
+
+import Data.Flex.Wrap
+import Data.Flex.WrapT
+
+import Data.Type.TList
+
+data X = X
+
+t8 :: FW TNil ()
+t8 = fWrap TNil ()
+t9 :: FW (X :*: TNil) ()
+t9 = fWrap X ()
+t10 :: FW (X :*: TNil) ()
+t10 = fWrap (X :*: TNil) ()
+
+t11 :: FW TNil ()
+t11 = fWrap TNil t8
+t12 :: FW (X :*: TNil) ()
+t12 = fWrap TNil t9
+t13 :: FW (X :*: TNil) ()
+t13 = fWrap X t8
+t14 :: FW (X :*: TNil) ()
+t14 = fWrap (X :*: TNil) t8
+
+t15 :: FWT TNil Maybe ()
+t15 = fWrapT TNil $ Just ()
+t16 :: FWT (X :*: TNil) Maybe ()
+t16 = fWrapT X $ Just ()
+t17 :: FWT (X :*: TNil) Maybe ()
+t17 = fWrapT (X :*: TNil) $ Just ()
+
+t18 :: FWT TNil Maybe ()
+t18 = fWrapT TNil t15
+t19 :: FWT (X :*: TNil) Maybe ()
+t19 = fWrapT TNil t16
+t20 :: FWT (X :*: TNil) Maybe ()
+t20 = fWrapT X t15
+t21 :: FWT (X :*: TNil) Maybe ()
+t21 = fWrapT (X :*: TNil) t15
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts #-}
+-- .$Header$
+module Data.Flex.Test.WrappedMonad where
+
+import Control.Applicative (Applicative(..))
+
+import Test.QuickCheck (Gen, Arbitrary(..))
+
+import Data.Type.TList
+
+import Data.Flex.Utils (bindWrapper)
+import Data.Flex.WrapT (FWT, fWrapT)
+import Data.Flex.WrappedMonad
+
+t0 :: FWT (FWMonadApplicative :*: TNil) Gen Int
+t0 = fWrapT FWMonadApplicative arbitrary
+t1 :: FWT (FWMonadApplicative :*: TNil) Gen Int
+t1 = pure 0
+t2 :: FWT (FWMonadApplicative :*: TNil) Gen Int
+t2 = pure succ <*> t0
+
+newtype TestMonad m a = TM {unTM :: m a}
+
+app_prec = 10
+
+instance Show (m a) => Show (TestMonad m a) where
+    showsPrec d (TM w) = showParen (d > app_prec) $
+        showString "TM " . showsPrec (app_prec+1) w
+
+instance Monad m => Monad (TestMonad m) where
+    return = TM . return
+    (>>=) = bindWrapper unTM TM (>>=)
+
+t3 :: FWT (FWMonadFunctor :*: TNil) (TestMonad []) Int
+t3 = fWrapT FWMonadFunctor $ TM [0]
+t4 :: FWT (FWMonadFunctor :*: TNil) (TestMonad []) Int
+t4 = fmap succ t3
+t5 :: FWT (FWMonadFunctor :*: TNil) (TestMonad Maybe) Int
+t5 = fWrapT FWMonadFunctor . TM $ Just 0
+t6 :: FWT (FWMonadFunctor :*: TNil) (TestMonad Maybe) Int
+t6 = fmap succ t5
+
+t7 :: FWT (FWWrapMonad :*: TNil) (TestMonad []) Int
+t7 = fWrapT FWWrapMonad $ TM [0]
+t8 :: FWT (FWWrapMonad :*: TNil) (TestMonad []) Int
+t8 = fmap succ t7
+t9 :: FWT (FWWrapMonad :*: TNil) (TestMonad Maybe) Int
+t9 = pure 0
+t10 :: FWT (FWWrapMonad :*: TNil) (TestMonad Maybe) Int
+t10 = pure succ <*> t9
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,27 @@+{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Utils.hs,v 1.1 2010/11/26 23:54:58 dosuser Exp dosuser $
+module Data.Flex.Utils (inCompose, inCompose2, bindWrapper) where
+
+circumpose :: (c -> d) -> (a -> b) -> (b -> c) -> (a -> d)
+circumpose left right = (left .) . (. right)
+
+inCompose :: (a -> b) -> (c -> d) -> (b -> c) -> (a -> d)
+inCompose = flip circumpose
+
+inCompose2 :: (forall a. f a -> a) -> (d -> e) ->
+    (b -> c -> d) -> (f b -> f c -> e)
+inCompose2 unwrap wrap = inCompose unwrap $ inCompose unwrap wrap
+
+result :: (b -> c) -> (a -> b) -> (a -> c)
+result = (.)
+
+-- Utility function to construct (>>=) for a target monad <t> from the (>>=)
+-- for an implementation monad <i>
+-- Parameters:
+--   wrap:   function from target monad to implementation monad (t a -> i a)
+--   unwrap: vice versa (i a -> t a)
+bindWrapper :: (forall q. f q -> g q) -> (d -> e) -> (g a -> (c -> g b) -> d) ->
+    f a -> (c -> f b) -> e
+bindWrapper wrap unwrap = inCompose wrap $ inCompose (result wrap) unwrap
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,178 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Wrap.hs,v 1.13 2010/04/24 00:47:40 dosuser Exp dosuser $
+module Data.Flex.Wrap where
+
+import Control.Applicative (Applicative(..))
+    -- , (<$>), liftA2, Alternative(..))
+
+import Data.Foldable as F (Foldable(..))
+import qualified Data.Traversable as T (Traversable(..))
+
+import Data.Type.Apply (Apply(..))
+import Data.Type.Eq (TypeCast)
+import Data.Type.TList ((:*:), TNil)
+
+import Data.Flex.Utils (inCompose, inCompose2)
+
+-- begin FlexiWrap
+
+newtype FlexiWrap s a = FlexiWrap {unFlexiWrap :: a}
+
+type FW = FlexiWrap
+
+flexiWrap :: s -> a -> FW s a
+flexiWrap _ = FlexiWrap
+
+inFlexiWrap :: (a -> b) -> (FW s a -> FW s b)
+inFlexiWrap = inCompose unFlexiWrap FlexiWrap
+
+inFlexiWrap2 :: (a -> b -> c) -> (FW s a -> FW s b -> FW s c)
+-- inFlexiWrap2 = inCompose unFlexiWrap $ inCompose unFlexiWrap FlexiWrap
+inFlexiWrap2 = inCompose2 unFlexiWrap FlexiWrap
+
+-- TODO: Use flexible instance machinery
+
+instance Functor (FW t) where
+    fmap = inFlexiWrap
+
+instance Applicative (FW t) where
+    pure = FlexiWrap
+    (<*>) = inFlexiWrap . unFlexiWrap
+
+instance F.Foldable (FW t) where
+    foldr f z (FlexiWrap a) = f a z
+
+instance T.Traversable (FW t) where
+    traverse = (fmap FlexiWrap .) . (. unFlexiWrap)
+    sequenceA = fmap FlexiWrap . unFlexiWrap
+
+instance Monad (FW t) where
+    return = FlexiWrap
+    (>>=) = flip (. unFlexiWrap)
+
+-- append <s> and <t> to produce <u>
+-- <s> may or may not be terminated by TNil
+-- if so, it does not appear in the result
+class FWNormAppend s t u | s t -> u
+
+instance FWNormAppend TNil t t
+
+instance FWNormAppend s t u => FWNormAppend (x :*: s) t (x :*: u)
+
+instance TypeCast u (x :*: t) => FWNormAppend x t u
+
+-- class FWrap w a b where
+class FWrap w a b | w a -> b where
+    fWrap :: w -> a -> b
+
+class FWIsWrapped a r | a -> r
+
+data FWAlreadyWrapped = FWAlreadyWrapped
+data FWNewWrapper = FWNewWrapper
+
+data FWFWrap s a = FWFWrap
+
+instance FWIsWrapped (FW s a) FWAlreadyWrapped
+instance TypeCast r FWNewWrapper => FWIsWrapped a r
+
+instance Apply (FWFWrap u a) FWNewWrapper (a -> FW u a) where
+    apply _ _ = FlexiWrap
+instance Apply (FWFWrap u (FW s a)) FWAlreadyWrapped (FW s a -> FW u a) where
+    apply _ _ = FlexiWrap . unFlexiWrap
+
+data FWTag
+
+instance Apply FWTag (FW t a) t
+instance TypeCast r TNil => Apply FWTag a r
+
+instance forall a b s t u w. (
+        Apply FWTag a t,
+        FWNormAppend s t u,
+        FWIsWrapped a w,
+        Apply (FWFWrap u a) w (a -> FW u b)
+    ) =>
+    FWrap s a (FW u b)
+  where
+    fWrap _ = apply (undefined :: FWFWrap u a) (undefined :: w)
+
+{-
+instance FWNormAppend s t u => FWrap s (FW t a) (FW u a) where
+    fWrap _ (FlexiWrap a) = FlexiWrap a
+
+instance FWNormAppend s TNil u => FWrap s a (FW u a) where
+    fWrap _ = FlexiWrap
+-}
+
+{-
+instance FWrap TNil (FW s a) (FW s a) where
+    fWrap _ = id
+
+instance FWrap s (FW t a) (FW u a) =>
+        FWrap (w :*: s) (FW t a) (FW (w :*: u) a) where
+    fWrap _ (FlexiWrap a) = FlexiWrap a
+
+instance TypeCast t (w :*: s) => FWrap w (FW s a) (FW t a) where
+    fWrap _ (FlexiWrap a) = FlexiWrap a
+
+{-
+instance FWrap w (FW s a) (FW (w :*: s) a) where
+    fWrap _ (FlexiWrap a) = FlexiWrap a
+-}
+
+{-
+instance TypeCast r (FW TNil a) => FWrap TNil a r where
+    fWrap _ = FlexiWrap
+-}
+
+instance FWrap TNil a (FW TNil a) where
+    fWrap _ = FlexiWrap
+
+instance FWrap s a (FW t a) => FWrap (x :*: s) a (FW (x :*: t) a) where
+    fWrap _ = FlexiWrap
+
+instance FWrap w a (FW (w :*: TNil) a) where
+    fWrap _ = FlexiWrap
+-}
+
+infixl 8 `on`
+on :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
+(op `on` f) x y = f x `op` f y
+
+class FWEq a r | a -> r
+
+data FWDefaultEq = FWDefaultEq
+
+data FWEquals t a = FWEquals
+
+data FWNotEquals t a = FWNotEquals
+
+-- default instance
+instance TypeCast r FWDefaultEq => FWEq (FW t a) r
+
+instance FWEq (FW s a) r => FWEq (FW (x :*: s) a) r
+
+instance Eq a => Apply (FWEquals t a) FWDefaultEq (FW t a -> FW t a -> Bool)
+  where
+    apply _ _ = (==) `on` unFlexiWrap
+
+instance Eq a => Apply (FWNotEquals t a) FWDefaultEq (FW t a -> FW t a -> Bool)
+  where
+    apply _ _ = (/=) `on` unFlexiWrap
+
+instance forall t a r. (Apply (FWEquals t a) r (FW t a -> FW t a -> Bool),
+            Apply (FWNotEquals t a) r (FW t a -> FW t a -> Bool),
+            FWEq (FW t a) r
+        ) =>
+        Eq (FW t a) where
+    (==) = apply (undefined :: FWEquals t a) (undefined :: r)
+    (/=) = apply (undefined :: FWNotEquals t a) (undefined :: r)
+
+-- end FlexiWrap
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,142 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/WrapCTC.hs,v 1.4 2010/12/01 00:24:20 dosuser Exp dosuser $
+module Data.Flex.WrapCTC where
+
+import Control.Monad (MonadPlus(..))
+import Control.Monad.Trans (MonadTrans(..))
+
+import Data.Type.Apply (Apply(..))
+import Data.Type.Eq (TypeCast)
+import Data.Type.TList ((:*:))
+
+import Data.Flex.Functor (FWFunctor, FWFmap, WrapFmap(..))
+import Data.Flex.Monad (FWMonad,
+        FWReturn, WrapReturn, wrapReturn, unwrapReturn,
+        FWBind, WrapBind(..), wrapBind
+    )
+import Data.Flex.MonadPlus (FWMonadPlus,
+        FWMZero, WrapMZero(..),
+        FWMPlus, WrapMPlus(..)
+    )
+import Data.Flex.MonadTrans (
+        FWMonadTrans,
+        -- FWDefaultMonadTrans,
+        FWLift, WrapLift(..)
+    )
+
+import Data.Flex.Utils (inCompose, bindWrapper)
+
+newtype FlexiWrapCTC s o (f :: * -> *) (g :: * -> *) a =
+    FlexiWrapCTC {unFlexiWrapCTC :: o f g a}
+
+type FWCTC = FlexiWrapCTC
+
+flexiWrapCTC :: s -> o f g a -> FWCTC s o f g a
+flexiWrapCTC _ = FlexiWrapCTC
+
+inFlexiWrapCTC :: (o f g a -> o' f' g' a') ->
+    (FWCTC s o f g a -> FWCTC s o' f' g' a')
+inFlexiWrapCTC = inCompose unFlexiWrapCTC FlexiWrapCTC
+
+inFlexiWrapCTC2 :: (o f g a -> o' f' g' a' -> o'' f'' g'' a'') ->
+    (FWCTC s o f g a -> FWCTC s o' f' g' a' -> FWCTC s o'' f'' g'' a'')
+inFlexiWrapCTC2 = inCompose unFlexiWrapCTC $
+    inCompose unFlexiWrapCTC FlexiWrapCTC
+
+-- Functor definitions
+
+data FWCTCDefaultFunctor = FWCTCDefaultFunctor
+
+-- default instance
+instance TypeCast r FWCTCDefaultFunctor => FWFunctor (FWCTC t o f g) r
+
+-- deferred instance
+instance FWFunctor (FWCTC s o f g) r => FWFunctor (FWCTC (x :*: s) o f g) r
+
+instance Functor (o f g) =>
+    Apply (FWFmap t (o f g)) FWCTCDefaultFunctor (WrapFmap (FWCTC t o f g))
+  where
+    apply _ _ = WrapFmap (inFlexiWrapCTC . fmap)
+
+instance forall t o f g r. (FWFunctor (FWCTC t o f g) r,
+            Apply (FWFmap t (o f g)) r (WrapFmap (FWCTC t o f g))
+        ) =>
+    Functor (FWCTC t o f g)
+  where
+    fmap = unwrapFmap $ apply (undefined :: FWFmap t (o f g)) (undefined :: r)
+
+-- Monad definitions
+
+data FWCTCDefaultMonad = FWCTCDefaultMonad
+
+-- default instance
+instance TypeCast r FWCTCDefaultMonad => FWMonad (FWCTC t o m n) r
+
+-- deferred instance
+instance FWMonad (FWCTC s o m n) r => FWMonad (FWCTC (x :*: s) o m n) r
+
+instance Monad (o m n) =>
+    Apply (FWReturn t (o m n)) FWCTCDefaultMonad (WrapReturn (FWCTC t o m n))
+  where
+    apply _ _ = wrapReturn (FlexiWrapCTC . return)
+
+instance Monad (o m n) =>
+    Apply (FWBind t (o m n)) FWCTCDefaultMonad (WrapBind (FWCTC t o m n))
+  where
+    apply _ _ = wrapBind (bindWrapper unFlexiWrapCTC FlexiWrapCTC (>>=))
+
+instance forall t o m n r. (
+            Apply (FWReturn t (o m n)) r (WrapReturn (FWCTC t o m n)),
+            Apply (FWBind t (o m n)) r (WrapBind (FWCTC t o m n)),
+            FWMonad (FWCTC t o m n) r
+        ) =>
+        Monad (FWCTC t o m n) where
+    return = unwrapReturn $
+        apply (undefined :: FWReturn t (o m n)) (undefined :: r)
+    (>>=) = unwrapBind $ apply (undefined :: FWBind t (o m n)) (undefined :: r)
+
+-- --- MonadPlus definitions
+
+instance FWMonadPlus (FWCTC s o m n) r => FWMonadPlus (FWCTC (t :*: s) o m n) r
+
+instance forall t o m n r. (
+        Monad (FWCTC t o m n),
+        FWMonadPlus (FWCTC t o m n) r,
+        Apply (FWMZero t (o m n)) r (WrapMZero (FWCTC t o m n)),
+        Apply (FWMPlus t (o m n)) r (WrapMPlus (FWCTC t o m n))
+    ) =>
+    MonadPlus (FWCTC t o m n)
+  where
+    mzero = unwrapMZero $
+        apply (undefined :: (FWMZero t (o m n))) (undefined :: r)
+    mplus = unwrapMPlus $
+        apply (undefined :: (FWMPlus t (o m n))) (undefined :: r)
+
+-- MonadTrans definitions
+
+{-
+-- No default instances -- the kinds below don't work out
+-- default instance
+instance TypeCast r FWDefaultMonadTrans => FWMonadTrans (FWCTC t o) r
+
+instance Apply (FWLift (FWCTC s o)) FWDefaultMonadTrans (WrapLift (FWCTC s o))
+  where
+    apply _ _ = WrapLift FlexiWrapCTC
+-}
+
+-- deferred instance
+instance FWMonadTrans (FWCTC s o f) r => FWMonadTrans (FWCTC (x :*: s) o f) r
+
+instance forall s o f r. (
+        Apply (FWLift (FWCTC s o f)) r (WrapLift (FWCTC s o f)),
+        FWMonadTrans (FWCTC s o f) r
+    ) => MonadTrans (FWCTC s o f) where
+    lift = unwrapLift $
+        apply (undefined :: FWLift (FWCTC s o f)) (undefined :: r)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,287 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/WrapT.hs,v 1.9 2010/12/01 00:37:45 dosuser Exp dosuser $
+module Data.Flex.WrapT where
+
+import Control.Applicative (Applicative(..))
+import Control.Monad.Trans (MonadTrans(..))
+import Control.Monad.State (MonadState(..))
+
+import Data.Type.Apply (Apply(..))
+import Data.Type.Eq (TypeCast)
+import Data.Type.TList ((:*:), TNil)
+
+import Data.Flex.Utils (inCompose, bindWrapper)
+
+import Data.Flex.Applicative (FWApplicative,
+        FWPure, WrapPure(..),
+        FWCombine, WrapCombine(..)
+    )
+import Data.Flex.Functor (FWFunctor, FWFmap, WrapFmap(..))
+import Data.Flex.MonadTrans (
+        FWMonadTrans, FWDefaultMonadTrans, FWLift, WrapLift(..)
+    )
+import Data.Flex.Monad (FWMonad,
+        FWReturn, WrapReturn, wrapReturn, unwrapReturn,
+        FWBind, WrapBind(..), wrapBind
+    )
+
+import Data.Flex.MonadState (FWMonadState, FWGet, FWPut)
+import Data.Flex.Wrap (FWAlreadyWrapped, FWNewWrapper, FWNormAppend)
+
+-- begin FlexiWrapT
+
+newtype FlexiWrapT s f a = FlexiWrapT {unFlexiWrapT :: f a}
+
+type FWT = FlexiWrapT
+
+flexiWrapT :: s -> f a -> FWT s f a
+flexiWrapT _ = FlexiWrapT
+
+inFlexiWrapT :: (f a -> g b) -> (FWT s f a -> FWT s g b)
+inFlexiWrapT = inCompose unFlexiWrapT FlexiWrapT
+
+inFlexiWrapT2 :: (f a -> g b -> h c) ->
+    (FWT s f a -> FWT s g b -> FWT s h c)
+inFlexiWrapT2 = inCompose unFlexiWrapT $ inCompose unFlexiWrapT FlexiWrapT
+
+asFlexiWrapT :: (FWT s f a -> FWT s g b) -> (f a -> g b)
+asFlexiWrapT = inCompose FlexiWrapT unFlexiWrapT
+
+-- --- Functor definitions
+
+data FWTDefaultFunctor = FWTDefaultFunctor
+
+-- default instance
+instance TypeCast r FWTDefaultFunctor => FWFunctor (FWT t f) r
+
+-- deferred instance
+instance FWFunctor (FWT s f) r => FWFunctor (FWT (x :*: s) f) r
+
+instance Functor f =>
+    Apply (FWFmap t f) FWTDefaultFunctor (WrapFmap (FWT t f))
+  where
+    apply _ _ = WrapFmap (inFlexiWrapT . fmap)
+
+instance forall t f r. (FWFunctor (FWT t f) r,
+            Apply (FWFmap t f) r (WrapFmap (FWT t f))
+        ) =>
+    Functor (FWT t f)
+  where
+    fmap = unwrapFmap $ apply (undefined :: FWFmap t f) (undefined :: r)
+
+{-
+instance Functor f => Functor (FWT s f) where
+    fmap = inFlexiWrapT . fmap
+-}
+
+-- --- Applicative definitions
+
+data FWTDefaultApplicative = FWTDefaultApplicative
+
+-- default instance
+instance TypeCast r FWTDefaultApplicative => FWApplicative (FWT t f) r
+
+-- deferred instance
+instance FWApplicative (FWT s f) r =>
+    FWApplicative (FWT (x :*: s) f) r
+
+instance Applicative f =>
+    Apply (FWPure t f) FWTDefaultApplicative (WrapPure (FWT t f))
+  where
+    apply _ _ = WrapPure (FlexiWrapT . pure)
+
+instance Applicative f =>
+    Apply (FWCombine t f) FWTDefaultApplicative (WrapCombine (FWT t f))
+  where
+    apply _ _ = WrapCombine (inFlexiWrapT2 (<*>))
+
+instance forall t f r. (Apply (FWPure t f) r (WrapPure (FWT t f)),
+            Apply (FWCombine t f) r (WrapCombine (FWT t f)),
+            FWApplicative (FWT t f) r,
+            Functor (FWT t f)
+        ) =>
+        Applicative (FWT t f) where
+    pure = unwrapPure $ apply (undefined :: FWPure t f) (undefined :: r)
+    (<*>) = unwrapCombine $ apply (undefined :: FWCombine t f) (undefined :: r)
+
+{-
+instance Applicative f => Apply FWPure t (WrapPure (FWT t f)) where
+    apply _ _ = WrapPure $ FlexiWrapT . pure
+
+instance Applicative f => Apply FWCombine t (WrapCombine (FWT t f)) where
+    apply _ _ = WrapCombine $ inFlexiWrapT2 (<*>)
+
+instance (Apply FWPure t (WrapPure f), Apply FWCombine t (WrapCombine f)) =>
+        Applicative (FWT t f) where
+    pure = unwrapPure $ apply FWPure (undefined :: t)
+    (<*>) = unwrapCombine $ apply FWCombine (undefined :: t)
+-}
+
+
+{-
+instance FWrap TNil (FWT s f a) (FWT s f a) where
+    fWrap _ = id
+
+instance FWrap s (FWT t f a) (FWT u f a) =>
+        FWrap (w :*: s) (FWT t f a) (FWT (w :*: u) f a) where
+    fWrap _ (FlexiWrapT a) = FlexiWrapT a
+
+instance FWrap w (FWT s f a) (FWT (w :*: s) f a) where
+    fWrap _ (FlexiWrapT a) = FlexiWrapT a
+
+instance FWrap TNil (f a) (FWT TNil f a) where
+    fWrap _ = FlexiWrapT
+
+instance FWrap s (f a) (FWT t f a) => FWrap (x :*: s) (f a) (FWT (x :*: t) f a) where
+    fWrap _ = FlexiWrapT
+
+instance FWrap w (f a) (FWT (w :*: TNil) f a) where
+    fWrap _ = FlexiWrapT
+-}
+
+-- --- Monad definitions
+
+data FWTDefaultMonad = FWTDefaultMonad
+
+data FWTDefaultMonadAll = FWTDefaultMonadAll
+
+-- default instance
+instance TypeCast r FWTDefaultMonad => FWMonad (FWT t m) r
+
+-- explicit instances
+instance FWMonad (FWT (FWTDefaultMonad :*: s) m) FWTDefaultMonad
+instance FWMonad (FWT (FWTDefaultMonadAll :*: s) m) FWTDefaultMonad
+
+-- deferred instance
+instance FWMonad (FWT s m) r => FWMonad (FWT (x :*: s) m) r
+
+instance Monad m =>
+    Apply (FWReturn t m) FWTDefaultMonad (WrapReturn (FWT t m))
+  where
+    apply _ _ = wrapReturn (FlexiWrapT . return)
+
+instance Monad m =>
+    Apply (FWBind t m) FWTDefaultMonad (WrapBind (FWT t m))
+  where
+    apply _ _ = wrapBind (bindWrapper unFlexiWrapT FlexiWrapT (>>=))
+
+instance forall t m r. (Apply (FWReturn t m) r (WrapReturn (FWT t m)),
+            Apply (FWBind t m) r (WrapBind (FWT t m)),
+            FWMonad (FWT t m) r
+        ) =>
+        Monad (FWT t m) where
+    return = unwrapReturn $
+        apply (undefined :: FWReturn t m) (undefined :: r)
+    (>>=) = unwrapBind $ apply (undefined :: FWBind t m) (undefined :: r)
+
+-- MonadState
+
+data FWTDefaultMonadState = FWTDefaultMonadState
+
+-- default instance
+instance TypeCast r FWTDefaultMonadState => FWMonadState (FWT t m) r
+
+-- explicit instances
+instance FWMonadState (FWT (FWTDefaultMonadState :*: s) m) FWTDefaultMonadState
+instance FWMonadState (FWT (FWTDefaultMonadAll :*: s) m) FWTDefaultMonadState
+
+-- deferred instance
+instance FWMonadState (FWT s m) r => FWMonadState (FWT (x :*: s) m) r
+
+instance MonadState s m =>
+    Apply (FWGet t s m) FWTDefaultMonadState (FWT t m s)
+  where
+    apply _ _ = FlexiWrapT get
+
+instance MonadState s m =>
+    Apply (FWPut t s m) FWTDefaultMonadState (s -> FWT t m ())
+  where
+    apply _ _ = FlexiWrapT . put
+
+class FwtMonadState s m | m -> s where
+    fwtGet :: m s
+    fwtPut :: s -> m ()
+
+instance forall t s m r. (
+            -- Monad (FWT t m),
+            MonadState s m,
+            Apply (FWGet t s m) r (FWT t m s),
+            Apply (FWPut t s m) r (s -> FWT t m ()),
+            FWMonadState (FWT t m) r
+        ) =>
+        FwtMonadState s (FWT t m) where
+    fwtGet = apply (undefined :: FWGet t s m) (undefined :: r)
+    fwtPut = apply (undefined :: FWPut t s m) (undefined :: r)
+
+instance (Monad (FWT t m), FwtMonadState s (FWT t m)) =>
+    MonadState s (FWT t m)
+  where
+    get = fwtGet
+    put = fwtPut
+
+-- MonadTrans
+
+-- default instance
+instance TypeCast r FWDefaultMonadTrans => FWMonadTrans (FWT t) r
+
+-- deferred instance
+instance FWMonadTrans (FWT s) r => FWMonadTrans (FWT (x :*: s)) r
+
+instance Apply (FWLift (FWT s)) FWDefaultMonadTrans (WrapLift (FWT s)) where
+    apply _ _ = WrapLift FlexiWrapT
+
+instance forall s r. (
+        Apply (FWLift (FWT s)) r (WrapLift (FWT s)),
+        FWMonadTrans (FWT s) r
+    ) => MonadTrans (FWT s) where
+    lift = unwrapLift $ apply (undefined :: FWLift (FWT s)) (undefined :: r)
+
+-- --- FWrapT
+
+class FWrapT w a b | w a -> b where
+    fWrapT :: w -> a -> b
+
+data FWTagT
+
+instance Apply FWTagT (FWT t f a) t
+instance TypeCast r TNil => Apply FWTagT a r
+
+class FWCon a (f :: * -> *) | a -> f
+
+instance FWCon (FWT t f a) f
+instance TypeCast (r a) (f a) => FWCon (f a) r
+
+class FWIsWrappedT a r | a -> r
+
+instance FWIsWrappedT (FWT s f a) FWAlreadyWrapped
+instance TypeCast r FWNewWrapper => FWIsWrappedT a r
+
+data FWFWrapT s (f :: * -> *) a = FWFWrapT
+
+instance Apply (FWFWrapT u f (f a)) FWNewWrapper (f a -> FWT u f a) where
+    apply _ _ = FlexiWrapT
+instance Apply (FWFWrapT u f (FWT s f a)) FWAlreadyWrapped
+            (FWT s f a -> FWT u f a)
+  where
+    apply _ _ = FlexiWrapT . unFlexiWrapT
+
+instance forall a b f s t u w. (
+        Apply FWTagT a t,
+        FWCon a f,
+        FWNormAppend s t u,
+        FWIsWrappedT a w,
+        Apply (FWFWrapT u f a) w (a -> FWT u f b)
+    ) =>
+    FWrapT s a (FWT u f b)
+  where
+    fWrapT _ = apply (undefined :: FWFWrapT u f a) (undefined :: w)
+
+-- end FlexiWrapT
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/WrappedMonad.hs,v 1.2 2010/02/10 00:26:03 dosuser Exp dosuser $
+module Data.Flex.WrappedMonad where
+
+import Control.Monad (liftM, ap)
+
+import Data.Type.Apply
+import Data.Type.TList
+
+import Data.Flex.Applicative (FWApplicative,
+        FWPure, WrapPure(..),
+        FWCombine, WrapCombine(..)
+    )
+import Data.Flex.Functor (FWFunctor, FWFmap, WrapFmap(..))
+import Data.Flex.WrapT (inFlexiWrapT,
+        FlexiWrapT(..), FWT, inFlexiWrapT2,
+    )
+
+data FWWrapMonad = FWWrapMonad
+
+data FWMonadFunctor = FWMonadFunctor
+data FWMonadApplicative = FWMonadApplicative
+
+instance FWFunctor (FWT (FWWrapMonad :*: s) f) FWMonadFunctor
+
+instance FWFunctor (FWT (FWMonadFunctor :*: s) f) FWMonadFunctor
+
+instance Monad m => Apply (FWFmap t m) FWMonadFunctor (WrapFmap (FWT t m)) where
+    apply _ _ = WrapFmap (inFlexiWrapT . liftM)
+
+instance FWApplicative (FWT (FWWrapMonad :*: s) f) FWMonadApplicative
+
+instance FWApplicative (FWT (FWMonadApplicative :*: s) f) FWMonadApplicative
+
+-- instance (Functor m, Monad m) =>
+instance Monad m =>
+    Apply (FWPure t m) FWMonadApplicative (WrapPure (FWT t m))
+  where
+    apply _ _ = WrapPure (FlexiWrapT . return)
+
+-- instance (Functor m, Monad m) =>
+instance Monad m =>
+    Apply (FWCombine t m) FWMonadApplicative (WrapCombine (FWT t m))
+  where
+    apply _ _ = WrapCombine (inFlexiWrapT2 ap)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,626 @@+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
+-- .$Header: c:/Source/Haskell/Wrapper/Data/RCS/Wrap.hs,v 1.1 2010/03/12 23:41:16 dosuser Exp dosuser $
+module Data.Wrap (
+    Wrapper(..),
+    circumpose,
+    inCompose, inCompose2,
+    inWrapping, inWrapping2,
+    traverseWrapping, foldWrapping, foldWrapper,
+    inWrapper, inWrapper2,
+    asWrapped, asWrapped2,
+    Wrap(..),
+    InnerWrapT(..), OuterWrapT(..),
+    inInnerWrapT, inInnerWrapT2,
+    inOuterWrapT, inOuterWrapT2,
+    fromInnerWrapT, mFromInnerWrapT, fromOuterWrapT,
+    toInnerWrapT, mToInnerWrapT, toOuterWrapT,
+    asInnerWrapT, mAsInnerWrapT, asOuterWrapT,
+    asInnerWrapT2, mAsInnerWrapT2, asOuterWrapT2,
+    -- traverseInnerWrapT, traverseOuterWrapT
+    -- traverseWrapT
+    traverseWrapper, sequenceWrapper,
+    bindWrapper, contWrapper, catchWrapper, fixWrapper,
+    readerWrapper, writerWrapper,
+    result, argument
+) where
+
+import Control.Applicative (Applicative(..), Alternative(..), (<$>))
+-- (<$>), liftA2, Alternative(..))
+import Control.Compose (Cofunctor(..))
+import Control.Monad (MonadPlus(..), liftM)
+import Control.Monad.Cont (MonadCont(..))
+import Control.Monad.Error (MonadError(..))
+import Control.Monad.Fix (MonadFix(..))
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.State(MonadState(..))
+import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
+import Control.Monad.Writer (MonadWriter(..))
+-- lift, 
+
+import Data.Foldable as F (Foldable(..))
+-- import Data.Generics (Data, Typeable2(..), mkTyCon, mkTyConApp)
+import Data.Monoid (Monoid(..))
+import qualified Data.Traversable as T (Traversable(..))
+
+import Test.QuickCheck (Arbitrary(..))
+
+class Wrapper f where
+    wrap :: a -> f a
+    unwrap :: f a -> a
+
+circumpose :: (c -> d) -> (a -> b) -> (b -> c) -> (a -> d)
+circumpose left right = (left .) . (. right)
+
+-- inCompose :: (f b -> b) -> (c -> d) -> (b -> c) -> (f b -> d)
+inCompose :: (a -> b) -> (c -> d) -> (b -> c) -> (a -> d)
+-- inCompose unwrap wrap = (wrap .) . (. unwrap)
+inCompose = flip circumpose
+
+-- inCompose2 :: (a -> b) -> (c -> d) -> (b -> b -> c) -> (a -> a -> d)
+inCompose2 :: (forall a. f a -> a) -> (d -> e) ->
+    (b -> c -> d) -> (f b -> f c -> e)
+inCompose2 unwrap wrap = inCompose unwrap $ inCompose unwrap wrap
+-- inCompose2 unwrap wrap = (inCompose unwrap wrap .) . (. unwrap)
+
+inWrapping :: (f a -> a) -> (b -> c) -> (a -> b) -> f a -> c
+-- inWrapping unwrap wrap = circumpose wrap unwrap
+-- inWrapping = flip circumpose
+inWrapping = inCompose
+
+inWrapping2 :: (forall a. f a -> a) -> (d -> e) ->
+    (b -> c -> d) -> (f b -> f c -> e)
+inWrapping2 unwrap wrap = inWrapping unwrap $ inWrapping unwrap wrap
+
+{-
+traverseWrapping :: Functor g => (f a -> a) -> (b -> c) -> (a -> g b) ->
+    (f a -> g c)
+-}
+traverseWrapping :: Functor f => (a -> b) -> (c -> d) ->
+    (b -> f c) -> (a -> f d)
+traverseWrapping unwrap wrap = inCompose unwrap $ fmap wrap
+
+inWrapper :: Wrapper f => (a -> b) -> f a -> f b
+inWrapper = inWrapping unwrap wrap
+-- inWrapper = (wrap .) . (. unwrap)
+
+inWrapper2 :: Wrapper f => (a -> b -> c) -> f a -> f b -> f c
+inWrapper2 = inWrapping2 unwrap wrap
+
+asWrapped :: (Wrap f a -> Wrap f b) -> (f a -> f b)
+asWrapped = inCompose Wrapped unWrapped
+
+asWrapped2 :: (Wrap f a -> Wrap f b -> Wrap f c) -> (f a -> f b -> f c)
+asWrapped2 = inCompose Wrapped asWrapped
+
+{-
+asWrapped :: Wrapper f => (f a -> f b) -> (a -> b)
+asWrapped = inCompose wrap unwrap
+
+asWrapped2 :: Wrapper f => (f a -> f b -> f c) -> (a -> b -> c)
+asWrapped2 = inCompose wrap asWrapped
+-}
+
+newtype Wrap f a = Wrapped {unWrapped :: f a}
+    deriving (Eq, Ord, Monoid)
+    -- , Show, Read)
+    -- Functor, Applicative, Monad
+    -- Foldable, Traversable
+    -- Monoid
+    -- Arbitrary
+    -- Data, Typeable
+    -- CoMonad
+    -- but NOT
+    -- Cofunctor
+    -- Alternative, MonadPlus
+    -- MonadTrans, MonadState, MonadIO, ...
+
+app_prec = 10
+
+instance Show (f a) => Show (Wrap f a) where
+    showsPrec d (Wrapped w) = showParen (d > app_prec) $
+        showString "Wrapped " . showsPrec (app_prec+1) w
+
+instance Read (f a) => Read (Wrap f a) where
+    readsPrec d r = readParen
+        (d > app_prec)
+        (\r -> [(Wrapped m, t) |
+            ("Wrapped", s) <- lex r,
+            (m, t) <- readsPrec (app_prec+1) s
+        ])
+        r
+
+instance Wrapper f => Wrapper (Wrap f) where
+    wrap = Wrapped . wrap
+    unwrap = unwrap . unWrapped
+
+instance Wrapper f => Functor (Wrap f) where
+    fmap = inWrapper
+
+instance Wrapper f => Applicative (Wrap f) where
+    pure = wrap
+    (<*>) = inWrapper . unwrap
+
+instance Wrapper f => F.Foldable (Wrap f) where
+    foldr f z = flip f z . unwrap
+
+instance Wrapper f => T.Traversable (Wrap f) where
+    traverse = traverseWrapping unwrap wrap
+    -- traverse = inWrapping unwrap $ fmap wrap
+    -- traverse = (fmap wrap .) . (. unwrap)
+    sequenceA = fmap wrap . unwrap
+
+instance Wrapper f => Monad (Wrap f) where
+    return = wrap
+    (>>=) = flip (. unwrap)
+
+instance (Wrapper f, Arbitrary a) => Arbitrary (Wrap f a) where
+    arbitrary = wrap <$> arbitrary
+    coarbitrary = coarbitrary . unwrap
+
+-- Utility function to construct (>>=) for a target monad <t> from the (>>=)
+-- for an implementation monad <i>
+-- Parameters:
+--   wrap:   function from target monad to implementation monad (t a -> i a)
+--   unwrap: vice versa (i a -> t a)
+bindWrapper :: (forall a. f a -> g a) -> (d -> e) -> (g a -> (c -> g b) -> d) ->
+    f a -> (c -> f b) -> e
+bindWrapper wrap unwrap = inCompose wrap $ inCompose (result wrap) unwrap
+
+newtype InnerWrapT f g a = InnerWrapT {runInnerWrapT :: g (Wrap f a)}
+    deriving (Eq, Ord, Monoid)
+    -- , Show, Read)
+    -- deriving (Functor, Applicative, Monad, MonadTrans)
+    -- Alternative, MonadPlus
+    -- MonadState, MonadIO, ...
+    -- Foldable, Traversable
+    -- Cofunctor
+    -- Monoid
+    -- Arbitrary
+    -- Data, Typeable
+    -- CoMonad
+
+newtype OuterWrapT f g a = OuterWrapT {runOuterWrapT :: Wrap f (g a)}
+    deriving (Eq, Ord, Monoid)
+    -- , Show, Read)
+    -- deriving (Functor, Applicative, Foldable, T.Traversable, Monad,
+    -- MonadTrans)
+    -- Alternative, MonadPlus
+    -- MonadState, MonadIO, ...
+    -- Cofunctor, CoMonad
+    -- Monoid
+    -- Arbitrary
+    -- Data, Typeable
+
+inInnerWrapT :: (g (Wrap f a) -> g (Wrap f b)) ->
+    InnerWrapT f g a -> InnerWrapT f g b
+inInnerWrapT = circumpose InnerWrapT runInnerWrapT
+
+inInnerWrapT2 :: (g (Wrap f a) -> g (Wrap f b) -> g (Wrap f c)) ->
+    InnerWrapT f g a -> InnerWrapT f g b -> InnerWrapT f g c
+inInnerWrapT2 = circumpose inInnerWrapT runInnerWrapT
+
+inOuterWrapT :: (Wrap f (g a) -> Wrap f (g b)) ->
+    OuterWrapT f g a -> OuterWrapT f g b
+inOuterWrapT = circumpose OuterWrapT runOuterWrapT
+
+inOuterWrapT2 :: (Wrap f (g a) -> Wrap f (g b) -> Wrap f (g c)) ->
+    OuterWrapT f g a -> OuterWrapT f g b -> OuterWrapT f g c
+inOuterWrapT2 = circumpose inOuterWrapT runOuterWrapT
+
+fromInnerWrapT :: Functor g => InnerWrapT f g a -> g (f a)
+fromInnerWrapT = fmap unWrapped . runInnerWrapT
+
+fromOuterWrapT :: OuterWrapT f g a -> f (g a)
+fromOuterWrapT = unWrapped . runOuterWrapT
+
+mFromInnerWrapT :: Monad g => InnerWrapT f g a -> g (f a)
+mFromInnerWrapT = liftM unWrapped . runInnerWrapT
+
+toInnerWrapT :: Functor g => g (f a) -> InnerWrapT f g a
+toInnerWrapT = InnerWrapT . fmap Wrapped
+
+toOuterWrapT :: f (g a) -> OuterWrapT f g a
+toOuterWrapT = OuterWrapT . Wrapped
+
+mToInnerWrapT :: Monad g => g (f a) -> InnerWrapT f g a
+mToInnerWrapT = InnerWrapT . liftM Wrapped
+
+asInnerWrapT :: Functor g => (InnerWrapT f g a -> InnerWrapT f g b) ->
+    g (f a) -> g (f b)
+asInnerWrapT = circumpose fromInnerWrapT toInnerWrapT
+-- asInnerWrapT = inCompose (InnerWrapT . fmap Wrapped) fromInnerWrapT
+
+asOuterWrapT :: (OuterWrapT f g a -> OuterWrapT f g b) ->
+    f (g a) -> f (g b)
+asOuterWrapT = circumpose fromOuterWrapT toOuterWrapT
+
+mAsInnerWrapT :: Monad g => (InnerWrapT f g a -> InnerWrapT f g b) ->
+    g (f a) -> g (f b)
+mAsInnerWrapT = circumpose mFromInnerWrapT mToInnerWrapT
+-- mAsInnerWrapT = inCompose (InnerWrapT . liftM Wrapped) mFromInnerWrapT
+
+asInnerWrapT2 :: Functor g =>
+    (InnerWrapT f g a -> InnerWrapT f g b -> InnerWrapT f g c) ->
+    g (f a) -> g (f b) -> g (f c)
+asInnerWrapT2 = circumpose asInnerWrapT toInnerWrapT
+
+asOuterWrapT2 :: (OuterWrapT f g a -> OuterWrapT f g b -> OuterWrapT f g c) ->
+    f (g a) -> f (g b) -> f (g c)
+asOuterWrapT2 = circumpose asOuterWrapT toOuterWrapT
+
+mAsInnerWrapT2 :: Monad g =>
+    (InnerWrapT f g a -> InnerWrapT f g b -> InnerWrapT f g c) ->
+    g (f a) -> g (f b) -> g (f c)
+mAsInnerWrapT2 = circumpose mAsInnerWrapT mToInnerWrapT
+
+instance Show (g (Wrap f a)) => Show (InnerWrapT f g a) where
+    showsPrec d (InnerWrapT w) = showParen (d > app_prec) $
+        showString "InnerWrapT " . showsPrec (app_prec+1) w
+
+instance Read (g (Wrap f a)) => Read (InnerWrapT f g a) where
+    readsPrec d r = readParen
+        (d > app_prec)
+        (\r -> [(InnerWrapT m, t) |
+            ("InnerWrapT", s) <- lex r,
+            (m, t) <- readsPrec (app_prec+1) s
+        ])
+        r
+
+instance Show (f (g a)) => Show (OuterWrapT f g a) where
+    showsPrec d (OuterWrapT w) = showParen (d > app_prec) $
+        showString "OuterWrapT " . showsPrec (app_prec+1) w
+
+instance Read (f (g a)) => Read (OuterWrapT f g a) where
+    readsPrec d r = readParen
+        (d > app_prec)
+        (\r -> [(OuterWrapT m, t) |
+            ("OuterWrapT", s) <- lex r,
+            (m, t) <- readsPrec (app_prec+1) s
+        ])
+        r
+
+instance (Wrapper f, Functor g) => Functor (InnerWrapT f g) where
+    fmap = inInnerWrapT . fmap . inWrapper
+
+instance (Wrapper f, Functor g) => Functor (OuterWrapT f g) where
+    fmap = inOuterWrapT . inWrapper . fmap
+
+instance (Wrapper f, Cofunctor g) => Cofunctor (InnerWrapT f g) where
+    -- cofmap h = InnerWrapT . cofmap (fmap h) . runInnerWrapT
+    -- cofmap h = inInnerWrapT $ cofmap $ fmap h
+    cofmap = inInnerWrapT . cofmap . fmap
+
+-- cofmapCF h (O gf) = O (cofmap (fmap h) gf)
+
+instance (Wrapper f, Cofunctor g) => Cofunctor (OuterWrapT f g) where
+    cofmap = inOuterWrapT . fmap . cofmap
+
+-- cofmapFC = inO.fmap.cofmap
+
+instance (Wrapper f, Applicative g) => Applicative (InnerWrapT f g) where
+    pure = InnerWrapT . pure . wrap
+    (<*>) = inInnerWrapT2 $ (<*>) . fmap (<*>)
+    -- (<*>) = inInnerWrapT2 $ inCompose2 (fmap unwrap) (fmap wrap) (<*>)
+    {-
+    (<*>) :: Wrap f (a -> b) -> Wrap f a -> Wrap f b
+    fmap (<*>) :: g (Wrap f (a -> b)) -> g (Wrap f a -> Wrap f b)
+    (<*>) . fmap (<*>) :: g (Wrap f (a -> b)) -> g (Wrap f a) -> g (Wrap f b)
+    -}
+
+instance (Wrapper f, Applicative g) => Applicative (OuterWrapT f g) where
+    pure = OuterWrapT . wrap . pure
+    (<*>) = inOuterWrapT2 $ (<*>) . fmap (<*>)
+    {-
+    (<*>) :: g (a -> b) -> g a -> g b
+    fmap (<*>) :: Wrap f (g (a -> b)) -> Wrap f (g a -> g b)
+    (<*>) . fmap (<*>) :: Wrap f (g (a -> b)) -> Wrap f (g a) -> Wrap f (g b)
+    -}
+
+instance (Wrapper f, Alternative g) => Alternative (InnerWrapT f g) where
+    empty = InnerWrapT empty
+    (<|>) = inInnerWrapT2 (<|>)
+
+instance (Wrapper f, Alternative g) => Alternative (OuterWrapT f g) where
+    empty = OuterWrapT $ wrap empty
+    (<|>) = inOuterWrapT2 $ inWrapper2 (<|>)
+
+result = (.)
+argument = flip (.)
+
+foldWrapping :: (Foldable f, Foldable g) => (a -> b -> b) -> b -> f (g a) -> b
+foldWrapping f z = flip F.foldr z . flip $ F.foldr f
+
+foldWrapper :: (Foldable f, Foldable g) => (c -> f (g a)) ->
+    (a -> b -> b) -> b -> c -> b
+-- foldWrapper = flip flip foldWrapping $ result . result . argument
+foldWrapper = flip (result . result . argument) foldWrapping
+-- foldWrapper = result . result . argument `flip` foldWrapping
+
+instance (Wrapper f, Foldable g) => Foldable (InnerWrapT f g) where
+    foldr = foldWrapper runInnerWrapT
+    -- foldr = (result . result . argument) runInnerWrapT foldWrapping
+    -- foldr f z = foldWrapping f z . runInnerWrapT
+    -- foldr f z = F.foldr (flip $ F.foldr f) z . runInnerWrapT
+
+instance (Wrapper f, Foldable g) => Foldable (OuterWrapT f g) where
+    foldr = foldWrapper runOuterWrapT
+    -- foldr = (result . result . argument) runOuterWrapT foldWrapping
+    -- foldr f z = foldWrapping f z . runOuterWrapT
+    -- foldr f z = F.foldr (flip $ F.foldr f) z . runOuterWrapT
+
+traverseInnerWrapT :: Functor h => (g (Wrap f a) -> h (g' (Wrap f' b))) ->
+    InnerWrapT f g a -> h (InnerWrapT f' g' b)
+traverseInnerWrapT = traverseWrapping runInnerWrapT InnerWrapT
+-- traverseInnerWrapT = (fmap InnerWrapT .) . (. runInnerWrapT)
+
+traverseWrapT :: (T.Traversable t, Applicative f) =>
+    ((t a -> f (t b)) -> c) -> (a -> f b) -> c
+traverseWrapT wrapper mapper = wrapper $ T.sequenceA . fmap mapper
+
+traverseWrapper :: (T.Traversable t, T.Traversable u, Applicative f) =>
+    ((t (u a) -> f (t (u b))) -> c) -> (a -> f b) -> c
+traverseWrapper wrapper = traverseWrapT wrapper . T.traverse
+
+sequenceWrapper :: (T.Traversable t, T.Traversable u, Applicative f) =>
+    ((t (u (f a)) -> f (t (u a))) -> c) -> c
+sequenceWrapper wrapper = traverseWrapT wrapper T.sequenceA
+
+instance (Wrapper f, T.Traversable g) => T.Traversable (InnerWrapT f g) where
+    traverse = traverseWrapper traverseInnerWrapT
+    -- traverse = traverseWrapT traverseInnerWrapT . T.traverse
+    -- traverse f = traverseWrapT traverseInnerWrapT $ T.traverse f
+    -- traverse f = traverseInnerWrapT $ T.sequenceA . fmap (T.traverse f)
+    {-
+    traverse f = fmap InnerWrapT . T.sequenceA .
+        fmap (T.traverse f) . runInnerWrapT
+    -}
+    {-
+    InnerWrapT f g a
+    -> runInnerWrapT ->
+    g (Wrap f a)
+    -> fmap (traverse f) ->
+    g (h (Wrap f b))
+    -> sequenceA ->
+    h (g (Wrap f b))
+    -> fmap InnerWrapT ->
+    h (InnerWrapT f g b)
+    -}
+    sequenceA = sequenceWrapper traverseInnerWrapT
+    -- sequenceA = traverseWrapT traverseInnerWrapT T.sequenceA
+    -- sequenceA = traverseInnerWrapT $ T.sequenceA . fmap T.sequenceA
+    {-
+    sequenceA = fmap InnerWrapT . T.sequenceA .
+        fmap T.sequenceA . runInnerWrapT
+    -}
+    {-
+    InnerWrapT f g (h a)
+    -> runInnerWrapT ->
+    g (Wrap f (h a))
+    -> fmap sequenceA ->
+    g (h (Wrap f a))
+    -> sequenceA ->
+    h (g (Wrap f a))
+    -> fmap InnerWrapT ->
+    h (InnerWrapT f g a)
+    -}
+
+traverseOuterWrapT :: Functor h => (Wrap f (g a) -> h (Wrap f' (g' b))) ->
+    OuterWrapT f g a -> h (OuterWrapT f' g' b)
+traverseOuterWrapT = traverseWrapping runOuterWrapT OuterWrapT
+-- traverseOuterWrapT = (fmap OuterWrapT .) . (. runOuterWrapT)
+
+instance (Wrapper f, T.Traversable g) => T.Traversable (OuterWrapT f g) where
+    traverse = traverseWrapper traverseOuterWrapT
+    {-
+    traverse f = fmap OuterWrapT . T.sequenceA .
+        fmap (T.traverse f) . runOuterWrapT
+    -}
+    {-
+    OuterWrapT f g a
+    -> runOuterWrapT ->
+    Wrap f (g a)
+    -> fmap (traverse f) ->
+    Wrap f (h (g b))
+    -> sequenceA ->
+    h (Wrap f (g b))
+    -> fmap OuterWrapT ->
+    h (OuterWrapT f g b)
+    -}
+    sequenceA = sequenceWrapper traverseOuterWrapT
+    {-
+    sequenceA = fmap OuterWrapT . T.sequenceA .
+        fmap T.sequenceA . runOuterWrapT
+    -}
+    {-
+    OuterWrapT f g (h a)
+    -> runOuterWrapT ->
+    Wrap f (g (h a))
+    -> fmap sequenceA ->
+    Wrap f (h (g a))
+    -> sequenceA ->
+    h (Wrap f (g a))
+    -> fmap OuterWrapT ->
+    h (OuterWrapT f g a)
+    -}
+
+instance (Wrapper f, Monad g) => Monad (InnerWrapT f g) where
+    return = InnerWrapT . return . wrap
+    a >>= f = InnerWrapT $ runInnerWrapT a >>= runInnerWrapT . f . unwrap
+
+instance (Wrapper f, Monad g) => Monad (OuterWrapT f g) where
+    return = OuterWrapT . wrap . return
+    a >>= f = OuterWrapT . wrap $
+        unwrap (runOuterWrapT a) >>= unwrap . runOuterWrapT . f
+
+instance (Wrapper f, MonadPlus g) => MonadPlus (InnerWrapT f g) where
+    mzero = InnerWrapT mzero
+    mplus = inInnerWrapT2 mplus
+
+instance (Wrapper f, MonadPlus g) => MonadPlus (OuterWrapT f g) where
+    mzero = OuterWrapT $ wrap mzero
+    mplus = inOuterWrapT2 $ inWrapper2 mplus
+
+instance Wrapper f => MonadTrans (InnerWrapT f) where
+    lift = InnerWrapT . liftM wrap
+
+instance Wrapper f => MonadTrans (OuterWrapT f) where
+    lift = OuterWrapT . wrap
+
+instance (Wrapper f, MonadState s g) => MonadState s (InnerWrapT f g) where
+    get = lift get
+    put = lift . put
+
+instance (Wrapper f, MonadState s g) => MonadState s (OuterWrapT f g) where
+    get = lift get
+    put = lift . put
+
+instance (Wrapper f, MonadIO g) => MonadIO (InnerWrapT f g) where
+    liftIO = lift . liftIO
+
+instance (Wrapper f, MonadIO g) => MonadIO (OuterWrapT f g) where
+    liftIO = lift . liftIO
+
+{-
+contWrapper :: (b -> d) -> (e -> c) ->
+    (((a -> b) -> c) -> b) -> (((a -> d) -> e) -> d)
+-}
+contWrapper :: (forall b. m b -> n b) -> (n c -> m c) ->
+    (((a -> m b) -> m c) -> m d) -> (((a -> n b) -> n c) -> n d)
+contWrapper lift unlift = circumpose lift . circumpose unlift $ result lift
+{-
+contWrapper lift unlift = ((argument $ circumpose unlift (result lift)) .
+        result lift
+    )
+contWrapper lift unlift = ((argument $ inCompose (result lift) unlift) .
+        result lift
+    )
+contWrapper lift unlift = ((argument $
+            argument (result lift) . result unlift) .
+        result lift
+    )
+contWrapper lift unlift = ((argument $
+            (argument . result) lift . result unlift) .
+        result lift
+    )
+contWrapper lift unlift = ((argument . argument . result) lift .
+        (argument . result) unlift .
+        result lift
+    )
+-}
+
+unliftInner :: (Wrapper f, Monad g) => InnerWrapT f g a -> g a
+unliftInner = liftM unwrap . runInnerWrapT
+
+innerWrapper :: (Wrapper f, Monad g) => (
+        (forall a. g a -> InnerWrapT f g a) ->
+        (InnerWrapT f g a -> g a) ->
+        b
+    ) -> b
+innerWrapper w = w lift unliftInner
+
+instance (Wrapper f, MonadCont g) => MonadCont (InnerWrapT f g) where
+    callCC = innerWrapper contWrapper callCC
+    -- callCC = contWrapper lift unliftInner callCC
+    -- callCC = contWrapper lift (liftM unwrap . runInnerWrapT) callCC
+    {-
+    callCC = ((argument . argument . result) lift .
+            (argument . result) (liftM unwrap . runInnerWrapT) .
+            result lift
+        ) callCC
+    -}
+
+unliftOuter :: Wrapper f => OuterWrapT f g a -> g a
+unliftOuter = unwrap . runOuterWrapT
+
+outerWrapper :: (Wrapper f, Monad g) => (
+        (forall a. g a -> OuterWrapT f g a) ->
+        (OuterWrapT f g a -> g a) ->
+        b
+    ) -> b
+outerWrapper w = w lift unliftOuter
+
+instance (Wrapper f, MonadCont g) => MonadCont (OuterWrapT f g) where
+    callCC = outerWrapper contWrapper callCC
+    -- callCC = contWrapper lift unliftOuter callCC
+    -- callCC = contWrapper lift (unwrap . runOuterWrapT) callCC
+    {-
+    callCC = ((argument . argument . result) lift .
+            (argument . result) (unwrap . runOuterWrapT) .
+            result lift
+        ) callCC
+    -}
+
+{-
+catchWrapper :: (m a -> n a) -> (n a -> m a) ->
+    (m a -> (e -> m a) -> m a) -> (n a -> (e -> n a) -> n a)
+-}
+catchWrapper :: (a -> b) -> (b -> a) ->
+    (a -> (e -> a) -> a) -> (b -> (e -> b) -> b)
+catchWrapper lift unlift = inCompose unlift . circumpose lift $ result unlift
+
+instance (Wrapper f, MonadError e g) => MonadError e (InnerWrapT f g) where
+    throwError = lift . throwError
+    catchError = innerWrapper catchWrapper catchError
+    -- catchError = catchWrapper lift unliftInner catchError
+    {-
+    catchError = (inCompose unliftInner . circumpose lift $ result unliftInner)
+        catchError
+    -}
+
+instance (Wrapper f, MonadError e g) => MonadError e (OuterWrapT f g) where
+    throwError = lift . throwError
+    catchError = outerWrapper catchWrapper catchError
+    -- catchError = catchWrapper lift unliftOuter catchError
+    {-
+    catchError = (inCompose unliftOuter . circumpose lift $ result unliftOuter)
+        catchError
+    -}
+
+fixWrapper :: (m a -> n a) -> (n a -> m a) ->
+    ((a -> m a) -> m a) -> ((a -> n a) -> n a)
+fixWrapper lift unlift = circumpose lift $ result unlift
+
+instance (Wrapper f, MonadFix g) => MonadFix (InnerWrapT f g) where
+    mfix = innerWrapper fixWrapper mfix
+    -- mfix = fixWrapper lift unliftInner mfix
+
+instance (Wrapper f, MonadFix g) => MonadFix (OuterWrapT f g) where
+    mfix = outerWrapper fixWrapper mfix
+    -- mfix = fixWrapper lift unliftOuter mfix
+
+readerWrapper :: (m a -> n a) -> (n a -> m a) ->
+    ((r -> r) -> m a -> m a) -> ((r -> r) -> n a -> n a)
+readerWrapper lift unlift = result $ inCompose unlift lift
+
+instance (Wrapper f, MonadReader r g) => MonadReader r (InnerWrapT f g) where
+    ask = lift ask
+    local = innerWrapper readerWrapper local
+
+instance (Wrapper f, MonadReader r g) => MonadReader r (OuterWrapT f g) where
+    ask = lift ask
+    local = outerWrapper readerWrapper local
+
+writerWrapper :: (m b -> n b) -> (n a -> m a) ->
+    (m a -> m b) -> (n a -> n b)
+writerWrapper = circumpose
+
+instance (Wrapper f, MonadWriter w g) => MonadWriter w (InnerWrapT f g) where
+    tell = lift . tell
+    listen = innerWrapper writerWrapper listen
+    pass = innerWrapper writerWrapper pass
+
+instance (Wrapper f, MonadWriter w g) => MonadWriter w (OuterWrapT f g) where
+    tell = lift . tell
+    listen = outerWrapper writerWrapper listen
+    pass = outerWrapper writerWrapper pass
+
+instance (Wrapper f, Functor g, Arbitrary (g a)) =>
+        Arbitrary (InnerWrapT f g a) where
+    arbitrary = InnerWrapT . fmap wrap <$> arbitrary
+    coarbitrary = coarbitrary . fmap unwrap . runInnerWrapT
+
+instance (Wrapper f, Arbitrary (g a)) => Arbitrary (OuterWrapT f g a) where
+    arbitrary = OuterWrapT . wrap <$> arbitrary
+    coarbitrary = coarbitrary . unwrap . runOuterWrapT
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

@@ -0,0 +1,30 @@+Copyright Iain Alexander 2010.
+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 Iain Alexander 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.

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,46 @@+Name:            flexiwrap
+Version:         0.0.1
+Cabal-version:   >= 1.2.3
+Build-Type:      Simple
+Synopsis:        Flexible wrappers
+Description:     MPTC/FD framework using multi-purpose wrappers
+                 to direct instance selection
+Category:        Data
+License:         BSD3
+License-File:    LICENSE
+Author:          Iain Alexander <ia@stryx.demon.co.uk>
+Maintainer:      Iain Alexander <ia@stryx.demon.co.uk>
+Build-Type:      Simple
+Extra-source-files:   Data/Flex/SmallCheck/Wrap.hs
+                    , Data/Flex/Test/Compose.hs
+                    , Data/Flex/Test/Wrap.hs
+                    , Data/Flex/Test/WrappedMonad.hs
+                    , Data/Flex/Examples/Lex/Simple.hs
+                    , Data/Flex/Examples/Lex/Strict.hs
+                    , Data/Wrap.hs
+                    , .ghci
+Tested-with:     GHC==6.4.1, GHC==6.6.1, GHC==6.8.3, GHC==6.10.4, GHC==6.12.3
+               , GHC==7.0.1
+Library
+    Exposed-Modules:     Data.Flex.Applicative
+                       , Data.Flex.Compose
+                       , Data.Flex.FlipT
+                       , Data.Flex.Functor
+                       , Data.Flex.Monad
+                       , Data.Flex.MonadPlus
+                       , Data.Flex.MonadState
+                       , Data.Flex.MonadTrans
+                       , Data.Flex.Utils
+                       , Data.Flex.Wrap
+                       , Data.Flex.WrapCTC
+                       , Data.Flex.WrappedMonad
+                       , Data.Flex.WrapT
+    if impl(ghc < 6.6.1)
+        Extensions:      UndecidableInstances
+        Build-Depends:  special-functors < 2
+    if impl(ghc < 6.8.1)
+        Ghc-options:     -fglasgow-exts
+    if impl(ghc >= 6.8.1)
+        Extensions:      TypeOperators, KindSignatures
+    Build-Depends:   base < 5, data-type < 0.1, mtl < 2.1
+-- vim: expandtab:tabstop=4:shiftwidth=4