module Control.RMonad.Trans.Set where
import Prelude hiding (return, fail, (>>=), (>>), (=<<), sequence, sequence_, mapM, mapM_)
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) }
instance (Ord a, Suitable m a, Suitable m (Set a)) => Suitable (SetT m) a where
data Constraints (SetT m) a = (Ord a, Suitable m a, Suitable m (Set a)) => SetTConstraints
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