WrappedMonad.hs

{-# 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