enummapmap 0.4.0 → 0.5.0
raw patch · 10 files changed
+480/−36 lines, 10 filesdep +data-defaultdep +hspec-expectationsdep +semigroupsdep ~hspecPVP ok
version bump matches the API change (PVP)
Dependencies added: data-default, hspec-expectations, semigroups
Dependency ranges changed: hspec
API changes (from Hackage documentation)
+ Data.EnumMapMap.Lazy: class Eq k => IsKey k where data family EnumMapMap k :: * -> * joinKey = removeEmpties . unsafeJoinKey map f = mapWithKey (\ _ -> f) toList = foldrWithKey (\ k x xs -> (k, x) : xs) [] fromList = foldlStrict (\ t (k, x) -> insert k x t) empty elems = foldr (:) [] keys = foldrWithKey (\ k _ ks -> k : ks) [] deleteFindMin = fromMaybe (error "deleteFindMin: empty EnumMapMap has no minimal element") . minViewWithKey unions = foldlStrict union empty unionsWith f = foldlStrict (unionWith f) empty unionWith f = unionWithKey (\ _ -> f) differenceWith f = differenceWithKey (\ _ -> f) intersectionWith f = intersectionWithKey (\ _ -> f)
+ Data.EnumMapMap.Lazy: class SubKey k1 k2 v where type family Result k1 k2 v :: * insertWith f = insertWithKey (\ _ -> f)
+ Data.EnumMapMap.Lazy: deleteFindMin :: IsKey k => EnumMapMap k v -> ((k, v), EnumMapMap k v)
+ Data.EnumMapMap.Lazy: findMin :: IsKey k => EnumMapMap k v -> (k, v)
+ Data.EnumMapMap.Lazy: instance (Eq k, Enum k) => Foldable (EnumMapMap (K k))
+ Data.EnumMapMap.Lazy: minViewWithKey :: IsKey k => EnumMapMap k v -> Maybe ((k, v), EnumMapMap k v)
+ Data.EnumMapMap.Lazy: unionsWith :: IsKey k => (v -> v -> v) -> [EnumMapMap k v] -> EnumMapMap k v
+ Data.EnumMapMap.Strict: class Eq k => IsKey k where data family EnumMapMap k :: * -> * joinKey = removeEmpties . unsafeJoinKey map f = mapWithKey (\ _ -> f) toList = foldrWithKey (\ k x xs -> (k, x) : xs) [] fromList = foldlStrict (\ t (k, x) -> insert k x t) empty elems = foldr (:) [] keys = foldrWithKey (\ k _ ks -> k : ks) [] deleteFindMin = fromMaybe (error "deleteFindMin: empty EnumMapMap has no minimal element") . minViewWithKey unions = foldlStrict union empty unionsWith f = foldlStrict (unionWith f) empty unionWith f = unionWithKey (\ _ -> f) differenceWith f = differenceWithKey (\ _ -> f) intersectionWith f = intersectionWithKey (\ _ -> f)
+ Data.EnumMapMap.Strict: class SubKey k1 k2 v where type family Result k1 k2 v :: * insertWith f = insertWithKey (\ _ -> f)
+ Data.EnumMapMap.Strict: deleteFindMin :: IsKey k => EnumMapMap k v -> ((k, v), EnumMapMap k v)
+ Data.EnumMapMap.Strict: findMin :: IsKey k => EnumMapMap k v -> (k, v)
+ Data.EnumMapMap.Strict: instance (Eq k, Enum k) => Foldable (EnumMapMap (K k))
+ Data.EnumMapMap.Strict: minViewWithKey :: IsKey k => EnumMapMap k v -> Maybe ((k, v), EnumMapMap k v)
+ Data.EnumMapMap.Strict: unionsWith :: IsKey k => (v -> v -> v) -> [EnumMapMap k v] -> EnumMapMap k v
+ Data.EnumMapSet: all :: IsKey k => (k -> Bool) -> EnumMapSet k -> Bool
+ Data.EnumMapSet: deleteFindMin :: IsKey k => EnumMapSet k -> (k, EnumMapSet k)
+ Data.EnumMapSet: findMin :: IsKey k => EnumMapSet k -> k
+ Data.EnumMapSet: minView :: IsKey k => EnumMapSet k -> Maybe (k, EnumMapSet k)
Files
- Data/EnumMapMap/Base.hs +81/−5
- Data/EnumMapMap/Lazy.hs +46/−2
- Data/EnumMapMap/Strict.hs +47/−4
- Data/EnumMapSet.hs +6/−1
- Data/EnumMapSet/Base.hs +62/−7
- enummapmap.cabal +25/−2
- test/EnumMapMapVsIntMap.hs +95/−10
- test/EnumMapSetVsIntSet.hs +35/−2
- test/UnitEnumMapMap.hs +51/−3
- test/UnitEnumMapSet.hs +32/−0
Data/EnumMapMap/Base.hs view
@@ -69,7 +69,10 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits-import Data.Monoid (Monoid(..))+import Data.Default+import qualified Data.Foldable as FOLD+import Data.Maybe (fromMaybe)+import Data.Semigroup import GHC.Exts (Word(..), Int(..), uncheckedShiftRL#, uncheckedShiftL#) @@ -326,12 +329,27 @@ -- | Build an 'EnumMapMap' from an 'EnumMapSet' and a function which for each -- key computes it's value fromSet :: HasSKey k => (k -> v) -> EnumMapMap (Skey k) () -> EnumMapMap k v+ -- | The minimal key and value of the 'EnumMapMap'.+ --+ -- > findMin empty -- ERROR, no minimal key+ -- > findMin $ fromList [(K 1, "a", K 3, "b")] == (K 1, a)+ findMin :: EnumMapMap k v -> (k, v)+ -- | Retrieves the minimal (key,value) pair of the EnumMapMap, and the+ -- EnumMapMap stripped of that element, or 'Nothing' if passed an empty map.+ minViewWithKey :: EnumMapMap k v -> Maybe ((k, v), EnumMapMap k v)+ deleteFindMin :: EnumMapMap k v -> ((k, v), EnumMapMap k v)+ deleteFindMin =+ fromMaybe(error "deleteFindMin: empty EnumMapMap has no minimal\+ \ element") . minViewWithKey -- | The (left-biased) union of two 'EnumMapMap's. -- It prefers the first 'EnumMapMap' when duplicate keys are encountered. union :: EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v -- | The union of a list of maps. unions :: [EnumMapMap k v] -> EnumMapMap k v unions = foldlStrict union empty+ -- | The union of a list of maps with a combining function+ unionsWith :: (v -> v -> v) -> [EnumMapMap k v] -> EnumMapMap k v+ unionsWith f = foldlStrict (unionWith f) empty -- | The union with a combining function. unionWith :: (v -> v -> v) -> EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v@@ -426,7 +444,7 @@ tip k1 $ differenceSet x1 x2 instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where- data EnumMapMap (k :& t) v = KCC (EMM k (EnumMapMap t v))+ newtype EnumMapMap (k :& t) v = KCC (EMM k (EnumMapMap t v)) emptySubTrees e@(KCC emm) = case emm of@@ -480,6 +498,38 @@ where go k = fromSet (\nxt -> f $! k :& nxt) + findMin (KCC emm) =+ case emm of+ Nil -> error "findMin: no minimal element"+ Tip k v -> (toEnum k :& t, v')+ where (t, v') = findMin v+ Bin _ m l r+ | m < 0 -> go r+ | otherwise -> go l+ where go (Tip k v) = (toEnum k :& t, v')+ where (t, v') = findMin v+ go (Bin _ _ l' _) = go l'+ go Nil = error "findMin: Nil"++ minViewWithKey (KCC emm) =+ goat emm >>= \(r, emm') -> return (r, KCC $ emm')+ where+ goat t =+ case t of+ Nil -> Nothing+ Bin p m l r | m < 0 ->+ case go r of+ (result, r') ->+ Just (result, binD p m l r')+ _ -> Just (go t)+ go (Bin p m l r) = case go l of+ (result, l') -> (result, binD p m l' r)+ go (Tip k y) = case minViewWithKey y of+ Just ((t, v), y') ->+ (((toEnum k) :& t, v), tip k y')+ Nothing -> error "minViewWithKey: Nothing"+ go Nil = error "minViewWithKey Nil"+ union (KCC emm1) (KCC emm2) = KCC $ mergeWithKey' binD go id id emm1 emm2 where go = \(Tip k1 x1) (Tip _ x2) -> tip k1 $ union x1 x2@@ -662,11 +712,18 @@ where fmap = map -instance (IsKey k) => Monoid (EnumMapMap k v) where+-- | This instance differs from the 'Monoid' instance in 'IntMap'. Where the keys+-- are the same the values are combined using 'mappend'.+instance (IsKey k, Semigroup v) => Monoid (EnumMapMap k v) where mempty = empty- mappend = union- mconcat = unions+ mappend = unionWith (<>)+ mconcat = unionsWith (<>) +instance (IsKey k, Semigroup v) =>+ Semigroup (EnumMapMap k v) where+ (<>) = unionWith (<>)+ times1p _ a = a+ instance (Show v, Show (EnumMapMap t v)) => Show (EnumMapMap (k :& t) v) where show (KCC emm) = show emm @@ -682,6 +739,23 @@ where rnf (k :& t) = rnf k `seq` rnf t +instance (FOLD.Foldable (EnumMapMap t), Enum k, Eq k, IsKey t, HasSKey t) =>+ FOLD.Foldable (EnumMapMap (k :& t)) where+ fold (KCC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = FOLD.fold v+ go (Bin _ _ l r) = go l `mappend` go r+ foldr = foldr+ foldMap f (KCC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = FOLD.foldMap f v+ go (Bin _ _ l r) = go l `mappend` go r++instance (IsKey k) => Default (EnumMapMap k v) where+ def = empty+ {-------------------------------------------------------------------- Nat conversion --------------------------------------------------------------------}@@ -697,6 +771,8 @@ shiftRL, shiftLL :: Nat -> Int -> Nat shiftRL (W# x) (I# i) = W# (uncheckedShiftRL# x i) shiftLL (W# x) (I# i) = W# (uncheckedShiftL# x i)+{-# INLINE shiftRL #-}+{-# INLINE shiftLL #-} {-------------------------------------------------------------------- Join
Data/EnumMapMap/Lazy.hs view
@@ -34,7 +34,7 @@ emptySubTrees, -- * Key types- (:&)(..), K(..),+ (:&)(..), K(..), IsKey, SubKey, Result, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, -- * Map Type EnumMapMap,@@ -59,6 +59,7 @@ unionWith, unionWithKey, unions,+ unionsWith, -- ** Difference difference, differenceWith,@@ -82,6 +83,10 @@ elems, keysSet, fromSet,+ -- * Min/Max+ findMin,+ minViewWithKey,+ deleteFindMin, -- * Split/Join Keys toK, toS,@@ -94,6 +99,8 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits+import qualified Data.Foldable as FOLD+import Data.Semigroup import Data.EnumMapMap.Base import qualified Data.EnumMapSet.Base as EMS@@ -107,7 +114,7 @@ deriving (Show, Eq) instance (Enum k, Eq k) => IsKey (K k) where- data EnumMapMap (K k) v = KEC (EMM k v)+ newtype EnumMapMap (K k) v = KEC (EMM k v) emptySubTrees e@(KEC emm) = case emm of@@ -183,6 +190,30 @@ computeBm !acc Nil = acc fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) emm+ findMin (KEC emm) =+ case emm of+ Nil -> error "findMin: no minimal element"+ Tip k v -> (K $ toEnum k, v)+ Bin _ m l r+ | m < 0 -> go r+ | otherwise -> go l+ where go (Tip k v) = (K $ toEnum k, v)+ go (Bin _ _ l' _) = go l'+ go Nil = error "findMin: Nil"+ minViewWithKey (KEC emm) =+ goat emm >>= \(r, emm') -> return (r, KEC $ emm')+ where+ goat t =+ case t of Nil -> Nothing+ Bin p m l r | m < 0 ->+ case go r of+ (result, r') ->+ Just (result, bin p m l r')+ _ -> Just (go t)+ go (Bin p m l r) = case go l of+ (result, l') -> (result, bin p m l' r)+ go (Tip k y) = ((K $ toEnum k, y), Nil)+ go Nil = error "minViewWithKey Nil" union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2 unionWithKey f (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin go id id emm1 emm2@@ -228,6 +259,19 @@ instance (NFData k) => NFData (K k) where rnf (K k) = rnf k++instance (Eq k, Enum k) => FOLD.Foldable (EnumMapMap (K k)) where+ fold (KEC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = v+ go (Bin _ _ l r) = go l `mappend` go r+ foldr = foldr+ foldMap f (KEC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = f v+ go (Bin _ _ l r) = go l `mappend` go r instance HasSKey (K k) where type Skey (K k) = EMS.S k
Data/EnumMapMap/Strict.hs view
@@ -34,7 +34,7 @@ emptySubTrees, -- * Key types- (:&)(..), K(..),+ (:&)(..), K(..), IsKey, SubKey, Result, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, -- * Map Type EnumMapMap,@@ -59,6 +59,7 @@ unionWith, unionWithKey, unions,+ unionsWith, -- ** Difference difference, differenceWith,@@ -69,8 +70,7 @@ intersectionWith, intersectionWithKey, intersectSet,- -- * Traversal- -- ** Map+ -- * Map map, mapWithKey, -- * Folds@@ -83,6 +83,10 @@ elems, keysSet, fromSet,+ -- * Min/Max+ findMin,+ minViewWithKey,+ deleteFindMin, -- * Split/Join Keys toK, toS,@@ -95,6 +99,8 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits+import qualified Data.Foldable as FOLD+import Data.Semigroup import Data.EnumMapMap.Base import qualified Data.EnumMapSet.Base as EMS@@ -108,7 +114,7 @@ deriving (Show, Eq) instance (Enum k, Eq k) => IsKey (K k) where- data EnumMapMap (K k) v = KEC (EMM k v)+ newtype EnumMapMap (K k) v = KEC (EMM k v) emptySubTrees e@(KEC emm) = case emm of@@ -182,6 +188,30 @@ computeBm !acc (Tip kx _) = acc .|. EMS.bitmapOf kx computeBm !acc Nil = acc fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) emm+ findMin (KEC emm) =+ case emm of+ Nil -> error "findMin: no minimal element"+ Tip k v -> (K $ toEnum k, v)+ Bin _ m l r+ | m < 0 -> go r+ | otherwise -> go l+ where go (Tip k v) = (K $ toEnum k, v)+ go (Bin _ _ l' _) = go l'+ go Nil = error "findMin: Nil"+ minViewWithKey (KEC emm) =+ goat emm >>= \(r, emm') -> return (r, KEC $ emm')+ where+ goat t =+ case t of Nil -> Nothing+ Bin p m l r | m < 0 ->+ case go r of+ (result, r') ->+ Just (result, bin p m l r')+ _ -> Just (go t)+ go (Bin p m l r) = case go l of+ (result, l') -> (result, bin p m l' r)+ go (Tip k y) = ((K $ toEnum k, y), Nil)+ go Nil = error "minViewWithKey Nil" union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2 unionWithKey f (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin go id id emm1 emm2@@ -229,6 +259,19 @@ instance (NFData k) => NFData (K k) where rnf (K k) = rnf k++instance (Eq k, Enum k) => FOLD.Foldable (EnumMapMap (K k)) where+ fold (KEC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = v+ go (Bin _ _ l r) = go l `mappend` go r+ foldr = foldr+ foldMap f (KEC emm) = go emm+ where+ go Nil = mempty+ go (Tip _ v) = f v+ go (Bin _ _ l r) = go l `mappend` go r instance HasSKey (K k) where type Skey (K k) = EMS.S k
Data/EnumMapSet.hs view
@@ -45,10 +45,15 @@ EMS.map, -- * Folds EMS.foldr,+ EMS.all, -- * Lists toList, fromList,- keys+ keys,+ -- * Min/Max+ findMin,+ minView,+ deleteFindMin ) where import Data.EnumMapSet.Base as EMS
Data/EnumMapSet/Base.hs view
@@ -39,10 +39,15 @@ map, -- * Folds foldr,+ all, -- * Lists toList, fromList, keys,+ -- * Min/Max+ findMin,+ minView,+ deleteFindMin, -- * Internals EMS(..), EnumMapMap(KSC),@@ -52,15 +57,12 @@ prefixOf ) where -import Prelude hiding (lookup,- map,- filter,- foldr, foldl,- null, init,- head, tail)+import Prelude hiding (lookup, map, filter, foldr, foldl,+ null, init, head, tail, all) import Data.Bits import qualified Data.List as List+import Data.Maybe (fromMaybe) import GHC.Exts (Word(..), Int(..)) import GHC.Prim (indexInt8OffAddr#) #include "MachDeps.h"@@ -98,7 +100,7 @@ deriving (Show) instance (Enum k, Eq k) => IsKey (S k) where- data EnumMapMap (S k) v = KSC (EMS k)+ newtype EnumMapMap (S k) v = KSC (EMS k) emptySubTrees e@(KSC emm) = case emm of@@ -137,6 +139,35 @@ go init' (Bin _ _ l r) = go (go init' r) l f' !k t = f (S $ toEnum k) undefined t + findMin (KSC ems) =+ case ems of+ Nil -> error "findMin: no minimal element"+ Tip k bm -> (S $ toEnum $ k + lowestBitSet bm, undefined)+ Bin _ m l r+ | m < 0 -> go r+ | otherwise -> go l+ where go (Tip k bm) = (S $ toEnum $ k + lowestBitSet bm, undefined)+ go (Bin _ _ l' _) = go l'+ go Nil = error "findMin: Nil"++ minViewWithKey (KSC ems) =+ goat ems >>= (\(k, r) -> return ((S $ toEnum k, undefined), KSC r))+ where+ goat t =+ case t of Nil -> Nothing+ Bin p m l r | m < 0 ->+ case go r of+ (result, r') ->+ Just (result, bin p m l r')+ _ -> Just (go t)+ go (Bin p m l r) = case go l of+ (result, l') -> (result, bin p m l' r)+ go (Tip kx bm) = case lowestBitSet bm of+ bi -> (kx + bi,+ tip kx (bm .&. complement+ (bitmapOfSuffix bi)))+ go Nil = error "minView Nil"+ union (KSC ems1) (KSC ems2) = KSC $ go ems1 ems2 where go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)@@ -316,6 +347,12 @@ where go k _ z = f k z +all :: (IsKey k) => (k -> Bool) -> EnumMapSet k -> Bool+all f = foldr go True+ where+ go _ False = False+ go k True = f k+ -- | @'map' f s@ is the set obtained by applying @f@ to each element of @s@. -- -- It's worth noting that the size of the result may be smaller if,@@ -324,6 +361,17 @@ (k1 -> k2) -> EnumMapSet k1 -> EnumMapSet k2 map f = fromList . List.map f . toList +findMin :: (IsKey k) => EnumMapSet k -> k+findMin = fst . EMM.findMin++minView :: (IsKey k) => EnumMapSet k -> Maybe (k, EnumMapSet k)+minView ems = EMM.minViewWithKey ems >>= \((k, _), ems') -> return (k, ems')++deleteFindMin :: (IsKey k) => EnumMapSet k -> (k, EnumMapSet k)+deleteFindMin =+ fromMaybe (error "deleteFindMin: empty EnumMapSet has no minimal element")+ . minView+ union :: (IsKey k) => EnumMapSet k -> EnumMapSet k -> EnumMapSet k union = EMM.union @@ -436,6 +484,9 @@ insertWith = undefined insertWithKey = undefined +instance (Show v) => Show (EnumMapMap (S k) v) where+ show (KSC ems) = show ems+ {--------------------------------------------------------------------- Helper functions ---------------------------------------------------------------------}@@ -574,3 +625,7 @@ | otherwise = case lowestBitMask bm of bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of bi -> bi `seq` go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)++lowestBitSet :: Nat -> Int+lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)+{-# INLINE lowestBitSet #-}
enummapmap.cabal view
@@ -1,5 +1,5 @@ name: enummapmap-version: 0.4.0+version: 0.5.0 synopsis: Map of maps using Enum types as keys description: This package provides 'maps of maps' using Enum types as keys. The code is based upon Data.IntMap in@@ -22,8 +22,10 @@ Data.EnumMapSet other-modules: Data.EnumMapMap.Base, Data.EnumMapSet.Base build-depends: base >= 4.0 && < 5,+ data-default, deepseq >= 1.2 && < 1.4,- ghc-prim+ ghc-prim,+ semigroups >= 0.8 ghc-options: -Wall -O2 default-language: Haskell2010 @@ -37,7 +39,9 @@ HUnit, QuickCheck >= 2, hspec >= 1.3,+ hspec-expectations, deepseq >= 1.2 && < 1.4,+ semigroups >= 0.8, enummapmap cpp-options: -DTESTING -DLAZY @@ -52,6 +56,7 @@ QuickCheck >= 2, hspec >= 1.3, deepseq >= 1.2 && < 1.4,+ semigroups >= 0.8, containers >= 0.4.2, enummapmap cpp-options: -DTESTING -DLAZY@@ -66,7 +71,9 @@ HUnit, QuickCheck >= 2, hspec >= 1.3,+ hspec-expectations, deepseq >= 1.2 && < 1.4,+ semigroups >= 0.8, enummapmap cpp-options: -DTESTING -DSTRICT @@ -81,9 +88,25 @@ QuickCheck >= 2, hspec >= 1.3, deepseq >= 1.2 && < 1.4,+ semigroups >= 0.8, containers >= 0.4.2, enummapmap cpp-options: -DTESTING -DSTRICT++Test-Suite test-enummapset+ type: exitcode-stdio-1.0+ main-is: UnitEnumMapSet.hs+ hs-source-dirs: test+ ghc-options: -Wall -O2+ default-language: Haskell2010+ build-depends: base >= 4.0 && < 5,+ HUnit,+ QuickCheck >= 2,+ hspec >= 1.3,+ hspec-expectations,+ deepseq >= 1.2 && < 1.4,+ containers >= 0.4.2,+ enummapmap Test-Suite test-enummapset-intset type: exitcode-stdio-1.0
test/EnumMapMapVsIntMap.hs view
@@ -6,13 +6,18 @@ -- 'EnumMapMap' one by one for each function. It does not check that empty -- EnumMapMaps are removed. -import Test.Hspec.Monadic+import Test.Hspec+ import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ()+import Test.QuickCheck ((==>)) import qualified Data.IntSet as IS import Data.EnumMapSet (S(..)) import qualified Data.EnumMapSet as EMS+import Data.Foldable (foldMap, fold)+import qualified Data.List as L+import Data.Semigroup+ #ifdef LAZY import qualified Data.IntMap as IM @@ -58,6 +63,15 @@ set2l4 :: Int -> Int -> Int -> [Int] -> [Int :& Int :& Int :& S Int] set2l4 s1 s2 s3 = map (\s -> s :& s1 :& s2 :& S s3) +unKey1 :: K k -> k+unKey1 (K k) = k+unKey2 :: k1 :& K k2 -> k1+unKey2 (k :& K _) = k+unKey3 :: k1 :& k2 :& K k3 -> k1+unKey3 (k :& _ :& K _) = k+unKey4 :: k1 :& k2 :& k3 :& K k4 -> k1+unKey4 (k :& _ :& _ :& K _) = k+ -- | Run functions on an 'IntMap' and an 'EnumMapMap' created from list and check -- that the results are equal runProp :: Eq t =>@@ -381,18 +395,69 @@ describe "mapWithKey" $ do let f k a = k + a prop "Level 1" $- runPropL (IM.mapWithKey f) (EMM.mapWithKey- (\(K k) -> f k))+ runPropL (IM.mapWithKey f) (EMM.mapWithKey (f . unKey1)) prop "Level 2" $- runPropL2 (IM.mapWithKey f) (EMM.mapWithKey- (\(k :& K _) -> f k))+ runPropL2 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey2)) prop "Level 3" $- runPropL3 (IM.mapWithKey f) (EMM.mapWithKey- (\(k :& _ :& K _) -> f k))+ runPropL3 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey3)) prop "Level 4" $- runPropL4 (IM.mapWithKey f) (EMM.mapWithKey- (\(k :& _ :& _ :& K _) -> f k))+ runPropL4 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey4)) + describe "findMin" $ do+ let go f (a, b) = (f a, b)+ prop "Level 1" $ \list ->+ (not $ L.null list) ==>+ runProp (IM.findMin) (go unKey1 . EMM.findMin) list+ prop "Level 2" $ \k1 list ->+ (not $ L.null list) ==>+ runProp2 (IM.findMin) (go unKey2 . EMM.findMin) k1 list+ prop "Level 3" $ \k1 k2 list ->+ (not $ L.null list) ==>+ runProp3 (IM.findMin) (go unKey3 . EMM.findMin) k1 k2 list+ prop "Level 4" $ \k1 k2 k3 list ->+ (not $ L.null list) ==>+ runProp4 (IM.findMin) (go unKey4 . EMM.findMin) k1 k2 k3 list++ describe "minViewWithKey" $ do+ let goe _ Nothing = Nothing+ goe f (Just ((k, v), emm)) = Just ((f k, v), EMM.toList emm)+ goi _ Nothing = Nothing+ goi f (Just ((k, v), im)) = Just ((k, v), f $ IM.toList im)+ prop "Level 1" $+ runProp (goi list2l1 . IM.minViewWithKey)+ (goe unKey1 . EMM.minViewWithKey)+ prop "Level 2" $ \k1 ->+ runProp2 (goi (list2l2 k1) . IM.minViewWithKey)+ (goe unKey2 . EMM.minViewWithKey) k1+ prop "Level 3" $ \k1 k2 ->+ runProp3 (goi (list2l3 k1 k2) . IM.minViewWithKey)+ (goe unKey3 . EMM.minViewWithKey) k1 k2+ prop "Level 4" $ \k1 k2 k3 ->+ runProp4 (goi (list2l4 k1 k2 k3) . IM.minViewWithKey)+ (goe unKey4 . EMM.minViewWithKey) k1 k2 k3++ describe "deleteFindMin" $ do+ let goe _ Nothing = Nothing+ goe f (Just ((k, v), emm)) = Just ((f k, v), EMM.toList emm)+ goi _ Nothing = Nothing+ goi f (Just ((k, v), im)) = Just ((k, v), f $ IM.toList im)+ prop "Level 1" $ \list ->+ (not $ L.null list) ==>+ runProp (goi list2l1 . IM.minViewWithKey)+ (goe unKey1 . EMM.minViewWithKey) list+ prop "Level 2" $ \k1 list ->+ (not $ L.null list) ==>+ runProp2 (goi (list2l2 k1) . IM.minViewWithKey)+ (goe unKey2 . EMM.minViewWithKey) k1 list+ prop "Level 3" $ \k1 k2 list ->+ (not $ L.null list) ==>+ runProp3 (goi (list2l3 k1 k2) . IM.minViewWithKey)+ (goe unKey3 . EMM.minViewWithKey) k1 k2 list+ prop "Level 4" $ \k1 k2 k3 list ->+ (not $ L.null list) ==>+ runProp4 (goi (list2l4 k1 k2 k3) . IM.minViewWithKey)+ (goe unKey4 . EMM.minViewWithKey) k1 k2 k3 list+ describe "union" $ do prop "Level 1" $ runPropDuoL IM.union EMM.union@@ -480,3 +545,23 @@ prop "Level 4" $ \ s1 s2 s3 -> runProp4 (set2l4 s1 s2 s3 . IS.toList . IM.keysSet) (EMS.toList . EMM.keysSet) s1 s2 s3++ describe "foldable instance" $ do+ describe "foldMap" $ do+ prop "Level 1" $+ runProp (foldMap (All . (> 5))) (foldMap (All . (> 5)))+ prop "Level 2" $+ runProp2 (foldMap (All . (> 5))) (foldMap (All . (> 5)))+ prop "Level 3" $+ runProp3 (foldMap (All . (> 5))) (foldMap (All . (> 5)))+ prop "Level 4" $+ runProp4 (foldMap (All . (> 5))) (foldMap (All . (> 5)))+ describe "fold" $ do+ prop "Level 1" $+ runProp (fold . IM.map Sum) (fold . EMM.map Sum)+ prop "Level 2" $+ runProp2 (fold . IM.map Sum) (fold . EMM.map Sum)+ prop "Level 3" $+ runProp3 (fold . IM.map Sum) (fold . EMM.map Sum)+ prop "Level 4" $+ runProp4 (fold . IM.map Sum) (fold . EMM.map Sum)
test/EnumMapSetVsIntSet.hs view
@@ -4,11 +4,12 @@ -- | This uses QuickCheck to try to check that an 'EnumMapSet' -- behaves in the same way as an 'IntSet'. -import Test.Hspec.Monadic+import Test.Hspec import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ()+import Test.QuickCheck ((==>)) import qualified Data.IntSet as IS+import qualified Data.List as L import Data.EnumMapSet(EnumMapSet, (:&)(..), S(..)) import qualified Data.EnumMapSet as EMS@@ -26,6 +27,13 @@ list2l3 :: Int -> Int -> [Int] -> [Int :& Int :& S Int] list2l3 k1 k2 = map (\k -> k :& k1 :& S k2) +unKey1 :: S k -> k+unKey1 (S k) = k+unKey2 :: k1 :& S k2 -> k1+unKey2 (k :& S _) = k+unKey3 :: k1 :& k2 :& S k3 -> k1+unKey3 (k :& _ :& S _) = k+ runProp :: Eq t => (IS.IntSet -> t) -> (TestSet1 -> t)@@ -175,6 +183,31 @@ prop "Level 3" $ runPropL3 (IS.map f) (EMS.map (\(k :& k2 :& S k1) -> f k :& k2 :& S k1))++ describe "findMin" $ do+ prop "Level 1" $ \list ->+ (not $ L.null list) ==>+ runProp (IS.findMin) (unKey1 . EMS.findMin) list+ prop "Level 2" $ \k1 list ->+ (not $ L.null list) ==>+ runProp2 (IS.findMin) (unKey2 . EMS.findMin) k1 list+ prop "Level 3" $ \k1 k2 list ->+ (not $ L.null list) ==>+ runProp3 (IS.findMin) (unKey3 . EMS.findMin) k1 k2 list++ describe "minView" $ do+ let goe _ Nothing = Nothing+ goe f (Just (k, ems)) = Just (f k, EMS.toList ems)+ goi _ Nothing = Nothing+ goi f (Just (k, is)) = Just (k, f $ IS.toList is)+ prop "Level 1" $+ runProp (goi list2l1 . IS.minView) (goe unKey1 . EMS.minView)+ prop "Level 2" $ \k1 ->+ runProp2 (goi (list2l2 k1) . IS.minView)+ (goe unKey2 . EMS.minView) k1+ prop "Level 3" $ \k1 k2 ->+ runProp3 (goi (list2l3 k1 k2) . IS.minView)+ (goe unKey3 . EMS.minView) k1 k2 describe "union" $ do prop "Level 1" $
test/UnitEnumMapMap.hs view
@@ -1,12 +1,23 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeOperators #-}+{-# LANGUAGE+ CPP,+ FlexibleContexts,+ FlexibleInstances,+ GeneralizedNewtypeDeriving,+ ScopedTypeVariables,+ TypeFamilies,+ TypeOperators,+ UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +import Control.Exception import Control.Monad (liftM, liftM2)+import Data.Semigroup+import Test.Hspec.Expectations import Test.Hspec.HUnit ()-import Test.Hspec.Monadic+import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.HUnit-import Test.QuickCheck (Arbitrary, arbitrary, shrink)+import Test.QuickCheck (Arbitrary, arbitrary, shrink, listOf) import qualified Data.EnumMapSet as EMS #ifdef LAZY@@ -25,6 +36,14 @@ instance (Arbitrary a) => Arbitrary (K a) where arbitrary = liftM K arbitrary +instance (Arbitrary k, Arbitrary v,+ EMM.IsKey k, EMM.SubKey k k v, EMM.Result k k v ~ v) =>+ Arbitrary (EnumMapMap k v) where+ arbitrary = fmap EMM.fromList $ listOf $ do+ key <- arbitrary+ val <- arbitrary+ return (key, val)+ newtype ID1 = ID1 Int deriving (Show, Enum, Arbitrary, Eq, Num) newtype ID2 = ID2 Int@@ -36,6 +55,7 @@ type TestEmm1 = EnumMapMap TestKey1 Int type TestKey2 = ID2 :& K ID1 type TestEmm2 = EnumMapMap TestKey2 Int+type TestEmm2B = EnumMapMap TestKey2 Bool type TestKey3 = ID3 :& ID2 :& K ID1 type TestEmm3 = EnumMapMap TestKey3 Int @@ -334,3 +354,31 @@ it "leaves correct subtree" $ (EMM.differenceSet l2odds $ EMS.fromList [s 3, s 4, s 5]) @?= EMM.fromList [(1 :& k 1, 1), (1 :& k 3, 3), (1 :& k 5, 5)]++ describe "findMin" $ do+ it "throws an error when it is passed an empty EnumMapMap" $ do+ evaluate (EMM.findMin (EMM.empty :: EnumMapMap (K Int) Int))+ `shouldThrow` anyErrorCall++ describe "deleteFindMin" $ do+ it "throws an error when it is passed an empty EnumMapMap" $ do+ evaluate (EMM.deleteFindMin (EMM.empty :: EnumMapMap (K Int) Int))+ `shouldThrow` anyErrorCall++ describe "Monoid/Semigroup instances" $ do+ let uvsm :: TestEmm3 -> TestEmm3 -> Bool+ uvsm emm1 emm2 =+ ((EMM.map Sum emm1) <> (EMM.map Sum emm2)) ==+ ( EMM.map Sum $ EMM.unionWith (+) emm1 emm2)+ prop "mappend works like unionWith mappend" uvsm+ let lvsi :: TestEmm3 -> TestEmm3 -> Bool+ lvsi emm1 emm2+ = ((EMM.map First emm1) <> (EMM.map First emm2)) ==+ (EMM.map First $ EMM.union emm1 emm2)+ prop "(<>) First works like union" lvsi+ let bvsu :: [TestEmm2B] -> Bool+ bvsu emms =+ (mconcat $ map (EMM.map All) emms) ==+ (EMM.map All $ EMM.unionsWith (&&) emms)+ prop "unionsWith (&&) works like mconcat All" bvsu+
+ test/UnitEnumMapSet.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP, TypeOperators #-}++import Test.Hspec.Expectations+import Test.Hspec.HUnit ()+import Test.Hspec.QuickCheck (prop)+import Test.Hspec++import Data.EnumMapSet (EnumMapSet, (:&)(..), S(..))+import qualified Data.EnumMapSet as EMS+import qualified Data.List as List++main :: IO ()+main =+ hspec $ do+ describe "all" $ do+ let f :: S Int -> Bool+ f (S s) = s > 0+ it "returns True for an empty EnumMapSet" $+ EMS.all (const False) (EMS.empty :: EnumMapSet (Int :& S Int))+ `shouldBe` True+ it "returns False when given all False" $+ EMS.all (const False) (EMS.fromList [S 1, S (2 :: Int)])+ `shouldBe` False+ it "returns False when given one False" $+ EMS.all f (EMS.fromList [S 5, S 2, S (-1),S 1000])+ `shouldBe` False+ let prop_list :: [Int] -> Bool+ prop_list list =+ let list' = map S list in+ EMS.all f (EMS.fromList list') == List.all f list'+ prop "is equivalent to List.all" prop_list+