{-# LANGUAGE ConstraintKinds #-}
-- | STM mutable set
module Haskus.Utils.STM.TSet
( TSet
, Element
, null
, size
, member
, notMember
, empty
, singleton
, insert
, delete
, toList
, fromList
, elems
, stream
, unions
, map
)
where
import Prelude hiding (lookup,null,map)
import Haskus.Utils.STM
import qualified StmContainers.Set as SSET
import ListT (ListT, fold)
import qualified ListT
import Data.Hashable
import Haskus.Utils.Flow (forM_)
type Element a = (Eq a, Hashable a)
-- | STM Set
type TSet a = SSET.Set a
-- | Indicate if the set is empty
null :: TSet a -> STM Bool
null = SSET.null
-- | Number of elements in the set
size :: TSet a -> STM Int
size = fold f 0 . SSET.listT
where
f n _ = return (n+1)
-- | Check if an element is in the set
member :: Element e => e -> TSet e -> STM Bool
member = SSET.lookup
-- | Check if an element is not in the set
notMember :: Element e => e -> TSet e -> STM Bool
notMember e s = not <$> member e s
-- | Create an empty set
empty :: STM (TSet e)
empty = SSET.new
-- | Create a set containing a single element
singleton :: Element e => e -> STM (TSet e)
singleton e = do
m <- empty
insert e m
return m
-- | Insert an element in a set
insert :: Element e => e -> TSet e -> STM ()
insert = SSET.insert
-- | Delete an element from a set
delete :: Element e => e -> TSet e -> STM ()
delete = SSET.delete
-- | Convert a set into a list
toList :: TSet e -> STM [e]
toList = ListT.toList . SSET.listT
-- | Create a set from a list
fromList :: Element e => [e] -> STM (TSet e)
fromList xs = do
s <- empty
forM_ xs (`insert` s)
return s
-- | Get the set elements
elems :: TSet e -> STM [e]
elems = toList
-- | Get the set as a ListT stream
stream :: TSet e -> ListT STM e
stream = SSET.listT
-- | Perform a set union
unions :: Element e => [TSet e] -> STM (TSet e)
unions ss = do
ret <- empty
forM_ ss $ \s ->
ListT.traverse_ (`insert` ret) (stream s)
return ret
-- | Apply a function to each element in the set
map :: (Element b) => (a -> b) -> TSet a -> STM (TSet b)
map f m = do
r <- empty
ListT.traverse_ (\x -> insert (f x) r) (stream m)
return r
--filter :: (a -> Bool) -> TSet a -> STM ()
--filter f = withTVar (Set.filter f)