packages feed

sets 0.0.3 → 0.0.4

raw patch · 11 files changed

+765/−49 lines, 11 filesdep +invariantdep +witherabledep −set-withdep ~basedep ~containerssetup-changed

Dependencies added: invariant, witherable

Dependencies removed: set-with

Dependency ranges changed: base, containers

Files

− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
sets.cabal view
@@ -1,5 +1,5 @@ Name:                   sets-Version:                0.0.3+Version:                0.0.4 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                MIT@@ -18,16 +18,19 @@                         Data.Set.Unordered.Unique                         Data.Set.Unordered.Many                         Data.Set.Ordered.Unique+                        Data.Set.Ordered.Unique.With                         Data.Set.Ordered.Unique.Finite                         Data.Set.Ordered.Many+                        Data.Set.Ordered.Many.With   Build-Depends:        base >= 4.6 && < 5                       , containers                       , unordered-containers                       , hashable-                      , set-with                       , commutative                       , contravariant                       , discrimination+                      , invariant+                      , witherable  Test-Suite spec   Type:                 exitcode-stdio-1.0@@ -35,13 +38,21 @@   Hs-Source-Dirs:       src                       , test   Ghc-Options:          -Wall-  Main-Is:              Spec.hs+  Main-Is:              Main.hs   Build-Depends:        base                       , tasty                       , tasty-quickcheck                       , tasty-hunit                       , QuickCheck                       , quickcheck-instances+                      , containers+                      , unordered-containers+                      , hashable+                      , commutative+                      , contravariant+                      , discrimination+                      , invariant+                      , witherable  Source-Repository head   Type:                 git
src/Data/Set/Class.hs view
@@ -14,7 +14,8 @@  module Data.Set.Class where -import Prelude (Eq (..), Ord, Int, Bool (..), (&&), (||), ($), (.), not, const)+import Prelude ( Eq (..), Ord (..), Int, Bool (..), (&&), (||), ($), (.), not, const+               , Show (..)) import Data.Foldable as Fold import Data.Monoid as Monoid import Data.Commutative as Comm@@ -28,18 +29,21 @@ import Data.Hashable (Hashable) import qualified Data.HashSet as HashSet import qualified Data.HashMap.Lazy as HashMap-import qualified Data.SetWith as SetWith import qualified Data.Functor.Contravariant as Pred import qualified Data.Set.Ordered.Many as OM import Data.Discrimination as Disc import qualified Data.Set.Unordered.Many as UM import qualified Data.Set.Unordered.Unique as UU import qualified Data.Set.Ordered.Unique.Finite as OUF+import qualified Data.Set.Ordered.Unique.With as SetWith   newtype Union a        = Union {unUnion :: a}+  deriving (Show, Eq) newtype Intersection a = Intersection {unIntersection :: a}+  deriving (Show, Eq) newtype XUnion a       = XUnion {unXUnion :: a}+  deriving (Show, Eq)  class HasUnion s where   union :: s -> s -> s@@ -60,6 +64,9 @@ class HasDifference s where   difference :: s -> s -> s +(\\) :: HasDifference s => s -> s -> s+(\\) = difference+ class HasIntersection s where   intersection :: s -> s -> s @@ -93,19 +100,28 @@ class HasComplement s where   complement :: s -> s -class HasSingleton s a where+class HasSingleton a s where   singleton :: a -> s -class HasSingletonWith s k a where+class HasSingletonWith k a s where   singletonWith :: k -> a -> s +class HasDelete a s where+  delete :: a -> s -> s++class HasInsert a s where+  insert :: a -> s -> s++class HasInsertWith k a s where+  insertWith :: k -> a -> s -> s+ class HasEmpty s where   empty :: s  instance (Commutative (Union s), HasEmpty s) => CommutativeId (Union s) where   cempty = empty -class HasEmptyWith s k where+class HasEmptyWith k s where   emptyWith :: k -> s  class HasTotal s where@@ -114,7 +130,7 @@ instance (Commutative (Intersection s), HasTotal s) => CommutativeId (Intersection s) where   cempty = total -class HasTotalWith s k where+class HasTotalWith k s where   totalWith :: k -> s  class HasSize s where@@ -136,6 +152,9 @@ deriving instance HasComplement a        => HasComplement        (Union a) deriving instance HasSingleton x a       => HasSingleton x       (Union a) deriving instance HasSingletonWith k x a => HasSingletonWith k x (Union a)+deriving instance HasInsert x a          => HasInsert x          (Union a)+deriving instance HasInsertWith k x a    => HasInsertWith k x    (Union a)+deriving instance HasDelete x a          => HasDelete x          (Union a) deriving instance HasEmpty a             => HasEmpty             (Union a) deriving instance HasEmptyWith k a       => HasEmptyWith k       (Union a) deriving instance HasTotal a             => HasTotal             (Union a)@@ -149,6 +168,9 @@ deriving instance HasComplement a        => HasComplement        (Intersection a) deriving instance HasSingleton x a       => HasSingleton x       (Intersection a) deriving instance HasSingletonWith k x a => HasSingletonWith k x (Intersection a)+deriving instance HasInsert x a          => HasInsert x          (Intersection a)+deriving instance HasInsertWith k x a    => HasInsertWith k x    (Intersection a)+deriving instance HasDelete x a          => HasDelete x          (Intersection a) deriving instance HasEmpty a             => HasEmpty             (Intersection a) deriving instance HasEmptyWith k a       => HasEmptyWith k       (Intersection a) deriving instance HasTotal a             => HasTotal             (Intersection a)@@ -162,6 +184,9 @@ deriving instance HasComplement a        => HasComplement        (XUnion a) deriving instance HasSingleton x a       => HasSingleton x       (XUnion a) deriving instance HasSingletonWith k x a => HasSingletonWith k x (XUnion a)+deriving instance HasInsert x a          => HasInsert x          (XUnion a)+deriving instance HasInsertWith k x a    => HasInsertWith k x    (XUnion a)+deriving instance HasDelete x a          => HasDelete x          (XUnion a) deriving instance HasEmpty a             => HasEmpty             (XUnion a) deriving instance HasEmptyWith k a       => HasEmptyWith k       (XUnion a) deriving instance HasTotal a             => HasTotal             (XUnion a)@@ -181,9 +206,15 @@ instance Ord a => HasIntersection (Set.Set a) where   intersection = Set.intersection -instance HasSingleton (Set.Set a) a where+instance HasSingleton a (Set.Set a) where   singleton = Set.singleton +instance Ord a => HasInsert a (Set.Set a) where+  insert = Set.insert++instance Ord a => HasDelete a (Set.Set a) where+  delete = Set.delete+ instance HasEmpty (Set.Set a) where   empty = Set.empty @@ -207,9 +238,15 @@ instance Ord k => HasIntersection (Map.Map k a) where   intersection = Map.intersection -instance HasSingletonWith (Map.Map k a) k a where+instance HasSingletonWith k a (Map.Map k a) where   singletonWith = Map.singleton +instance Ord k => HasInsertWith k a (Map.Map k a) where+  insertWith = Map.insert++instance Ord k => HasDelete k (Map.Map k a) where+  delete = Map.delete+ instance HasEmpty (Map.Map k a) where   empty = Map.empty @@ -224,9 +261,15 @@   -- Data.List-instance HasSingleton [a] a where+instance HasSingleton a [a] where   singleton = (:[]) +instance HasInsert a [a] where+  insert = (:)++instance Eq a => HasDelete a [a] where+  delete x = List.filter (== x)+ instance HasEmpty [a] where   empty = [] @@ -234,7 +277,7 @@   size = List.length  -- Data.Sequence-instance HasSingleton (Seq.Seq a) a where+instance HasSingleton a (Seq.Seq a) where   singleton = Seq.singleton  instance HasEmpty (Seq.Seq a) where@@ -253,9 +296,15 @@ instance HasIntersection IntSet.IntSet where   intersection = IntSet.intersection -instance HasSingleton IntSet.IntSet IntSet.Key where+instance HasSingleton IntSet.Key IntSet.IntSet where   singleton = IntSet.singleton +instance HasInsert IntSet.Key IntSet.IntSet where+  insert = IntSet.insert++instance HasDelete IntSet.Key IntSet.IntSet where+  delete = IntSet.delete+ instance HasEmpty IntSet.IntSet where   empty = IntSet.empty @@ -279,9 +328,15 @@ instance HasIntersection (IntMap.IntMap a) where   intersection = IntMap.intersection -instance HasSingletonWith (IntMap.IntMap a) IntMap.Key a where+instance HasSingletonWith IntMap.Key a (IntMap.IntMap a) where   singletonWith = IntMap.singleton +instance HasInsertWith IntMap.Key a (IntMap.IntMap a) where+  insertWith = IntMap.insert++instance HasDelete IntMap.Key (IntMap.IntMap a) where+  delete = IntMap.delete+ instance HasEmpty (IntMap.IntMap a) where   empty = IntMap.empty @@ -305,9 +360,15 @@ instance (Hashable a, Eq a) => HasIntersection (HashSet.HashSet a) where   intersection = HashSet.intersection -instance Hashable a => HasSingleton (HashSet.HashSet a) a where+instance Hashable a => HasSingleton a (HashSet.HashSet a) where   singleton = HashSet.singleton +instance (Hashable a, Eq a) => HasInsert a (HashSet.HashSet a) where+  insert = HashSet.insert++instance (Hashable a, Eq a) => HasDelete a (HashSet.HashSet a) where+  delete = HashSet.delete+ instance HasEmpty (HashSet.HashSet a) where   empty = HashSet.empty @@ -325,9 +386,15 @@ instance (Hashable k, Eq k) => HasIntersection (HashMap.HashMap k a) where   intersection = HashMap.intersection -instance Hashable k => HasSingletonWith (HashMap.HashMap k a) k a where+instance Hashable k => HasSingletonWith k a (HashMap.HashMap k a) where   singletonWith = HashMap.singleton +instance (Hashable k, Eq k) => HasInsertWith k a (HashMap.HashMap k a) where+  insertWith = HashMap.insert++instance (Hashable k, Eq k) => HasDelete k (HashMap.HashMap k a) where+  delete = HashMap.delete+ instance HasEmpty (HashMap.HashMap k a) where   empty = HashMap.empty @@ -344,10 +411,16 @@ instance Ord k => HasIntersection (SetWith.SetWith k a) where   intersection = SetWith.intersection -instance Ord k => HasSingletonWith (SetWith.SetWith k a) (a -> k) a where+instance Ord k => HasSingletonWith (a -> k) a (SetWith.SetWith k a) where   singletonWith = SetWith.singleton -instance HasEmptyWith (SetWith.SetWith k a) (a -> k) where+instance Ord k => HasInsert a (SetWith.SetWith k a) where+  insert = SetWith.insert++instance Ord k => HasDelete a (SetWith.SetWith k a) where+  delete = SetWith.delete++instance HasEmptyWith (a -> k) (SetWith.SetWith k a) where   emptyWith = SetWith.empty  instance HasSize (SetWith.SetWith k a) where@@ -372,9 +445,15 @@ instance HasComplement (Pred.Predicate a) where   complement (Pred.Predicate f) = Pred.Predicate $ not . f -instance Eq a => HasSingleton (Pred.Predicate a) a where+instance Eq a => HasSingleton a (Pred.Predicate a) where   singleton a = Pred.Predicate $ \x -> a == x +instance Eq a => HasInsert a (Pred.Predicate a) where+  insert a (Pred.Predicate f) = Pred.Predicate $ \x -> a == x || f x++instance Eq a => HasDelete a (Pred.Predicate a) where+  delete a (Pred.Predicate f) = Pred.Predicate $ \x -> a /= x && f x+ instance HasEmpty (Pred.Predicate a) where   empty = Pred.Predicate $ const False @@ -392,9 +471,15 @@ instance Ord a => HasIntersection (OM.OMSet a) where   intersection = OM.intersection -instance HasSingleton (OM.OMSet a) a where+instance HasSingleton a (OM.OMSet a) where   singleton = OM.singleton +instance Ord a => HasInsert a (OM.OMSet a) where+  insert = OM.insert++instance Eq a => HasDelete a (OM.OMSet a) where+  delete = OM.delete+ instance HasEmpty (OM.OMSet a) where   empty = OM.empty @@ -418,9 +503,15 @@ instance Eq a => HasIntersection (UM.UMSet a) where   intersection = UM.intersection -instance HasSingleton (UM.UMSet a) a where+instance HasSingleton a (UM.UMSet a) where   singleton = UM.singleton +instance HasInsert a (UM.UMSet a) where+  insert = UM.insert++instance Eq a => HasDelete a (UM.UMSet a) where+  delete = UM.delete+ instance HasEmpty (UM.UMSet a) where   empty = UM.empty @@ -444,9 +535,15 @@ instance Eq a => HasIntersection (UU.UUSet a) where   intersection = UU.intersection -instance HasSingleton (UU.UUSet a) a where+instance HasSingleton a (UU.UUSet a) where   singleton = UU.singleton +instance Eq a => HasInsert a (UU.UUSet a) where+  insert = UU.insert++instance Eq a => HasDelete a (UU.UUSet a) where+  delete = UU.delete+ instance HasEmpty (UU.UUSet a) where   empty = UU.empty @@ -473,10 +570,16 @@ instance Ord a => HasComplement (OUF.FiniteSet a) where   complement = OUF.complement -instance HasSingletonWith (OUF.FiniteSet a) (Set.Set a) a where+instance HasSingletonWith (Set.Set a) a (OUF.FiniteSet a) where   singletonWith = OUF.singleton -instance HasEmptyWith (OUF.FiniteSet a) (Set.Set a) where+instance Ord a => HasInsert a (OUF.FiniteSet a) where+  insert = OUF.insert++instance Ord a => HasDelete a (OUF.FiniteSet a) where+  delete = OUF.delete++instance HasEmptyWith (Set.Set a) (OUF.FiniteSet a) where   emptyWith = OUF.empty  instance HasTotalWith (OUF.FiniteSet a) (OUF.FiniteSet a) where
src/Data/Set/Ordered/Many.hs view
@@ -1,19 +1,32 @@ {-# LANGUAGE     GeneralizedNewtypeDeriving   , DeriveFunctor+  , DeriveFoldable+  , DeriveTraversable   #-}  module Data.Set.Ordered.Many where  import Data.Mergeable import Data.List as List hiding (delete)+import Data.Foldable as Fold+import Data.Traversable import Data.Discrimination as Disc import Data.Maybe (fromJust, isJust, mapMaybe)+import Control.Monad.Fix   -- | Ordered sets with duplicate elements. newtype OMSet a = OMSet {unOMSet :: [a]}-  deriving (Functor)+  deriving ( Eq+           , Show+           , Functor+           , Applicative+           , Monad+           , Fold.Foldable+           , Traversable+           , MonadFix+           )  instance Mergeable OMSet where   mergeMap f (OMSet xs) = mergeMap f xs@@ -46,8 +59,8 @@ lookup x (OMSet xs) = lookup' x xs   where     lookup' _ [] = Nothing-    lookup' x (y:ys) | x == y    = Just y-                     | otherwise = lookup' x ys+    lookup' x' (y:ys) | x == y    = Just y+                      | otherwise = lookup' x' ys  -- | /O(n*m)/ isSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool@@ -80,9 +93,9 @@ insert :: Ord a => a -> OMSet a -> OMSet a insert x (OMSet xs) = OMSet $ insert' x xs   where-    insert' x [] = [x]-    insert' x (a:as) | x > a = a : insert' x as-                     | otherwise = x:a:as+    insert' x' [] = [x']+    insert' x' (a:as) | x' > a = a : insert' x' as+                      | otherwise = x':a:as  -- | /O(n)/ delete :: Eq a => a -> OMSet a -> OMSet a@@ -92,7 +105,7 @@  -- | /O(n+m)/ union :: Disc.Sorting a => OMSet a -> OMSet a -> OMSet a-union (OMSet xs) (OMSet ys) = OMSet $ Disc.sort (xs ++ ys) -- TODO: Use descrimonation+union (OMSet xs) (OMSet ys) = OMSet $ Disc.sort (xs ++ ys)  -- | /O(n*m)/ difference :: Eq a => OMSet a -> OMSet a -> OMSet a
+ src/Data/Set/Ordered/Many/With.hs view
@@ -0,0 +1,346 @@+{-# LANGUAGE+    NoImplicitPrelude+  , FlexibleContexts+  , FlexibleInstances+  , MultiParamTypeClasses+  #-}++module Data.Set.Ordered.Many.With where++import Prelude (($), (.), Eq (..), Ord (..), Maybe (..)+               , Bool (..), (&&), (||), and, not, Functor (..), Int+               , fst, snd, zip, String (..), Show (..))+import qualified Data.Set.Class as Sets+import qualified Data.Set.Ordered.Many as OM+import qualified Data.Set.Ordered.Unique.With as OU+import qualified Data.Map as Map+import qualified Data.Witherable as Wither++import Data.Monoid+import Data.Maybe (isJust)+import Data.Functor.Invariant+import Data.Foldable as Fold+import Control.Applicative hiding (empty)+++newtype SetsWith k c a = SetsWith {unSetsWith :: (a -> k, Map.Map k (c a))}++instance Functor c => Invariant (SetsWith k c) where+  invmap = map++instance Fold.Foldable c => Fold.Foldable (SetsWith k c) where+  foldr = Data.Set.Ordered.Many.With.foldr++instance (Eq (c a), Eq k) => Eq (SetsWith k c a) where+  (SetsWith (_,xs)) == (SetsWith (_,ys)) = xs == ys++instance ( Ord k+         , Sets.HasUnion (c a)+         ) => Sets.HasUnion (SetsWith k c a) where+  union = union++instance ( Ord k+         , Eq (c a)+         , Sets.HasEmpty (c a)+         , Sets.HasDifference (c a)+         ) => Sets.HasDifference (SetsWith k c a) where+  difference = difference++instance ( Ord k+          , Eq (c a)+          , Sets.HasEmpty (c a)+         , Sets.HasIntersection (c a)+         ) => Sets.HasIntersection (SetsWith k c a) where+  intersection = intersection++instance ( Ord k+         , Sets.HasUnion (c a)+         , Sets.HasSingleton a (c a)+         ) => Sets.HasSingletonWith (a -> k) a (SetsWith k c a) where+  singletonWith = singleton++instance ( Ord k+         , Sets.HasUnion (c a)+         , Sets.HasSingleton a (c a)+         ) => Sets.HasInsert a (SetsWith k c a) where+  insert = insert++instance ( Ord k+         , Eq (c a)+         , Sets.HasEmpty (c a)+         , Sets.HasDelete a (c a)+         ) => Sets.HasDelete a (SetsWith k c a) where+  delete = delete++instance Sets.HasEmptyWith (a -> k) (SetsWith k c a) where+  emptyWith = empty++instance Sets.HasSize (SetsWith k c a) where+  size = size++instance ( Ord k+         , Eq (c a)+         , Sets.CanBeSubset (c a)+         ) => Sets.CanBeSubset (SetsWith k c a) where+  isSubsetOf = isSubsetOf++instance ( Ord k+         , Eq (c a)+         , Sets.CanBeSubset (c a)+         ) => Sets.CanBeProperSubset (SetsWith k c a) where+  isProperSubsetOf = isProperSubsetOf++-- * Operators++(\\) :: ( Ord k+        , Sets.HasDifference (c a)+        ) => SetsWith k c a -> SetsWith k c a -> SetsWith k c a+(SetsWith (f,xs)) \\ (SetsWith (_,ys)) = SetsWith+  (f, Map.unionWith Sets.difference xs (ys `Map.intersection` xs))++-- * Query++null :: SetsWith k c a -> Bool+null (SetsWith (_,xs)) = Map.null xs++size :: SetsWith k c a -> Int+size (SetsWith (_,xs)) = Map.size xs++member :: Ord k => a -> SetsWith k c a -> Bool+member x (SetsWith (f,xs)) = Map.member (f x) xs -- Depends on eager pruning++notMember :: Ord k => a -> SetsWith k c a -> Bool+notMember x = not . member x++lookupLT :: Ord k => a -> SetsWith k c a -> Maybe (c a)+lookupLT x (SetsWith (f,xs)) = snd <$> Map.lookupLT (f x) xs++lookupGT :: Ord k => a -> SetsWith k c a -> Maybe (c a)+lookupGT x (SetsWith (f,xs)) = snd <$> Map.lookupGT (f x) xs++lookupLE :: Ord k => a -> SetsWith k c a -> Maybe (c a)+lookupLE x (SetsWith (f,xs)) = snd <$> Map.lookupLE (f x) xs++lookupGE :: Ord k => a -> SetsWith k c a -> Maybe (c a)+lookupGE x (SetsWith (f,xs)) = snd <$> Map.lookupGE (f x) xs++isSubsetOf :: ( Ord k+              , Eq (c a)+              , Sets.CanBeSubset (c a)+              ) => SetsWith k c a -> SetsWith k c a -> Bool+isSubsetOf (SetsWith (_,xs)) (SetsWith (_,ys)) = Map.isSubmapOf xs ys &&+  and (getZipList $ Sets.isSubsetOf <$> (ZipList $ Map.elems $ xs `Map.intersection` ys)+                                    <*> (ZipList $ Map.elems $ ys `Map.intersection` xs))++isProperSubsetOf :: ( Ord k+                    , Eq (c a)+                    , Sets.CanBeSubset (c a)+                    ) => SetsWith k c a -> SetsWith k c a -> Bool+isProperSubsetOf xss yss =+  xss `isSubsetOf` yss && size xss < size yss++-- * Construction++empty :: (a -> k) -> SetsWith k c a+empty f = SetsWith (f, Map.empty)++singleton :: ( Ord k+             , Sets.HasUnion (c a)+             , Sets.HasSingleton a (c a)+             ) => (a -> k) -> a -> SetsWith k c a+singleton f x = insert x (empty f)++insert :: ( Ord k+          , Sets.HasUnion (c a)+          , Sets.HasSingleton a (c a)+          ) => a -> SetsWith k c a -> SetsWith k c a+insert x (SetsWith (f,xs)) = SetsWith+  (f, Map.insertWith Sets.union (f x) (Sets.singleton x) xs)++delete :: ( Ord k+          , Eq (c a)+          , Sets.HasEmpty (c a)+          , Sets.HasDelete a (c a)+          ) => a -> SetsWith k c a -> SetsWith k c a+delete x (SetsWith (f,xs)) =+  case Map.lookup (f x) xs of+    Just set -> if Sets.delete x set == Sets.empty+                then SetsWith (f, Map.delete (f x) xs)+                else SetsWith (f, Map.update (Just . Sets.delete x) (f x) xs)+    Nothing -> SetsWith (f,xs)++-- * Combine++union :: ( Ord k+         , Sets.HasUnion (c a)+         ) => SetsWith k c a -> SetsWith k c a -> SetsWith k c a+union (SetsWith (f,xs)) (SetsWith (_,ys)) = SetsWith+  (f, Map.unionWith Sets.union xs ys)++difference :: ( Ord k+              , Eq (c a)+              , Sets.HasEmpty (c a)+              , Sets.HasDifference (c a)+              ) => SetsWith k c a -> SetsWith k c a -> SetsWith k c a+difference (SetsWith (f,xs)) (SetsWith (_,ys)) = SetsWith+  (f, Map.filter (/= Sets.empty) $ Map.unionWith Sets.difference+        xs (ys `Map.intersection` xs))++intersection :: ( Ord k+                , Eq (c a)+                , Sets.HasEmpty (c a)+                , Sets.HasIntersection (c a)+                ) => SetsWith k c a -> SetsWith k c a -> SetsWith k c a+intersection (SetsWith (f,xs)) (SetsWith (_,ys)) = SetsWith+  (f, Map.filter (/= Sets.empty) $ Map.intersectionWith Sets.intersection xs ys)++-- -- * Filter++filter :: ( Eq (c a)+          , Sets.HasEmpty (c a)+          , Wither.Witherable c+          ) => (a -> Bool) -> SetsWith k c a -> SetsWith k c a+filter p (SetsWith (f,xs)) = SetsWith (f, Map.filter (/= Sets.empty) $+  Map.map (Wither.filter p) xs)++partition :: (c a -> Bool) -> SetsWith k c a -> (SetsWith k c a, SetsWith k c a)+partition p (SetsWith (f,xs)) = let zs = Map.partition p xs+                                in (SetsWith (f, fst zs), SetsWith (f, snd zs))++split :: Ord k => a -> SetsWith k c a -> (SetsWith k c a, SetsWith k c a)+split x (SetsWith (f,xs)) = let zs = Map.split (f x) xs+                            in (SetsWith (f, fst zs), SetsWith (f, snd zs))++splitMember :: Ord k => a -> SetsWith k c a -> (SetsWith k c a, Bool, SetsWith k c a)+splitMember x (SetsWith (f,xs)) = let (l,b,r) = Map.splitLookup (f x) xs+                                  in (SetsWith (f,l), isJust b, SetsWith (f,r))++splitRoot :: Ord k => SetsWith k c a -> [SetsWith k c a]+splitRoot (SetsWith (f,xs)) = let xss = Map.splitRoot xs+                              in fmap (\a -> SetsWith (f,a)) xss++-- -- * Indexed++lookupIndex :: Ord k => a -> SetsWith k c a -> Maybe Int+lookupIndex x (SetsWith (f,xs)) = Map.lookupIndex (f x) xs++findIndex :: Ord k => a -> SetsWith k c a -> Int+findIndex x (SetsWith (f,xs)) = Map.findIndex (f x) xs++setAt :: Int -> SetsWith k c a -> c a+setAt i (SetsWith (_,xs)) = snd $ Map.elemAt i xs++deleteAt :: Int -> SetsWith k c a -> SetsWith k c a+deleteAt i (SetsWith (f,xs)) = SetsWith (f, Map.deleteAt i xs)++-- -- * Map++map :: Functor c => (a -> b) -> (b -> a) -> SetsWith k c a -> SetsWith k c b+map f g (SetsWith (p,xs)) = SetsWith (p . g, Map.map (fmap f) xs)++mapMaybe :: ( Eq (c b)+            , Sets.HasEmpty (c b)+            , Wither.Witherable c+            ) => (a -> Maybe b) -> (b -> a) -> SetsWith k c a -> SetsWith k c b+mapMaybe f g (SetsWith (p,xs)) = SetsWith+  (p . g, Map.filter (/= Sets.empty) $ Map.map (Wither.mapMaybe f) xs)++-- -- * Folds++foldr :: Fold.Foldable c => (a -> b -> b) -> b -> SetsWith k c a -> b+foldr f acc (SetsWith (_,xs)) = Map.foldr go acc xs+  where+    go cs acc' = Fold.foldr f acc' cs++foldl :: Fold.Foldable c => (b -> a -> b) -> b -> SetsWith k c a -> b+foldl f acc (SetsWith (_,xs)) = Map.foldl go acc xs+  where+    go = Fold.foldl f++-- -- ** Strict Folds++foldr' :: Fold.Foldable c => (a -> b -> b) -> b -> SetsWith k c a -> b+foldr' f acc (SetsWith (_,xs)) = Map.foldr' go acc xs+  where+    go cs acc' = Fold.foldr' f acc' cs++foldl' :: Fold.Foldable c => (b -> a -> b) -> b -> SetsWith k c a -> b+foldl' f acc (SetsWith (_,xs)) = Map.foldl' go acc xs+  where+    go = Fold.foldl' f++-- -- ** Legacy Fold++fold :: Fold.Foldable c => (a -> b -> b) -> b -> SetsWith k c a -> b+fold f acc (SetsWith (_,xs)) = Map.fold go acc xs+  where+    go cs acc' = Fold.foldr f acc' cs++-- -- * Min/Max++findMin :: (Ord a, Fold.Foldable c) => SetsWith k c a -> a+findMin (SetsWith (_,xs)) = Fold.minimum $ snd $ Map.findMin xs++findMax :: (Ord a, Fold.Foldable c) => SetsWith k c a -> a+findMax (SetsWith (_,xs)) = Fold.maximum $ snd $ Map.findMax xs++-- | Deletes __entire set__ with minimum key+deleteMin :: SetsWith k c a -> SetsWith k c a+deleteMin (SetsWith (f,xs)) = SetsWith (f, Map.deleteMin xs)++deleteMax :: SetsWith k c a -> SetsWith k c a+deleteMax (SetsWith (f,xs)) = SetsWith (f, Map.deleteMax xs)++deleteFindMin :: SetsWith k c a -> (c a, SetsWith k c a)+deleteFindMin (SetsWith (f,xs)) = let ((_,l),zs) = Map.deleteFindMin xs+                                  in (l, SetsWith (f,zs))++deleteFindMax :: SetsWith k c a -> (c a, SetsWith k c a)+deleteFindMax (SetsWith (f,xs)) = let ((_,l),zs) = Map.deleteFindMax xs+                                  in (l, SetsWith (f,zs))++minView :: SetsWith k c a -> Maybe (c a, SetsWith k c a)+minView (SetsWith (f,xs)) = (\(l,a) -> (l, SetsWith (f,a))) <$> Map.minView xs++maxView :: SetsWith k c a -> Maybe (c a, SetsWith k c a)+maxView (SetsWith (f,xs)) = (\(l,a) -> (l, SetsWith (f,a))) <$> Map.maxView xs++-- -- * Conversion++elems :: ( Sets.HasUnion (c a)+         , Sets.HasEmpty (c a)+         ) => SetsWith k c a -> c a+elems (SetsWith (_,xs)) = Sets.unions $ Map.elems xs++toList :: SetsWith k c a -> (a -> k, [c a])+toList (SetsWith (f,xs)) = (f, Map.elems xs)++fromList :: ( Ord k+            , Sets.HasSingleton a (c a)+            , Sets.HasUnion (c a)+            ) => (a -> k) -> [a] -> SetsWith k c a+fromList f = Fold.foldr insert $ empty f++-- -- * Ordered List++toAscList :: SetsWith k c a -> [c a]+toAscList (SetsWith (_,xs)) = snd <$> Map.toAscList xs++toDescList :: SetsWith k c a -> [c a]+toDescList (SetsWith (_,xs)) = snd <$> Map.toDescList xs++fromAscList :: ( Eq k+               , Sets.HasSingleton a (c a)+               ) => (a -> k) -> [a] -> SetsWith k c a+fromAscList f xs = SetsWith (f, Map.fromAscList $ (f <$> xs) `zip` fmap Sets.singleton xs)++fromDistinctAscList :: Sets.HasSingleton a (c a) => (a -> k) -> [a] -> SetsWith k c a+fromDistinctAscList f xs = SetsWith (f, Map.fromDistinctAscList $ (f <$> xs) `zip` fmap Sets.singleton xs)++-- -- * Debugging++showTree :: (Show k, Show (c a)) => SetsWith k c a -> String+showTree (SetsWith (_,xs)) = Map.showTree xs++showTreeWith :: (k -> c a -> String) -> Bool -> Bool -> SetsWith k c a -> String+showTreeWith f a b (SetsWith (_,xs)) = Map.showTreeWith f a b xs
src/Data/Set/Ordered/Unique/Finite.hs view
@@ -5,6 +5,7 @@  newtype FiniteSet a = FiniteSet   { unFiniteSet :: (Set.Set a, Set.Set a) }+  deriving (Eq, Show)  -- * Operators
+ src/Data/Set/Ordered/Unique/With.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE+    GeneralizedNewtypeDeriving+  , NoImplicitPrelude+  #-}+++-- | Orient the ordering of your set by a different index, by first supplying a+-- function @(a -> k)@ to weigh each element. This module simply leverages+-- @Data.Map@, and does not use a novel data type.+--+-- Note: This data type can only have one element per distinguished weight. For+-- oriented multisets, use @Data.Set.Ordered.Many.With.SetsWith@.++module Data.Set.Ordered.Unique.With where++import Prelude (Show, String, Eq, Ord, Bool, Int, Maybe, fmap, not, fst, snd, zip, (.), ($))+import qualified Data.Map as Map+import qualified Data.List as List+import Data.Maybe (isJust)+import qualified Data.Foldable as Fold+import Data.Functor.Invariant+import Control.Applicative ((<$>))+import Data.Monoid (Monoid)+++newtype SetWith k a = SetWith {unSetWith :: (a -> k, Map.Map k a)}+  deriving (Monoid)++instance Invariant (SetWith k) where+  invmap = map++instance Fold.Foldable (SetWith k) where+  foldr = Data.Set.Ordered.Unique.With.foldr+++-- * Operators++(\\) :: Ord k => SetWith k a -> SetWith k a -> SetWith k a+(SetWith (f,xs)) \\ (SetWith (_,ys)) = SetWith (f, Map.difference xs ys)++-- * Query++null :: SetWith k a -> Bool+null (SetWith (_,xs)) = Map.null xs++size :: SetWith k a -> Int+size (SetWith (_,xs)) = Map.size xs++member :: Ord k => a -> SetWith k a -> Bool+member x (SetWith (f,xs)) = Map.member (f x) xs++notMember :: Ord k => a -> SetWith k a -> Bool+notMember x = not . member x++lookupLT :: Ord k => a -> SetWith k a -> Maybe a+lookupLT x (SetWith (f,xs)) = snd <$> Map.lookupLT (f x) xs++lookupGT :: Ord k => a -> SetWith k a -> Maybe a+lookupGT x (SetWith (f,xs)) = snd <$> Map.lookupGT (f x) xs++lookupLE :: Ord k => a -> SetWith k a -> Maybe a+lookupLE x (SetWith (f,xs)) = snd <$> Map.lookupLE (f x) xs++lookupGE :: Ord k => a -> SetWith k a -> Maybe a+lookupGE x (SetWith (f,xs)) = snd <$> Map.lookupGE (f x) xs++isSubsetOf :: (Eq a, Ord k) => SetWith k a -> SetWith k a -> Bool+isSubsetOf (SetWith (_,xs)) (SetWith (_,ys)) = Map.isSubmapOf xs ys++isProperSubsetOf :: (Eq a, Ord k) => SetWith k a -> SetWith k a -> Bool+isProperSubsetOf (SetWith (_,xs)) (SetWith (_,ys)) = Map.isProperSubmapOf xs ys++-- * Construction++empty :: (a -> k) -> SetWith k a+empty f = SetWith (f, Map.empty)++singleton :: Ord k => (a -> k) -> a -> SetWith k a+singleton f x = insert x (empty f)++insert :: Ord k => a -> SetWith k a -> SetWith k a+insert x (SetWith (f,xs)) = SetWith (f, Map.insert (f x) x xs)++delete :: Ord k => a -> SetWith k a -> SetWith k a+delete x (SetWith (f,xs)) = SetWith (f, Map.delete (f x) xs)++-- * Combine++union :: Ord k => SetWith k a -> SetWith k a -> SetWith k a+union (SetWith (f,xs)) (SetWith (_,ys)) = SetWith (f, Map.union xs ys)++unions :: Ord k => (a -> k) -> [SetWith k a] -> SetWith k a+unions f = List.foldl' union $ empty f++difference :: Ord k => SetWith k a -> SetWith k a -> SetWith k a+difference (SetWith (f,xs)) (SetWith (_,ys)) = SetWith (f, Map.difference xs ys)++intersection :: Ord k => SetWith k a -> SetWith k a -> SetWith k a+intersection (SetWith (f,xs)) (SetWith (_,ys)) = SetWith (f, Map.intersection xs ys)++-- * Filter++filter :: (a -> Bool) -> SetWith k a -> SetWith k a+filter p (SetWith (f,xs)) = SetWith (f, Map.filter p xs)++partition :: (a -> Bool) -> SetWith k a -> (SetWith k a, SetWith k a)+partition p (SetWith (f,xs)) = let zs = Map.partition p xs+                               in (SetWith (f, fst zs), SetWith (f, snd zs))++split :: Ord k => a -> SetWith k a -> (SetWith k a, SetWith k a)+split x (SetWith (f,xs)) = let zs = Map.split (f x) xs+                           in (SetWith (f, fst zs), SetWith (f, snd zs))++splitMember :: Ord k => a -> SetWith k a -> (SetWith k a, Bool, SetWith k a)+splitMember x (SetWith (f,xs)) = let (l,b,r) = Map.splitLookup (f x) xs+                                 in (SetWith (f,l), isJust b, SetWith (f,r))++splitRoot :: Ord k => SetWith k a -> [SetWith k a]+splitRoot (SetWith (f,xs)) = let xss = Map.splitRoot xs+                             in fmap (\a -> SetWith (f,a)) xss++-- * Indexed++lookupIndex :: Ord k => a -> SetWith k a -> Maybe Int+lookupIndex x (SetWith (f,xs)) = Map.lookupIndex (f x) xs++findIndex :: Ord k => a -> SetWith k a -> Int+findIndex x (SetWith (f,xs)) = Map.findIndex (f x) xs++elemAt :: Int -> SetWith k a -> a+elemAt i (SetWith (_,xs)) = snd $ Map.elemAt i xs++deleteAt :: Int -> SetWith k a -> SetWith k a+deleteAt i (SetWith (f,xs)) = SetWith (f, Map.deleteAt i xs)++-- * Map++map :: (a -> b) -> (b -> a) -> SetWith k a -> SetWith k b+map f g (SetWith (p,xs)) = SetWith (p . g, Map.map f xs)++mapMaybe :: (a -> Maybe b) -> (b -> a) -> SetWith k a -> SetWith k b+mapMaybe f g (SetWith (p,xs)) = SetWith (p . g, Map.mapMaybe f xs)++-- * Folds++foldr :: (a -> b -> b) -> b -> SetWith k a -> b+foldr f acc (SetWith (_,xs)) = Map.foldr f acc xs++foldl :: (b -> a -> b) -> b -> SetWith k a -> b+foldl f acc (SetWith (_,xs)) = Map.foldl f acc xs++-- ** Strict Folds++foldr' :: (a -> b -> b) -> b -> SetWith k a -> b+foldr' f acc (SetWith (_,xs)) = Map.foldr' f acc xs++foldl' :: (b -> a -> b) -> b -> SetWith k a -> b+foldl' f acc (SetWith (_,xs)) = Map.foldl' f acc xs++-- ** Legacy Fold++fold :: (a -> b -> b) -> b -> SetWith k a -> b+fold f acc (SetWith (_,xs)) = Map.fold f acc xs++-- * Min/Max++findMin :: SetWith k a -> a+findMin = snd . Map.findMin . snd . unSetWith++findMax :: SetWith k a -> a+findMax = snd . Map.findMax . snd . unSetWith++deleteMin :: SetWith k a -> SetWith k a+deleteMin (SetWith (f,xs)) = SetWith (f, Map.deleteMin xs)++deleteMax :: SetWith k a -> SetWith k a+deleteMax (SetWith (f,xs)) = SetWith (f, Map.deleteMax xs)++deleteFindMin :: SetWith k a -> (a, SetWith k a)+deleteFindMin (SetWith (f,xs)) = let ((_,l),zs) = Map.deleteFindMin xs+                                 in (l, SetWith (f,zs))++deleteFindMax :: SetWith k a -> (a, SetWith k a)+deleteFindMax (SetWith (f,xs)) = let ((_,l),zs) = Map.deleteFindMax xs+                                 in (l, SetWith (f,zs))++minView :: SetWith k a -> Maybe (a, SetWith k a)+minView (SetWith (f,xs)) = (\(l,a) -> (l, SetWith (f,a))) <$> Map.minView xs++maxView :: SetWith k a -> Maybe (a, SetWith k a)+maxView (SetWith (f,xs)) = (\(l,a) -> (l, SetWith (f,a))) <$> Map.maxView xs++-- * Conversion++elems :: SetWith k a -> [a]+elems (SetWith (_,xs)) = Map.elems xs++toList :: SetWith k a -> (a -> k, [a])+toList (SetWith (f,xs)) = (f, Map.elems xs)++fromList :: Ord k => (a -> k) -> [a] -> SetWith k a+fromList f = List.foldr insert $ empty f++-- * Ordered List++toAscList :: SetWith k a -> [a]+toAscList (SetWith (_,xs)) = snd <$> Map.toAscList xs++toDescList :: SetWith k a -> [a]+toDescList (SetWith (_,xs)) = snd <$> Map.toDescList xs++fromAscList :: Eq k => (a -> k) -> [a] -> SetWith k a+fromAscList f xs = SetWith (f, Map.fromAscList $ (f <$> xs) `zip` xs)++fromDistinctAscList :: (a -> k) -> [a] -> SetWith k a+fromDistinctAscList f xs = SetWith (f, Map.fromDistinctAscList $ (f <$> xs) `zip` xs)++-- * Debugging++showTree :: (Show k, Show a) => SetWith k a -> String+showTree (SetWith (_,xs)) = Map.showTree xs++showTreeWith :: (k -> a -> String) -> Bool -> Bool -> SetWith k a -> String+showTreeWith f a b (SetWith (_,xs)) = Map.showTreeWith f a b xs
src/Data/Set/Unordered/Many.hs view
@@ -7,6 +7,7 @@  import Data.Mergeable import Data.List as List hiding (delete)+import qualified Data.List as List import Data.Maybe (fromJust, isJust, mapMaybe)  @@ -18,10 +19,20 @@  -- | Pronounced "Unordered Many Set" newtype UMSet a = UMSet {unUMSet :: [a]}-  deriving (Functor)+  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  -- * Operators
src/Data/Set/Unordered/Unique.hs view
@@ -16,10 +16,20 @@  -- | Pronounced "Unordered Unique Set" newtype UUSet a = UUSet {unUUSet :: [a]}-  deriving (Functor)+  deriving (Functor, Show)  instance Mergeable UUSet where   mergeMap f (UUSet xs) = mergeMap f xs++instance Eq a => Eq (UUSet a) where+  (UUSet xs) == (UUSet 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  -- * Operators
+ test/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import Data.SetSpec++import Test.Tasty+++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Testing..." spec
− test/Spec.hs 
@@ -1,13 +0,0 @@-module Spec where--import Data.SetSpec--import Test.Tasty---main :: IO ()-main = defaultMain tests--tests :: TestTree-tests = testGroup "Testing..."-  [spec]