{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-| The @set-monad@ library exports the @Set@ abstract data type and set-manipulating functions. These functions behave exactly as their namesakes from the @Data.Set@ module of the @containers@ library. In addition, the @set-monad@ library extends @Data.Set@ by providing @Functor@, @Applicative@, @Alternative@, @Monad@, and @MonadPlus@ instances for sets. In other words, you can use the @set-monad@ library as a drop-in replacement for the @Data.Set@ module of the @containers@ library and, in addition, you will also get the aforementioned instances which are not available in the @containers@ package. It is not possible to directly implement instances for the aforementioned standard Haskell type classes for the @Set@ data type from the @containers@ library. This is because the key operations @map@ and @union@, are constrained with @Ord@ as follows. > map :: (Ord a, Ord b) => (a -> b) -> Set a -> Set b > union :: (Ord a) => Set a -> Set a -> Set a The @set-monad@ library provides the type class instances by wrapping the constrained @Set@ type into a data type that has unconstrained constructors corresponding to monadic combinators. The data type constructors that represent monadic combinators are evaluated with a constrained run function. This elevates the need to use the constraints in the instance definitions (this is what prevents a direct definition). The wrapping and unwrapping happens internally in the library and does not affect its interface. For details, see the rather compact definitions of the @run@ function and type class instances. The left identity and associativity monad laws play a crucial role in the definition of the @run@ function. The rest of the code should be self explanatory. The technique is not new. This library was inspired by [1]. To my knowledge, the original, systematic presentation of the idea to represent monadic combinators as data is given in [2]. There is also a Haskell library that provides a generic infrastructure for the aforementioned wrapping and unwrapping [3]. The @set-monad@ library is particularly useful for writing set-oriented code using the do and/or monad comprehension notations. For example, the following definitions now type check. > s1 :: Set (Int,Int) > s1 = do a <- fromList [1 .. 4] > b <- fromList [1 .. 4] > return (a,b) > -- with -XMonadComprehensions > s2 :: Set (Int,Int) > s2 = [ (a,b) | (a,b) <- s1, even a, even b ] > s3 :: Set Int > s3 = fmap (+1) (fromList [1 .. 4]) As noted in [1], the implementation technique can be used for monadic libraries and EDSLs with restricted types (compiled EDSLs often restrict the types that they can handle). Haskell's standard monad type class can be used for restricted monad instances. There is no need to resort to GHC extensions that rebind the standard monadic combinators with the library or EDSL specific ones. @[@1@]@ CSDL Blog: The home of applied functional programming at KU. Monad Reification in Haskell and the Sunroof Javascript compiler. <http://www.ittc.ku.edu/csdlblog/?p=88> @[@2@]@ Chuan-kai Lin. 2006. Programming monads operationally with Unimo. In Proceedings of the eleventh ACM SIGPLAN International Conference on Functional Programming (ICFP '06). ACM. @[@3@]@ Heinrich Apfelmus. The operational package. <http://hackage.haskell.org/package/operational> -} module Data.Set.Monad ( -- * Set type Set -- * Operators , (\\) -- * Query , null , size , member , notMember , isSubsetOf , isProperSubsetOf -- * Construction , empty , singleton , insert , delete -- * Combine , union , unions , difference , intersection -- * Filter , filter , partition , split , splitMember -- * Map , map , mapMonotonic -- * Folds , foldr , foldl -- ** Strict folds , foldr' , foldl' -- ** Legacy folds , fold -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , maxView , minView -- * Conversion -- ** List , elems , toList , fromList -- ** Ordered list , toAscList , fromAscList , fromDistinctAscList -- * Debugging , showTree , showTreeWith , valid ) where import Prelude hiding (null, filter, map, foldr, foldl) import qualified Data.List as L import qualified Data.Set as S import qualified Data.Functor as F import qualified Control.Applicative as A import Data.Monoid import Control.Arrow import Control.Monad import Control.DeepSeq data Set a where Prim :: (Ord a) => S.Set a -> Set a Return :: a -> Set a Bind :: Set a -> (a -> Set b) -> Set b Zero :: Set a Plus :: Set a -> Set a -> Set a run :: (Ord a) => Set a -> S.Set a run (Prim s) = s run (Return a) = S.singleton a run (Zero) = S.empty run (Plus ma mb) = S.union (run ma) (run mb) run (Bind (Prim s) f) = S.foldl' S.union S.empty (S.map (run . f) s) run (Bind (Return a) f) = run (f a) run (Bind Zero _) = S.empty run (Bind (Plus ma mb) f) = run (Plus (Bind ma f) (Bind mb f)) run (Bind (Bind m f) g) = run (Bind m (\a -> Bind (f a) g)) instance F.Functor Set where fmap = liftM instance A.Applicative Set where pure = return (<*>) = ap instance A.Alternative Set where empty = mzero (<|>) = mplus instance Monad Set where return = Return (>>=) = Bind instance MonadPlus Set where mzero = Zero mplus = Plus instance (Ord a) => Monoid (Set a) where mempty = empty mappend = union mconcat = unions instance (Ord a) => Eq (Set a) where s1 == s2 = run s1 == run s2 instance (Ord a) => Ord (Set a) where compare s1 s2 = compare (run s1) (run s2) instance (Show a, Ord a) => Show (Set a) where show = show . run instance (Read a, Ord a) => Read (Set a) where readsPrec i s = L.map (first Prim) (readsPrec i s) instance (NFData a, Ord a) => NFData (Set a) where rnf = rnf . run infixl 9 \\ (\\) :: (Ord a) => Set a -> Set a -> Set a m1 \\ m2 = difference m1 m2 null :: (Ord a) => Set a -> Bool null = S.null . run size :: (Ord a) => Set a -> Int size = S.size . run member :: (Ord a) => a -> Set a -> Bool member a s = S.member a (run s) notMember :: (Ord a) => a -> Set a -> Bool notMember a t = not (member a t) isSubsetOf :: Ord a => Set a -> Set a -> Bool isSubsetOf s1 s2 = S.isSubsetOf (run s1) (run s2) isProperSubsetOf :: Ord a => Set a -> Set a -> Bool isProperSubsetOf s1 s2 = S.isProperSubsetOf (run s1) (run s2) empty :: (Ord a) => Set a empty = Prim S.empty singleton :: (Ord a) => a -> Set a singleton a = Prim (S.singleton a) insert :: (Ord a) => a -> Set a -> Set a insert a s = Prim (S.insert a (run s)) delete :: (Ord a) => a -> Set a -> Set a delete a s = Prim (S.delete a (run s)) union :: (Ord a) => Set a -> Set a -> Set a union s1 s2 = Prim (S.union (run s1) (run s2)) unions :: (Ord a) => [Set a] -> Set a unions ss = Prim (S.unions (L.map run ss)) difference :: (Ord a) => Set a -> Set a -> Set a difference s1 s2 = Prim (S.difference (run s1) (run s2)) intersection :: (Ord a) => Set a -> Set a -> Set a intersection s1 s2 = Prim (S.intersection (run s1) (run s2)) filter :: (Ord a) => (a -> Bool) -> Set a -> Set a filter f s = Prim (S.filter f (run s)) partition :: (Ord a) => (a -> Bool) -> Set a -> (Set a,Set a) partition f s = (Prim *** Prim) (S.partition f (run s)) split :: (Ord a) => a -> Set a -> (Set a,Set a) split a s = (Prim *** Prim) (S.split a (run s)) splitMember :: (Ord a) => a -> Set a -> (Set a, Bool, Set a) splitMember a s = (\(s1,b,s2) -> (Prim s1,b,Prim s2)) (S.splitMember a (run s)) map :: (Ord a,Ord b) => (a -> b) -> Set a -> Set b map f s = Prim (S.map f (run s)) mapMonotonic :: (Ord a,Ord b) => (a -> b) -> Set a -> Set b mapMonotonic f s = Prim (S.mapMonotonic f (run s)) foldr :: (Ord a) => (a -> b -> b) -> b -> Set a -> b foldr f z s = S.foldr f z (run s) foldl :: (Ord a) => (b -> a -> b) -> b -> Set a -> b foldl f z s = S.foldl f z (run s) foldr' :: (Ord a) => (a -> b -> b) -> b -> Set a -> b foldr' f z s = S.foldr' f z (run s) foldl' :: (Ord a) => (b -> a -> b) -> b -> Set a -> b foldl' f z s = S.foldl' f z (run s) fold :: (Ord a) => (a -> b -> b) -> b -> Set a -> b fold = foldr findMin :: (Ord a) => Set a -> a findMin = S.findMin . run findMax :: (Ord a) => Set a -> a findMax = S.findMax . run deleteMin :: (Ord a) => Set a -> Set a deleteMin = Prim . S.deleteMin . run deleteMax :: (Ord a) => Set a -> Set a deleteMax = Prim . S.deleteMax . run deleteFindMin :: (Ord a) => Set a -> (a,Set a) deleteFindMin s = second Prim (S.deleteFindMin (run s)) deleteFindMax :: (Ord a) => Set a -> (a,Set a) deleteFindMax s = second Prim (S.deleteFindMax (run s)) maxView :: (Ord a) => Set a -> Maybe (a,Set a) maxView = fmap (second Prim) . S.maxView . run minView :: (Ord a) => Set a -> Maybe (a,Set a) minView = fmap (second Prim) . S.minView . run elems :: (Ord a) => Set a -> [a] elems = toList toList :: (Ord a) => Set a -> [a] toList = S.toList . run fromList :: (Ord a) => [a] -> Set a fromList as = Prim (S.fromList as) toAscList :: (Ord a) => Set a -> [a] toAscList = S.toAscList . run fromAscList :: (Ord a) => [a] -> Set a fromAscList = Prim . S.fromAscList fromDistinctAscList :: (Ord a) => [a] -> Set a fromDistinctAscList = Prim . S.fromDistinctAscList showTree :: (Show a,Ord a) => Set a -> String showTree = S.showTree . run showTreeWith :: (Show a, Ord a) => Bool -> Bool -> Set a -> String showTreeWith b1 b2 s = S.showTreeWith b1 b2 (run s) valid :: (Ord a) => Set a -> Bool valid = S.valid . run