{-# LANGUAGE TypeFamilies, NoMonomorphismRestriction, NoImplicitPrelude, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

module Control.RMonad.Trans.List where

import Prelude hiding (return, fail, (>>=), (>>), (=<<), sequence, sequence_, mapM, mapM_)

import Control.RMonad
import Control.RMonad.Trans

import Data.Suitable

import Control.Monad.Trans.List

instance (Suitable m a, Suitable m [a]) => Suitable (ListT m) a where
   data Constraints (ListT m) a = (Suitable m a, Suitable m [a]) => ListTConstraints
   constraints _ = ListTConstraints

instance RMonad m => RMonad (ListT m) where
   return a = withResConstraints $ \ListTConstraints -> ListT $ return [a]
   m >>= f = withConstraintsOf m $ \ListTConstraints -> withResConstraints $ \ListTConstraints ->
             ListT $ do as <- runListT m
                        foldr (liftM2 (++)) (return []) $ map (runListT . f) as

instance RMonad m => RMonadPlus (ListT m) where
   mzero = withResConstraints $ \ListTConstraints -> ListT (return [])
   mplus (ListT m1) (ListT m2)
     = withResConstraints $ \ListTConstraints -> ListT $ liftM2 (++) m1 m2

instance RMonadTrans ListT where
  lift m = withResConstraints $ \ListTConstraints -> ListT . liftM (:[]) $ m

instance RMonadIO m => RMonadIO (ListT m) where
  liftIO m = withResConstraints $ \ListTConstraints -> lift $ liftIO m