#if __GLASGOW_HASKELL__>=700
#endif
module Control.RMonad.Trans.Set where
import Control.RMonad.Prelude
import Control.RMonad
import Control.RMonad.Trans
import Data.Suitable
import Data.Set (Set)
import qualified Data.Set as Set
newtype SetT m a = SetT { runSetT :: m (Set a) }
data instance Constraints (SetT m) a = (Ord a, Suitable m a, Suitable m (Set a)) => SetTConstraints
instance (Ord a, Suitable m a, Suitable m (Set a)) => Suitable (SetT m) a where
constraints = SetTConstraints
instance RMonad m => RMonad (SetT m) where
return a = withResConstraints $ \SetTConstraints -> SetT $ return (Set.singleton a)
m >>= f = withConstraintsOf m $ \SetTConstraints ->
withResConstraints $ \SetTConstraints ->
SetT $ do as <- runSetT m
foldr (liftM2 Set.union) (return Set.empty) $ map (runSetT . f) $ Set.elems as
instance RMonad m => RMonadPlus (SetT m) where
mzero = withResConstraints $ \SetTConstraints -> SetT (return Set.empty)
mplus (SetT ma) (SetT mb) = withResConstraints $ \SetTConstraints -> SetT $ liftM2 Set.union ma mb
instance RMonadTrans SetT where
lift ma = withResConstraints $ \SetTConstraints -> SetT $ liftM Set.singleton ma
instance RMonadIO m => RMonadIO (SetT m) where
liftIO ma = withResConstraints $ \SetTConstraints -> lift $ liftIO ma