{-# LANGUAGE
GeneralizedNewtypeDeriving
, DeriveFunctor
#-}
module Data.Set.Unordered.Many where
import Data.Mergeable
import Data.List as List hiding (delete)
import qualified Data.List as List
import Data.Maybe (mapMaybe)
import Control.Monad
import Test.QuickCheck
newtype UMSet a = UMSet {unUMSet :: [a]}
deriving (Functor, Show)
instance Mergeable UMSet where
mergeMap f (UMSet xs) = mergeMap f xs
instance Eq a => Eq (UMSet a) where
(UMSet xs) == (UMSet ys) = case foldr go (Just xs) ys of
Just [] -> True
_ -> False
where
go _ Nothing = Nothing
go _ (Just []) = Nothing
go y (Just xs') | y `elem` xs' = Just $ List.delete y xs'
| otherwise = Nothing
instance Arbitrary a => Arbitrary (UMSet a) where
arbitrary = UMSet <$> sized go
where
go s = replicateM s arbitrary
(\\) :: Eq a => UMSet a -> UMSet a -> UMSet a
(\\) = difference
null :: UMSet a -> Bool
null (UMSet xs) = List.null xs
size :: UMSet a -> Int
size (UMSet xs) = List.length xs
member :: Eq a => a -> UMSet a -> Bool
member x (UMSet xs) = List.elem x xs
notMember :: Eq a => a -> UMSet a -> Bool
notMember x = not . member x
lookup :: Eq a => a -> UMSet a -> Maybe a
lookup x (UMSet xs) = lookup' xs
where
lookup' [] = Nothing
lookup' (y:ys) | x == y = Just y
| otherwise = lookup' ys
isSubsetOf :: Eq a => UMSet a -> UMSet a -> Bool
isSubsetOf (UMSet xs) (UMSet ys) = foldr go True xs
where
go x b | List.elem x ys = b
| otherwise = False
isProperSubsetOf :: Eq a => UMSet a -> UMSet a -> Bool
isProperSubsetOf (UMSet xs) (UMSet ys) = fst $ foldr go (True,ys) xs
where
go _ (False,soFar) = (False,soFar)
go _ (_,[]) = (False,[])
go x (b,soFar) = if List.elem x soFar
then (b, List.filter (/= x) soFar)
else (False, soFar)
empty :: UMSet a
empty = UMSet []
singleton :: a -> UMSet a
singleton x = UMSet [x]
insert :: a -> UMSet a -> UMSet a
insert x (UMSet xs) = UMSet $ x:xs
delete :: Eq a => a -> UMSet a -> UMSet a
delete x (UMSet xs) = UMSet $ List.filter (/= x) xs
union :: UMSet a -> UMSet a -> UMSet a
union (UMSet xs) (UMSet ys) = UMSet $ xs ++ ys
difference :: Eq a => UMSet a -> UMSet a -> UMSet a
difference (UMSet xs) (UMSet ys) = UMSet $ foldr go [] xs
where
go x soFar | List.elem x ys = soFar
| otherwise = x:soFar
intersection :: Eq a => UMSet a -> UMSet a -> UMSet a
intersection (UMSet xs) (UMSet ys) = UMSet $ fst $ foldr go ([],ys) xs
where
go :: Eq a => a -> ([a],[a]) -> ([a],[a])
go x (soFar,whatsLeft) | List.elem x whatsLeft =
( soFar ++ List.filter (== x) whatsLeft
, List.filter (/= x) whatsLeft )
| otherwise =
( soFar
, whatsLeft )
filter :: (a -> Bool) -> UMSet a -> UMSet a
filter p (UMSet xs) = UMSet $ List.filter p xs
partition :: (a -> Bool) -> UMSet a -> (UMSet a, UMSet a)
partition p (UMSet xs) = let (l,r) = List.partition p xs in (UMSet l, UMSet r)
map :: (a -> b) -> UMSet a -> UMSet b
map f (UMSet xs) = UMSet $ List.map f xs
mapMaybe :: (a -> Maybe b) -> UMSet a -> UMSet b
mapMaybe f (UMSet xs) = UMSet $ Data.Maybe.mapMaybe f xs