{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/WrappedMonad.hs,v 1.3 2011/03/05 01:12:40 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