enummapset-0.6.0.1/0000755000000000000000000000000000000000000012161 5ustar0000000000000000enummapset-0.6.0.1/Data/0000755000000000000000000000000000000000000013032 5ustar0000000000000000enummapset-0.6.0.1/Data/EnumMap.hs0000644000000000000000000000475200000000000014740 0ustar0000000000000000-- Note that all these extensions are only needed for @Whoops@ & Co -- and only as long as "Utils.Containers.Internal.TypeError" -- is not exposed in the containers package -- (see https://github.com/haskell/containers/issues/586). {-# LANGUAGE CPP, DataKinds, FlexibleContexts, FlexibleInstances, KindSignatures, TypeFamilies, UndecidableInstances #-} -- | -- Module : $Header$ -- Description : Data.IntMap with Enum keys. -- Copyright : (c) 2011-2019 Michal Terepeta -- License : BSD3 -- Maintainer : mikolaj.konarski@funktory.com -- Stability : alpha -- Portability : uses DeriveDataTypeable and GeneralizedNewtypeDeriving -- This is a simple wrapper for 'Data.IntMap' that works with any type of keys -- that are instances of 'Enum' type class. For documentation please see the -- one for 'Data.IntMap'. module Data.EnumMap ( module Data.EnumMap.Lazy #ifdef __GLASGOW_HASKELL__ -- For GHC, we disable these, pending removal. For anything else, -- we just don't define them at all. , insertWith' , insertWithKey' , fold , foldWithKey #endif ) where import Data.EnumMap.Lazy #ifdef __GLASGOW_HASKELL__ -- Unfortunately we can't access this module: -- import Utils.Containers.Internal.TypeError -- so we copy-paste things first: import GHC.TypeLits class Whoops (a :: Symbol) #if __GLASGOW_HASKELL__ >= 800 instance TypeError ('Text a) => Whoops a #endif -- | This function is being removed and is no longer usable. -- Use 'Data.EnumMap.Strict.insertWith' insertWith' :: Whoops "Data.EnumMap.insertWith' is gone. Use Data.EnumMap.Strict.insertWith." => (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWith' _ _ _ _ = undefined -- | This function is being removed and is no longer usable. -- Use 'Data.EnumMap.Strict.insertWithKey'. insertWithKey' :: Whoops "Data.EnumMap.insertWithKey' is gone. Use Data.EnumMap.Strict.insertWithKey." => (k -> a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWithKey' _ _ _ _ = undefined -- | This function is being removed and is no longer usable. -- Use 'Data.EnumMap.Lazy.foldr'. fold :: Whoops "Data.EnumMap.fold' is gone. Use Data.EnumMap.foldr or Prelude.foldr." => (a -> b -> b) -> b -> EnumMap k a -> b fold _ _ _ = undefined -- | This function is being removed and is no longer usable. -- Use 'foldrWithKey'. foldWithKey :: Whoops "Data.EnumMap.foldWithKey is gone. Use foldrWithKey." => (k -> a -> b -> b) -> b -> EnumMap k a -> b foldWithKey _ _ _ = undefined #endif enummapset-0.6.0.1/Data/EnumMap/0000755000000000000000000000000000000000000014374 5ustar0000000000000000enummapset-0.6.0.1/Data/EnumMap/Base.hs0000644000000000000000000004642200000000000015612 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveTraversable #-} -- | -- Module : $Header$ -- Description : Data.IntMap with Enum keys. -- Copyright : (c) 2011-2019 Michal Terepeta -- License : BSD3 -- Maintainer : mikolaj.konarski@funktory.com -- Stability : alpha -- Portability : uses DeriveDataTypeable and GeneralizedNewtypeDeriving module Data.EnumMap.Base ( EnumMap(..) -- * Wrapping/unwrapping , intMapToEnumMap , enumMapToIntMap -- * Operators , (!) , (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault , lookupLT , lookupGT , lookupLE , lookupGE -- * Construction , empty , singleton -- ** Insertion , insert , insertWith , insertWithKey , insertLookupWithKey -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- ** Universal combining function , mergeWithKey -- * Traversal -- ** Map , map , mapWithKey , traverseWithKey , mapAccum , mapAccumWithKey , mapAccumRWithKey , mapKeys , mapKeysWith , mapKeysMonotonic -- * Folds , foldr , foldl , foldrWithKey , foldlWithKey -- ** Strict folds , foldr' , foldl' , foldrWithKey' , foldlWithKey' -- * Conversion , elems , keys , assocs , keysSet , fromSet -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- ** Ordered lists , toAscList , toDescList , fromAscList , fromAscListWith , fromAscListWithKey , fromDistinctAscList -- * Filter , filter , filterWithKey #if (MIN_VERSION_containers(0,5,8)) , restrictKeys , withoutKeys #endif , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey , split , splitLookup -- * Submap , isSubmapOf , isSubmapOfBy , isProperSubmapOf , isProperSubmapOfBy -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , updateMin , updateMax , updateMinWithKey , updateMaxWithKey , minView , maxView , minViewWithKey , maxViewWithKey ) where import Prelude hiding ( filter, foldr, foldl, lookup, map, null ) import qualified Prelude as P import Control.Applicative ( Applicative, liftA ) import Data.IntMap.Lazy ( IntMap ) import qualified Data.IntMap.Lazy as I import Data.EnumSet ( EnumSet ) import qualified Data.EnumSet as EnumSet import Control.Arrow ( first, second, (***) ) import Control.DeepSeq ( NFData ) import Data.Foldable ( Foldable ) import Data.Monoid ( Monoid ) import Data.Semigroup ( Semigroup ) import Data.Traversable ( Traversable ) import Data.Typeable ( Typeable ) import Text.Read -- | Wrapper for 'IntMap' with 'Enum' keys. newtype EnumMap k a = EnumMap { unWrap :: IntMap a } deriving (Eq, Foldable, Functor, Ord, Semigroup, Monoid, Traversable, Typeable, NFData) instance (Enum k, Show k, Show a) => Show (EnumMap k a) where showsPrec p em = showParen (p > 10) $ showString "fromList " . shows (toList em) instance (Enum k, Read k, Read a) => Read (EnumMap k a) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP list <- readPrec return (fromList list) -- -- Conversion to/from 'IntMap'. -- -- | Wrap 'IntMap'. intMapToEnumMap :: IntMap a -> EnumMap k a intMapToEnumMap = EnumMap {-# INLINE intMapToEnumMap #-} -- | Unwrap 'IntMap'. enumMapToIntMap :: EnumMap k a -> IntMap a enumMapToIntMap = unWrap {-# INLINE enumMapToIntMap #-} -- -- Here begins the main part. -- (!) :: (Enum k) => EnumMap k a -> k -> a (EnumMap im) ! k = im I.! (fromEnum k) {-# INLINE (!) #-} (\\) :: EnumMap k a -> EnumMap k b -> EnumMap k a (EnumMap im1) \\ (EnumMap im2) = EnumMap $ im1 I.\\ im2 {-# INLINE (\\) #-} null :: EnumMap k a -> Bool null = I.null . unWrap {-# INLINE null #-} size :: EnumMap k a -> Int size = I.size . unWrap {-# INLINE size #-} member :: (Enum k) => k -> EnumMap k a -> Bool member k = I.member (fromEnum k) . unWrap {-# INLINE member #-} notMember :: (Enum k) => k -> EnumMap k a -> Bool notMember k = I.notMember (fromEnum k) . unWrap {-# INLINE notMember #-} lookup :: (Enum k) => k -> EnumMap k a -> Maybe a lookup k = I.lookup (fromEnum k) . unWrap {-# INLINE lookup #-} findWithDefault :: (Enum k) => a -> k -> EnumMap k a -> a findWithDefault def k = I.findWithDefault def (fromEnum k) . unWrap {-# INLINE findWithDefault #-} lookupLT :: (Enum k) => k -> EnumMap k a -> Maybe (k, a) lookupLT k = fmap (first toEnum) . I.lookupLT (fromEnum k) . unWrap {-# INLINE lookupLT #-} lookupGT :: (Enum k) => k -> EnumMap k a -> Maybe (k, a) lookupGT k = fmap (first toEnum) . I.lookupGT (fromEnum k) . unWrap {-# INLINE lookupGT #-} lookupLE :: (Enum k) => k -> EnumMap k a -> Maybe (k, a) lookupLE k = fmap (first toEnum) . I.lookupLE (fromEnum k) . unWrap {-# INLINE lookupLE #-} lookupGE :: (Enum k) => k -> EnumMap k a -> Maybe (k, a) lookupGE k = fmap (first toEnum) . I.lookupGE (fromEnum k) . unWrap {-# INLINE lookupGE #-} empty :: EnumMap k a empty = EnumMap $ I.empty {-# INLINE empty #-} singleton :: (Enum k) => k -> a -> EnumMap k a singleton k = EnumMap . I.singleton (fromEnum k) {-# INLINE singleton #-} insert :: (Enum k) => k -> a -> EnumMap k a -> EnumMap k a insert k a = EnumMap . I.insert (fromEnum k) a . unWrap {-# INLINE insert #-} insertWith :: (Enum k) => (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWith f k a = EnumMap . I.insertWith f (fromEnum k) a . unWrap {-# INLINE insertWith #-} insertWithKey :: (Enum k) => (k -> a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWithKey f k a = EnumMap . I.insertWithKey (f . toEnum) (fromEnum k) a . unWrap {-# INLINE insertWithKey #-} insertLookupWithKey :: (Enum k) => (k -> a -> a -> a) -> k -> a -> EnumMap k a -> (Maybe a, EnumMap k a) insertLookupWithKey f k a = second EnumMap . I.insertLookupWithKey (f . toEnum) (fromEnum k) a . unWrap {-# INLINE insertLookupWithKey #-} delete :: (Enum k) => k -> EnumMap k a -> EnumMap k a delete k = EnumMap . I.delete (fromEnum k) . unWrap {-# INLINE delete #-} adjust :: (Enum k) => (a -> a) -> k -> EnumMap k a -> EnumMap k a adjust f k = EnumMap . I.adjust f (fromEnum k) . unWrap {-# INLINE adjust #-} adjustWithKey :: (Enum k) => (k -> a -> a) -> k -> EnumMap k a -> EnumMap k a adjustWithKey f k = EnumMap . I.adjustWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE adjustWithKey #-} update :: (Enum k) => (a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a update f k = EnumMap . I.update f (fromEnum k) . unWrap {-# INLINE update #-} updateWithKey :: (Enum k) => (k -> a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a updateWithKey f k = EnumMap . I.updateWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE updateWithKey #-} updateLookupWithKey :: (Enum k) => (k -> a -> Maybe a) -> k -> EnumMap k a -> (Maybe a,EnumMap k a) updateLookupWithKey f k = second EnumMap . I.updateLookupWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE updateLookupWithKey #-} alter :: (Enum k) => (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a alter f k = EnumMap . I.alter f (fromEnum k) . unWrap {-# INLINE alter #-} unions :: [EnumMap k a] -> EnumMap k a unions = EnumMap . I.unions . P.map unWrap {-# INLINE unions #-} unionsWith :: (a -> a -> a) -> [EnumMap k a] -> EnumMap k a unionsWith f = EnumMap . I.unionsWith f . P.map unWrap {-# INLINE unionsWith #-} union :: EnumMap k a -> EnumMap k a -> EnumMap k a union (EnumMap im1) (EnumMap im2) = EnumMap $ I.union im1 im2 {-# INLINE union #-} unionWith :: (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a unionWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.unionWith f im1 im2 {-# INLINE unionWith #-} unionWithKey :: (Enum k) => (k -> a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a unionWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.unionWithKey (f . toEnum) im1 im2 {-# INLINE unionWithKey #-} difference :: EnumMap k a -> EnumMap k b -> EnumMap k a difference (EnumMap im1) (EnumMap im2) = EnumMap $ I.difference im1 im2 {-# INLINE difference #-} differenceWith :: (a -> b -> Maybe a) -> EnumMap k a -> EnumMap k b -> EnumMap k a differenceWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.differenceWith f im1 im2 {-# INLINE differenceWith #-} differenceWithKey :: (Enum k) => (k -> a -> b -> Maybe a) -> EnumMap k a -> EnumMap k b -> EnumMap k a differenceWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.differenceWithKey (f . toEnum) im1 im2 {-# INLINE differenceWithKey #-} intersection :: EnumMap k a -> EnumMap k b -> EnumMap k a intersection (EnumMap im1) (EnumMap im2) = EnumMap $ I.intersection im1 im2 {-# INLINE intersection #-} intersectionWith :: (a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c intersectionWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.intersectionWith f im1 im2 {-# INLINE intersectionWith #-} intersectionWithKey :: (Enum k) => (k -> a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c intersectionWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.intersectionWithKey (f . toEnum) im1 im2 {-# INLINE intersectionWithKey #-} mergeWithKey :: (Enum k) => (k -> a -> b -> Maybe c) -> (EnumMap k a -> EnumMap k c) -> (EnumMap k b -> EnumMap k c) -> EnumMap k a -> EnumMap k b -> EnumMap k c mergeWithKey f ga gb = \ma mb -> EnumMap $ I.mergeWithKey (f . toEnum) (unWrap . ga . EnumMap) (unWrap . gb . EnumMap) (unWrap ma) (unWrap mb) {-# INLINE mergeWithKey #-} updateMinWithKey :: (Enum k) => (k -> a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMinWithKey f = EnumMap . I.updateMinWithKey (f . toEnum) . unWrap {-# INLINE updateMinWithKey #-} updateMaxWithKey :: (Enum k) => (k -> a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMaxWithKey f = EnumMap . I.updateMaxWithKey (f . toEnum) . unWrap {-# INLINE updateMaxWithKey #-} maxViewWithKey :: (Enum k) => EnumMap k a -> Maybe ((k, a), EnumMap k a) maxViewWithKey = fmap wrap . I.maxViewWithKey . unWrap where wrap ((i, a), im) = ((toEnum i, a), EnumMap im) {-# INLINE maxViewWithKey #-} minViewWithKey :: (Enum k) => EnumMap k a -> Maybe ((k, a), EnumMap k a) minViewWithKey = fmap wrap . I.minViewWithKey . unWrap where wrap ((i, a), imap) = ((toEnum i, a), EnumMap imap) {-# INLINE minViewWithKey #-} updateMax :: (a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMax f = EnumMap . I.updateMax f . unWrap {-# INLINE updateMax #-} updateMin :: (a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMin f = EnumMap . I.updateMin f . unWrap {-# INLINE updateMin #-} maxView :: EnumMap k a -> Maybe (a, EnumMap k a) maxView = fmap (second EnumMap) . I.maxView . unWrap {-# INLINE maxView #-} minView :: EnumMap k a -> Maybe (a, EnumMap k a) minView = fmap (second EnumMap) . I.minView . unWrap {-# INLINE minView #-} deleteFindMax :: (Enum k) => EnumMap k a -> ((k, a), EnumMap k a) deleteFindMax = (first toEnum *** EnumMap) . I.deleteFindMax . unWrap {-# INLINE deleteFindMax #-} deleteFindMin :: (Enum k) => EnumMap k a -> ((k, a), EnumMap k a) deleteFindMin = (first toEnum *** EnumMap) . I.deleteFindMin . unWrap {-# INLINE deleteFindMin #-} findMin :: (Enum k) => EnumMap k a -> (k, a) findMin = first toEnum . I.findMin . unWrap {-# INLINE findMin #-} findMax :: (Enum k) => EnumMap k a -> (k, a) findMax = first toEnum . I.findMax . unWrap {-# INLINE findMax #-} deleteMin :: EnumMap k a -> EnumMap k a deleteMin = EnumMap . I.deleteMin . unWrap {-# INLINE deleteMin #-} deleteMax :: EnumMap k a -> EnumMap k a deleteMax = EnumMap . I.deleteMax . unWrap {-# INLINE deleteMax #-} isProperSubmapOf :: (Eq a) => EnumMap k a -> EnumMap k a -> Bool isProperSubmapOf (EnumMap im1) (EnumMap im2) = I.isProperSubmapOf im1 im2 {-# INLINE isProperSubmapOf #-} isProperSubmapOfBy :: (a -> b -> Bool) -> EnumMap k a -> EnumMap k b -> Bool isProperSubmapOfBy p (EnumMap im1) (EnumMap im2) = I.isProperSubmapOfBy p im1 im2 {-# INLINE isProperSubmapOfBy #-} isSubmapOf :: Eq a => EnumMap k a -> EnumMap k a -> Bool isSubmapOf (EnumMap im1) (EnumMap im2) = I.isSubmapOf im1 im2 {-# INLINE isSubmapOf #-} isSubmapOfBy :: (a -> b -> Bool) -> EnumMap k a -> EnumMap k b -> Bool isSubmapOfBy p (EnumMap im1) (EnumMap im2) = I.isSubmapOfBy p im1 im2 {-# INLINE isSubmapOfBy #-} map :: (a -> b) -> EnumMap k a -> EnumMap k b map f = EnumMap . I.map f . unWrap {-# INLINE map #-} mapWithKey :: (Enum k) => (k -> a -> b) -> EnumMap k a -> EnumMap k b mapWithKey f = EnumMap . I.mapWithKey (f . toEnum) . unWrap {-# INLINE mapWithKey #-} traverseWithKey :: (Applicative t, Enum k) => (k -> a -> t b) -> EnumMap k a -> t (EnumMap k b) traverseWithKey f = liftA EnumMap . I.traverseWithKey (f . toEnum) . unWrap {-# INLINE traverseWithKey #-} mapAccum :: (a -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccum f a = second EnumMap . I.mapAccum f a . unWrap {-# INLINE mapAccum #-} mapAccumWithKey :: (Enum k) => (a -> k -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccumWithKey f a = second EnumMap . I.mapAccumWithKey (\b -> f b . toEnum) a . unWrap {-# INLINE mapAccumWithKey #-} mapAccumRWithKey :: (Enum k) => (a -> k -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccumRWithKey f a = second EnumMap . I.mapAccumRWithKey (\b -> f b . toEnum) a . unWrap {-# INLINE mapAccumRWithKey #-} mapKeys :: (Enum k) => (k -> k) -> EnumMap k a -> EnumMap k a mapKeys f = EnumMap . I.mapKeys (fromEnum . f . toEnum) . unWrap {-# INLINE mapKeys #-} mapKeysWith :: (Enum k) => (a -> a -> a) -> (k -> k) -> EnumMap k a -> EnumMap k a mapKeysWith f g = EnumMap . I.mapKeysWith f (fromEnum . g . toEnum) . unWrap {-# INLINE mapKeysWith #-} mapKeysMonotonic :: (Enum k) => (k -> k) -> EnumMap k a -> EnumMap k a mapKeysMonotonic f = EnumMap . I.mapKeysMonotonic (fromEnum . f . toEnum) . unWrap {-# INLINE mapKeysMonotonic #-} filter :: (a -> Bool) -> EnumMap k a -> EnumMap k a filter p = EnumMap . I.filter p . unWrap {-# INLINE filter #-} filterWithKey :: (Enum k) => (k -> a -> Bool) -> EnumMap k a -> EnumMap k a filterWithKey p = EnumMap . I.filterWithKey (p . toEnum) . unWrap {-# INLINE filterWithKey #-} #if (MIN_VERSION_containers(0,5,8)) restrictKeys :: (Enum k) => EnumMap k a -> EnumSet k -> EnumMap k a restrictKeys m s = EnumMap $ I.restrictKeys (unWrap m) (EnumSet.enumSetToIntSet s) {-# INLINE restrictKeys #-} withoutKeys :: (Enum k) => EnumMap k a -> EnumSet k -> EnumMap k a withoutKeys m s = EnumMap $ I.withoutKeys (unWrap m) (EnumSet.enumSetToIntSet s) {-# INLINE withoutKeys #-} #endif partition :: (a -> Bool) -> EnumMap k a -> (EnumMap k a, EnumMap k a) partition p = (EnumMap *** EnumMap) . I.partition p . unWrap {-# INLINE partition #-} partitionWithKey :: (Enum k) => (k -> a -> Bool) -> EnumMap k a -> (EnumMap k a, EnumMap k a) partitionWithKey p = (EnumMap *** EnumMap) . I.partitionWithKey (p . toEnum) . unWrap {-# INLINE partitionWithKey #-} mapMaybe :: (a -> Maybe b) -> EnumMap k a -> EnumMap k b mapMaybe f = EnumMap . I.mapMaybe f . unWrap {-# INLINE mapMaybe #-} mapMaybeWithKey :: (Enum k) => (k -> a -> Maybe b) -> EnumMap k a -> EnumMap k b mapMaybeWithKey f = EnumMap . I.mapMaybeWithKey (f . toEnum) . unWrap {-# INLINE mapMaybeWithKey #-} mapEither :: (a -> Either b c) -> EnumMap k a -> (EnumMap k b, EnumMap k c) mapEither f = (EnumMap *** EnumMap) . I.mapEither f . unWrap {-# INLINE mapEither #-} mapEitherWithKey :: (Enum k) => (k -> a -> Either b c) -> EnumMap k a -> (EnumMap k b, EnumMap k c) mapEitherWithKey f = (EnumMap *** EnumMap) . I.mapEitherWithKey (f . toEnum) . unWrap {-# INLINE mapEitherWithKey #-} split :: (Enum k) => k -> EnumMap k a -> (EnumMap k a, EnumMap k a) split k = (EnumMap *** EnumMap) . I.split (fromEnum k) . unWrap {-# INLINE split #-} splitLookup :: (Enum k) => k -> EnumMap k a -> (EnumMap k a, Maybe a, EnumMap k a) splitLookup k = wrap . I.splitLookup (fromEnum k) . unWrap where wrap (im1, ma, im2) = (EnumMap im1, ma, EnumMap im2) {-# INLINE splitLookup #-} foldr :: (a -> b -> b) -> b -> EnumMap k a -> b foldr f a = I.foldr f a . unWrap {-# INLINE foldr #-} foldl :: (a -> b -> a) -> a -> EnumMap k b -> a foldl f a = I.foldl f a . unWrap {-# INLINE foldl #-} foldrWithKey :: (Enum k) => (k -> a -> b -> b) -> b -> EnumMap k a -> b foldrWithKey f a = I.foldrWithKey (f . toEnum) a . unWrap {-# INLINE foldrWithKey #-} foldlWithKey :: (Enum k) => (a -> k -> b -> a) -> a -> EnumMap k b -> a foldlWithKey f a = I.foldlWithKey (\a' -> f a' . toEnum) a . unWrap {-# INLINE foldlWithKey #-} foldr' :: (a -> b -> b) -> b -> EnumMap k a -> b foldr' f a = I.foldr' f a . unWrap {-# INLINE foldr' #-} foldl' :: (a -> b -> a) -> a -> EnumMap k b -> a foldl' f a = I.foldl' f a . unWrap {-# INLINE foldl' #-} foldrWithKey' :: (Enum k) => (k -> a -> b -> b) -> b -> EnumMap k a -> b foldrWithKey' f a = I.foldrWithKey' (f . toEnum) a . unWrap {-# INLINE foldrWithKey' #-} foldlWithKey' :: (Enum k) => (a -> k -> b -> a) -> a -> EnumMap k b -> a foldlWithKey' f a = I.foldlWithKey' (\a' -> f a' . toEnum) a . unWrap {-# INLINE foldlWithKey' #-} elems :: EnumMap k a -> [a] elems = I.elems . unWrap {-# INLINE elems #-} keys :: (Enum k) => EnumMap k a -> [k] keys = P.map toEnum . I.keys . unWrap {-# INLINE keys #-} keysSet :: (Enum k) => EnumMap k a -> EnumSet k keysSet = EnumSet.fromDistinctAscList . keys {-# INLINE keysSet #-} fromSet :: (Enum k) => (k -> a) -> EnumSet k -> EnumMap k a fromSet f = EnumMap . I.fromSet (f . toEnum) . EnumSet.enumSetToIntSet {-# INLINE fromSet #-} assocs :: (Enum k) => EnumMap k a -> [(k, a)] assocs = P.map (first toEnum) . I.assocs . unWrap {-# INLINE assocs #-} toList :: (Enum k) => EnumMap k a -> [(k, a)] toList = P.map (first toEnum) . I.toList . unWrap {-# INLINE toList #-} toAscList :: (Enum k) => EnumMap k a -> [(k, a)] toAscList = P.map (first toEnum) . I.toAscList . unWrap {-# INLINE toAscList #-} toDescList :: (Enum k) => EnumMap k a -> [(k, a)] toDescList = P.map (first toEnum) . I.toDescList . unWrap {-# INLINE toDescList #-} fromList :: (Enum k) => [(k, a)] -> EnumMap k a fromList = EnumMap . I.fromList . P.map (first fromEnum) {-# INLINE fromList #-} fromListWith :: (Enum k) => (a -> a -> a) -> [(k, a)] -> EnumMap k a fromListWith f = EnumMap . I.fromListWith f . P.map (first fromEnum) {-# INLINE fromListWith #-} fromListWithKey :: (Enum k) => (k -> a -> a -> a) -> [(k, a)] -> EnumMap k a fromListWithKey f = EnumMap . I.fromListWithKey (f . toEnum) . P.map (first fromEnum) {-# INLINE fromListWithKey #-} fromAscList :: (Enum k) => [(k, a)] -> EnumMap k a fromAscList = EnumMap . I.fromAscList . P.map (first fromEnum) {-# INLINE fromAscList #-} fromAscListWith :: (Enum k) => (a -> a -> a) -> [(k, a)] -> EnumMap k a fromAscListWith f = EnumMap . I.fromAscListWith f . P.map (first fromEnum) {-# INLINE fromAscListWith #-} fromAscListWithKey :: (Enum k) => (k -> a -> a -> a) -> [(k, a)] -> EnumMap k a fromAscListWithKey f = EnumMap . I.fromAscListWithKey (f . toEnum) . P.map (first fromEnum) {-# INLINE fromAscListWithKey #-} fromDistinctAscList :: (Enum k) => [(k, a)] -> EnumMap k a fromDistinctAscList = EnumMap . I.fromDistinctAscList . P.map (first fromEnum) {-# INLINE fromDistinctAscList #-} enummapset-0.6.0.1/Data/EnumMap/Lazy.hs0000644000000000000000000000513100000000000015647 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : $Header$ -- Description : Data.IntMap.Lazy with Enum keys. -- Copyright : (c) 2011-2019 Michal Terepeta -- License : BSD3 -- Maintainer : mikolaj.konarski@funktory.com -- Stability : alpha -- Portability : uses DeriveDataTypeable and GeneralizedNewtypeDeriving -- This is a simple wrapper for 'Data.IntMap.Lazy' that works with any type of -- keys that are instances of 'Enum' type class. For documentation please see -- the one for 'Data.IntMap'. module Data.EnumMap.Lazy ( EnumMap -- * Wrapping/unwrapping , intMapToEnumMap , enumMapToIntMap -- * Operators , (!) , (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault , lookupLT , lookupGT , lookupLE , lookupGE -- * Construction , empty , singleton -- ** Insertion , insert , insertWith , insertWithKey , insertLookupWithKey -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- ** Universal combining function , mergeWithKey -- * Traversal -- ** Map , map , mapWithKey , traverseWithKey , mapAccum , mapAccumWithKey , mapAccumRWithKey , mapKeys , mapKeysWith , mapKeysMonotonic -- * Folds , foldr , foldl , foldrWithKey , foldlWithKey -- ** Strict folds , foldr' , foldl' , foldrWithKey' , foldlWithKey' -- * Conversion , elems , keys , assocs , keysSet , fromSet -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- ** Ordered lists , toAscList , toDescList , fromAscList , fromAscListWith , fromAscListWithKey , fromDistinctAscList -- * Filter , filter , filterWithKey #if (MIN_VERSION_containers(0,5,8)) , restrictKeys , withoutKeys #endif , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey , split , splitLookup -- * Submap , isSubmapOf , isSubmapOfBy , isProperSubmapOf , isProperSubmapOfBy -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , updateMin , updateMax , updateMinWithKey , updateMaxWithKey , minView , maxView , minViewWithKey , maxViewWithKey ) where import Prelude hiding (filter, foldl, foldr, lookup, map, null) import Data.EnumMap.Base enummapset-0.6.0.1/Data/EnumMap/Strict.hs0000644000000000000000000002631200000000000016204 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : $Header$ -- Description : Data.IntMap.Strict with Enum keys. -- Copyright : (c) 2011-2019 Michal Terepeta -- License : BSD3 -- Maintainer : mikolaj.konarski@funktory.com -- Stability : alpha -- Portability : uses DeriveDataTypeable and GeneralizedNewtypeDeriving -- This is a simple wrapper for 'Data.IntMap.Strict' that works with any type of -- keys that are instances of 'Enum' type class. For documentation please see -- the one for 'Data.IntMap'. module Data.EnumMap.Strict ( EnumMap -- * Wrapping/unwrapping , intMapToEnumMap , enumMapToIntMap -- * Operators , (!) , (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault , lookupLT , lookupGT , lookupLE , lookupGE -- * Construction , empty , singleton -- ** Insertion , insert , insertWith , insertWithKey , insertLookupWithKey -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- ** Universal combining function , mergeWithKey -- * Traversal -- ** Map , map , mapWithKey , traverseWithKey , mapAccum , mapAccumWithKey , mapAccumRWithKey , mapKeys , mapKeysWith , mapKeysMonotonic -- * Folds , foldr , foldl , foldrWithKey , foldlWithKey -- ** Strict folds , foldr' , foldl' , foldrWithKey' , foldlWithKey' -- * Conversion , elems , keys , assocs , keysSet , fromSet -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- ** Ordered lists , toAscList , toDescList , fromAscList , fromAscListWith , fromAscListWithKey , fromDistinctAscList -- * Filter , filter , filterWithKey #if (MIN_VERSION_containers(0,5,8)) , restrictKeys , withoutKeys #endif , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey , split , splitLookup -- * Submap , isSubmapOf , isSubmapOfBy , isProperSubmapOf , isProperSubmapOfBy -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , updateMin , updateMax , updateMinWithKey , updateMaxWithKey , minView , maxView , minViewWithKey , maxViewWithKey ) where import Prelude hiding (filter, foldl, foldr, lookup, map, null) import qualified Prelude as P import Control.Arrow (first, second, (***)) import qualified Data.IntMap.Strict as I import Data.EnumSet (EnumSet) import qualified Data.EnumSet as EnumSet import Data.EnumMap.Base hiding (adjust, adjustWithKey, alter, differenceWith, differenceWithKey, findWithDefault, fromAscList, fromAscListWith, fromAscListWithKey, fromDistinctAscList, fromList, fromListWith, fromListWithKey, fromSet, insert, insertLookupWithKey, insertWith, insertWithKey, intersectionWith, intersectionWithKey, map, mapAccum, mapAccumRWithKey, mapAccumWithKey, mapEither, mapEitherWithKey, mapKeysWith, mapMaybe, mapMaybeWithKey, mapWithKey, mergeWithKey, singleton, unionWith, unionWithKey, unionsWith, update, updateLookupWithKey, updateMax, updateMaxWithKey, updateMin, updateMinWithKey, updateWithKey) findWithDefault :: (Enum k) => a -> k -> EnumMap k a -> a findWithDefault def k = I.findWithDefault def (fromEnum k) . unWrap {-# INLINE findWithDefault #-} singleton :: (Enum k) => k -> a -> EnumMap k a singleton k = EnumMap . I.singleton (fromEnum k) {-# INLINE singleton #-} insert :: (Enum k) => k -> a -> EnumMap k a -> EnumMap k a insert k a = EnumMap . I.insert (fromEnum k) a . unWrap {-# INLINE insert #-} insertWith :: (Enum k) => (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWith f k a = EnumMap . I.insertWith f (fromEnum k) a . unWrap {-# INLINE insertWith #-} insertWithKey :: (Enum k) => (k -> a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a insertWithKey f k a = EnumMap . I.insertWithKey (f . toEnum) (fromEnum k) a . unWrap {-# INLINE insertWithKey #-} insertLookupWithKey :: (Enum k) => (k -> a -> a -> a) -> k -> a -> EnumMap k a -> (Maybe a, EnumMap k a) insertLookupWithKey f k a = second EnumMap . I.insertLookupWithKey (f . toEnum) (fromEnum k) a . unWrap {-# INLINE insertLookupWithKey #-} adjust :: (Enum k) => (a -> a) -> k -> EnumMap k a -> EnumMap k a adjust f k = EnumMap . I.adjust f (fromEnum k) . unWrap {-# INLINE adjust #-} adjustWithKey :: (Enum k) => (k -> a -> a) -> k -> EnumMap k a -> EnumMap k a adjustWithKey f k = EnumMap . I.adjustWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE adjustWithKey #-} alter :: (Enum k) => (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a alter f k = EnumMap . I.alter f (fromEnum k) . unWrap {-# INLINE alter #-} unionsWith :: (a -> a -> a) -> [EnumMap k a] -> EnumMap k a unionsWith f = EnumMap . I.unionsWith f . P.map unWrap {-# INLINE unionsWith #-} unionWith :: (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a unionWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.unionWith f im1 im2 {-# INLINE unionWith #-} unionWithKey :: (Enum k) => (k -> a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a unionWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.unionWithKey (f . toEnum) im1 im2 {-# INLINE unionWithKey #-} differenceWith :: (a -> b -> Maybe a) -> EnumMap k a -> EnumMap k b -> EnumMap k a differenceWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.differenceWith f im1 im2 {-# INLINE differenceWith #-} differenceWithKey :: (Enum k) => (k -> a -> b -> Maybe a) -> EnumMap k a -> EnumMap k b -> EnumMap k a differenceWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.differenceWithKey (f . toEnum) im1 im2 {-# INLINE differenceWithKey #-} intersectionWith :: (a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c intersectionWith f (EnumMap im1) (EnumMap im2) = EnumMap $ I.intersectionWith f im1 im2 {-# INLINE intersectionWith #-} intersectionWithKey :: (Enum k) => (k -> a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c intersectionWithKey f (EnumMap im1) (EnumMap im2) = EnumMap $ I.intersectionWithKey (f . toEnum) im1 im2 {-# INLINE intersectionWithKey #-} mergeWithKey :: (Enum k) => (k -> a -> b -> Maybe c) -> (EnumMap k a -> EnumMap k c) -> (EnumMap k b -> EnumMap k c) -> EnumMap k a -> EnumMap k b -> EnumMap k c mergeWithKey f ga gb = \ma mb -> EnumMap $ I.mergeWithKey (f . toEnum) (unWrap . ga . EnumMap) (unWrap . gb . EnumMap) (unWrap ma) (unWrap mb) {-# INLINE mergeWithKey #-} update :: (Enum k) => (a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a update f k = EnumMap . I.update f (fromEnum k) . unWrap {-# INLINE update #-} updateWithKey :: (Enum k) => (k -> a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a updateWithKey f k = EnumMap . I.updateWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE updateWithKey #-} updateLookupWithKey :: (Enum k) => (k -> a -> Maybe a) -> k -> EnumMap k a -> (Maybe a,EnumMap k a) updateLookupWithKey f k = second EnumMap . I.updateLookupWithKey (f . toEnum) (fromEnum k) . unWrap {-# INLINE updateLookupWithKey #-} updateMinWithKey :: (Enum k) => (k -> a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMinWithKey f = EnumMap . I.updateMinWithKey (f . toEnum) . unWrap {-# INLINE updateMinWithKey #-} updateMaxWithKey :: (Enum k) => (k -> a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMaxWithKey f = EnumMap . I.updateMaxWithKey (f . toEnum) . unWrap {-# INLINE updateMaxWithKey #-} updateMax :: (a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMax f = EnumMap . I.updateMax f . unWrap {-# INLINE updateMax #-} updateMin :: (a -> Maybe a) -> EnumMap k a -> EnumMap k a updateMin f = EnumMap . I.updateMin f . unWrap {-# INLINE updateMin #-} map :: (a -> b) -> EnumMap k a -> EnumMap k b map f = EnumMap . I.map f . unWrap {-# INLINE map #-} mapWithKey :: (Enum k) => (k -> a -> b) -> EnumMap k a -> EnumMap k b mapWithKey f = EnumMap . I.mapWithKey (f . toEnum) . unWrap {-# INLINE mapWithKey #-} mapAccum :: (a -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccum f a = second EnumMap . I.mapAccum f a . unWrap {-# INLINE mapAccum #-} mapAccumWithKey :: (Enum k) => (a -> k -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccumWithKey f a = second EnumMap . I.mapAccumWithKey (\b -> f b . toEnum) a . unWrap {-# INLINE mapAccumWithKey #-} mapAccumRWithKey :: (Enum k) => (a -> k -> b -> (a, c)) -> a -> EnumMap k b -> (a, EnumMap k c) mapAccumRWithKey f a = second EnumMap . I.mapAccumRWithKey (\b -> f b . toEnum) a . unWrap {-# INLINE mapAccumRWithKey #-} mapKeysWith :: (Enum k) => (a -> a -> a) -> (k -> k) -> EnumMap k a -> EnumMap k a mapKeysWith f g = EnumMap . I.mapKeysWith f (fromEnum . g . toEnum) . unWrap {-# INLINE mapKeysWith #-} mapMaybe :: (a -> Maybe b) -> EnumMap k a -> EnumMap k b mapMaybe f = EnumMap . I.mapMaybe f . unWrap {-# INLINE mapMaybe #-} mapMaybeWithKey :: (Enum k) => (k -> a -> Maybe b) -> EnumMap k a -> EnumMap k b mapMaybeWithKey f = EnumMap . I.mapMaybeWithKey (f . toEnum) . unWrap {-# INLINE mapMaybeWithKey #-} mapEither :: (a -> Either b c) -> EnumMap k a -> (EnumMap k b, EnumMap k c) mapEither f = (EnumMap *** EnumMap) . I.mapEither f . unWrap {-# INLINE mapEither #-} mapEitherWithKey :: (Enum k) => (k -> a -> Either b c) -> EnumMap k a -> (EnumMap k b, EnumMap k c) mapEitherWithKey f = (EnumMap *** EnumMap) . I.mapEitherWithKey (f . toEnum) . unWrap {-# INLINE mapEitherWithKey #-} fromSet :: (Enum k) => (k -> a) -> EnumSet k -> EnumMap k a fromSet f = EnumMap . I.fromSet (f . toEnum) . EnumSet.enumSetToIntSet {-# INLINE fromSet #-} fromList :: (Enum k) => [(k, a)] -> EnumMap k a fromList = EnumMap . I.fromList . P.map (first fromEnum) {-# INLINE fromList #-} fromListWith :: (Enum k) => (a -> a -> a) -> [(k, a)] -> EnumMap k a fromListWith f = EnumMap . I.fromListWith f . P.map (first fromEnum) {-# INLINE fromListWith #-} fromListWithKey :: (Enum k) => (k -> a -> a -> a) -> [(k, a)] -> EnumMap k a fromListWithKey f = EnumMap . I.fromListWithKey (f . toEnum) . P.map (first fromEnum) {-# INLINE fromListWithKey #-} fromAscList :: (Enum k) => [(k, a)] -> EnumMap k a fromAscList = EnumMap . I.fromAscList . P.map (first fromEnum) {-# INLINE fromAscList #-} fromAscListWith :: (Enum k) => (a -> a -> a) -> [(k, a)] -> EnumMap k a fromAscListWith f = EnumMap . I.fromAscListWith f . P.map (first fromEnum) {-# INLINE fromAscListWith #-} fromAscListWithKey :: (Enum k) => (k -> a -> a -> a) -> [(k, a)] -> EnumMap k a fromAscListWithKey f = EnumMap . I.fromAscListWithKey (f . toEnum) . P.map (first fromEnum) {-# INLINE fromAscListWithKey #-} fromDistinctAscList :: (Enum k) => [(k, a)] -> EnumMap k a fromDistinctAscList = EnumMap . I.fromDistinctAscList . P.map (first fromEnum) {-# INLINE fromDistinctAscList #-} enummapset-0.6.0.1/Data/EnumSet.hs0000644000000000000000000002016000000000000014745 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- Module : $Header$ -- Description : Data.IntSet with Enum elements. -- Copyright : (c) 2011-2019 Michal Terepeta -- License : BSD3 -- Maintainer : mikolaj.konarski@funktory.com -- Stability : alpha -- Portability : uses DeriveDataTypeable and GeneralizedNewtypeDeriving -- This is a simple wrapper for 'Data.IntSet' that allows storing any elements -- of Enum type class. Useful if one wants to have the performance of -- 'Data.IntSet' and at the same time use something else than 'Int's (e.g. an -- 'Int' wrapped with newtype). For documentation see the one for 'Data.IntSet'. module Data.EnumSet ( EnumSet -- * Wrapping/unwrapping , intSetToEnumSet , enumSetToIntSet -- * Operators , (\\) -- * Query , null , size , member , notMember , lookupLT , lookupGT , lookupLE , lookupGE , isSubsetOf , isProperSubsetOf -- * Construction , empty , singleton , insert , delete -- * Combine , union , unions , difference , intersection -- * Filter , filter , partition , split , splitMember -- * Map , map -- * 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 , toDescList , fromAscList , fromDistinctAscList ) where import Prelude hiding ( filter, foldl, foldr, lookup, map, null ) import qualified Prelude as P import Data.IntSet ( IntSet ) import qualified Data.IntSet as I import Control.Arrow ( (***) ) import Control.DeepSeq ( NFData ) import Data.Monoid ( Monoid ) import Data.Semigroup ( Semigroup ) import Data.Typeable ( Typeable ) import Text.Read -- | Wrapper for 'IntSet' with 'Enum' elements. newtype EnumSet k = EnumSet { unWrap :: IntSet } deriving (Eq, Semigroup, Monoid, Ord, Typeable, NFData) instance (Enum k, Show k) => Show (EnumSet k) where showsPrec p ks = showParen (p > 10) $ showString "fromList " . shows (toList ks) instance (Enum k, Read k) => Read (EnumSet k) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP list <- readPrec return (fromList list) -- -- Conversion to/from 'IntSet'. -- -- | Wrap 'IntSet'. intSetToEnumSet :: IntSet -> EnumSet k intSetToEnumSet = EnumSet {-# INLINE intSetToEnumSet #-} -- | Unwrap 'IntSet'. enumSetToIntSet :: EnumSet k -> IntSet enumSetToIntSet = unWrap {-# INLINE enumSetToIntSet #-} -- -- Here begins the main part. -- (\\) :: EnumSet k -> EnumSet k -> EnumSet k (EnumSet is1) \\ (EnumSet is2) = EnumSet $ is1 I.\\ is2 {-# INLINE (\\) #-} null :: EnumSet k -> Bool null = I.null . unWrap {-# INLINE null #-} size :: EnumSet k -> Int size = I.size . unWrap {-# INLINE size #-} member :: (Enum k) => k -> EnumSet k -> Bool member k = I.member (fromEnum k) . unWrap {-# INLINE member #-} notMember :: (Enum k) => k -> EnumSet k -> Bool notMember k = I.notMember (fromEnum k) . unWrap {-# INLINE notMember #-} lookupLT :: (Enum k) => k -> EnumSet k -> Maybe k lookupLT k = fmap toEnum . I.lookupLT (fromEnum k) . unWrap {-# INLINE lookupLT #-} lookupGT :: (Enum k) => k -> EnumSet k -> Maybe k lookupGT k = fmap toEnum . I.lookupGT (fromEnum k) . unWrap {-# INLINE lookupGT #-} lookupLE :: (Enum k) => k -> EnumSet k -> Maybe k lookupLE k = fmap toEnum . I.lookupLE (fromEnum k) . unWrap {-# INLINE lookupLE #-} lookupGE :: (Enum k) => k -> EnumSet k -> Maybe k lookupGE k = fmap toEnum . I.lookupGE (fromEnum k) . unWrap {-# INLINE lookupGE #-} empty :: EnumSet k empty = EnumSet I.empty {-# INLINE empty #-} singleton :: (Enum k) => k -> EnumSet k singleton = EnumSet . I.singleton . fromEnum {-# INLINE singleton #-} insert :: (Enum k) => k -> EnumSet k -> EnumSet k insert k = EnumSet . I.insert (fromEnum k) . unWrap {-# INLINE insert #-} delete :: (Enum k) => k -> EnumSet k -> EnumSet k delete k = EnumSet . I.delete (fromEnum k) . unWrap {-# INLINE delete #-} unions :: [EnumSet k] -> EnumSet k unions = EnumSet . I.unions . P.map unWrap {-# INLINE unions #-} union :: EnumSet k -> EnumSet k -> EnumSet k union (EnumSet is1) (EnumSet is2) = EnumSet $ I.union is1 is2 {-# INLINE union #-} difference :: EnumSet k -> EnumSet k -> EnumSet k difference (EnumSet is1) (EnumSet is2) = EnumSet $ I.difference is1 is2 {-# INLINE difference #-} intersection :: EnumSet k -> EnumSet k -> EnumSet k intersection (EnumSet is1) (EnumSet is2) = EnumSet $ I.intersection is1 is2 {-# INLINE intersection #-} isProperSubsetOf :: EnumSet k -> EnumSet k -> Bool isProperSubsetOf (EnumSet is1) (EnumSet is2) = I.isProperSubsetOf is1 is2 {-# INLINE isProperSubsetOf #-} isSubsetOf :: EnumSet k -> EnumSet k -> Bool isSubsetOf (EnumSet is1) (EnumSet is2) = I.isSubsetOf is1 is2 {-# INLINE isSubsetOf #-} filter :: (Enum k) => (k -> Bool) -> EnumSet k -> EnumSet k filter f = EnumSet . I.filter (f . toEnum) . unWrap {-# INLINE filter #-} partition :: (Enum k) => (k -> Bool) -> EnumSet k -> (EnumSet k, EnumSet k) partition f = (EnumSet *** EnumSet) . I.partition (f . toEnum) . unWrap {-# INLINE partition #-} split :: (Enum k) => k -> EnumSet k -> (EnumSet k, EnumSet k) split k = (EnumSet *** EnumSet) . I.split (fromEnum k) . unWrap {-# INLINE split #-} splitMember :: (Enum k) => k -> EnumSet k -> (EnumSet k, Bool, EnumSet k) splitMember k = wrap . I.splitMember (fromEnum k) . unWrap where wrap (is1, b, is2) = (EnumSet is1, b, EnumSet is2) {-# INLINE splitMember #-} maxView :: (Enum k) => EnumSet k -> Maybe (k, EnumSet k) maxView = fmap (toEnum *** EnumSet) . I.maxView . unWrap {-# INLINE maxView #-} minView :: (Enum k) => EnumSet k -> Maybe (k, EnumSet k) minView = fmap (toEnum *** EnumSet) . I.minView . unWrap {-# INLINE minView #-} deleteFindMin :: (Enum k) => EnumSet k -> (k, EnumSet k) deleteFindMin = (toEnum *** EnumSet) . I.deleteFindMin . unWrap {-# INLINE deleteFindMin #-} deleteFindMax :: (Enum k) => EnumSet k -> (k, EnumSet k) deleteFindMax = (toEnum *** EnumSet) . I.deleteFindMax . unWrap {-# INLINE deleteFindMax #-} findMin :: (Enum k) => EnumSet k -> k findMin = toEnum . I.findMin . unWrap {-# INLINE findMin #-} findMax :: (Enum k) => EnumSet k -> k findMax = toEnum . I.findMax . unWrap {-# INLINE findMax #-} deleteMin :: EnumSet k -> EnumSet k deleteMin = EnumSet . I.deleteMin . unWrap {-# INLINE deleteMin #-} deleteMax :: EnumSet k -> EnumSet k deleteMax = EnumSet . I.deleteMax . unWrap {-# INLINE deleteMax #-} map :: (Enum k) => (k -> k) -> EnumSet k -> EnumSet k map f = EnumSet . I.map (fromEnum . f . toEnum) . unWrap {-# INLINE map #-} foldr :: (Enum k) => (k -> b -> b) -> b -> EnumSet k -> b foldr f acc = I.foldr (f . toEnum) acc . unWrap {-# INLINE foldr #-} foldl :: (Enum k) => (a -> k -> a) -> a -> EnumSet k -> a foldl f acc = I.foldl (\a -> f a . toEnum) acc . unWrap {-# INLINE foldl #-} foldr' :: (Enum k) => (k -> b -> b) -> b -> EnumSet k -> b foldr' f acc = I.foldr' (f . toEnum) acc . unWrap {-# INLINE foldr' #-} foldl' :: (Enum k) => (a -> k -> a) -> a -> EnumSet k -> a foldl' f acc = I.foldl' (\a -> f a . toEnum) acc . unWrap {-# INLINE foldl' #-} fold :: (Enum k) => (k -> b -> b) -> b -> EnumSet k -> b fold f acc = I.fold (f . toEnum) acc . unWrap {-# INLINE fold #-} elems :: (Enum k) => EnumSet k -> [k] elems = P.map toEnum . I.elems . unWrap {-# INLINE elems #-} toList :: (Enum k) => EnumSet k -> [k] toList = P.map toEnum . I.toList . unWrap {-# INLINE toList #-} toAscList :: (Enum k) => EnumSet k -> [k] toAscList = P.map toEnum . I.toAscList . unWrap {-# INLINE toAscList #-} toDescList :: (Enum k) => EnumSet k -> [k] toDescList = P.map toEnum . I.toDescList . unWrap {-# INLINE toDescList #-} fromList :: (Enum k) => [k] -> EnumSet k fromList = EnumSet . I.fromList . P.map fromEnum {-# INLINE fromList #-} fromAscList :: (Enum k) => [k] -> EnumSet k fromAscList = EnumSet . I.fromAscList . P.map fromEnum {-# INLINE fromAscList #-} fromDistinctAscList :: (Enum k) => [k] -> EnumSet k fromDistinctAscList = EnumSet . I.fromDistinctAscList . P.map fromEnum {-# INLINE fromDistinctAscList #-} enummapset-0.6.0.1/LICENSE0000644000000000000000000000271400000000000013172 0ustar0000000000000000BSD 3-Clause License All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. enummapset-0.6.0.1/README.md0000755000000000000000000000105400000000000013443 0ustar0000000000000000Enummapset ========== [![Build Status](https://travis-ci.org/Mikolaj/enummapset.svg?branch=master)](https://travis-ci.org/Mikolaj/enummapset) [![Hackage](https://img.shields.io/hackage/v/enummapset.svg)](https://hackage.haskell.org/package/enummapset) This package contains simple wrappers around 'Data.IntMap' and 'Data.IntSet' with 'Enum' keys and elements respectively. Especially useful for 'Int's wrapped with `newtype`. Copyright --------- Copyright (c) 2011-2019 Michal Terepeta Copyright (c) 2019 Mikolaj Konarski and others (see git history) enummapset-0.6.0.1/Setup.hs0000644000000000000000000000005600000000000013616 0ustar0000000000000000import Distribution.Simple main = defaultMain enummapset-0.6.0.1/enummapset.cabal0000644000000000000000000000413000000000000015321 0ustar0000000000000000name: enummapset version: 0.6.0.1 synopsis: IntMap and IntSet with Enum keys/elements. description: This package contains simple wrappers around 'Data.IntMap' and 'Data.IntSet' with 'Enum' keys and elements respectively. Especially useful for 'Int's wrapped with `newtype`. homepage: https://github.com/Mikolaj/enummapset bug-reports: https://github.com/Mikolaj/enummapset/issues license: BSD3 license-file: LICENSE tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 author: Michal Terepeta maintainer: Mikolaj Konarski category: Data Structures build-type: Simple cabal-version: >=1.8 extra-source-files: README.md source-repository head type: git location: https://github.com/Mikolaj/enummapset.git flag debug description: Debug build (more warnings, etc.) default: False Library exposed-modules: Data.EnumMap Data.EnumMap.Lazy Data.EnumMap.Strict Data.EnumSet other-modules: Data.EnumMap.Base build-depends: base >= 4.6 && < 5, containers >= 0.5.2 && < 0.7, semigroups >=0.1 && <1.0, deepseq if flag(debug) ghc-options: -Wall other-extensions: CPP, BangPatterns, DataKinds, FlexibleContexts, FlexibleInstances, KindSignatures, TypeFamilies, UndecidableInstances Test-suite intset-properties hs-source-dirs: tests, . main-is: intset-properties.hs other-modules: Data.EnumSet IntSetValidity type: exitcode-stdio-1.0 cpp-options: -DTESTING build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim ghc-options: -O2 other-extensions: CPP, BangPatterns, DataKinds, FlexibleContexts, FlexibleInstances, KindSignatures, TypeFamilies, UndecidableInstances build-depends: containers, semigroups, HUnit, QuickCheck >= 2.7.1, test-framework, test-framework-hunit, test-framework-quickcheck2 enummapset-0.6.0.1/tests/0000755000000000000000000000000000000000000013323 5ustar0000000000000000enummapset-0.6.0.1/tests/IntSetValidity.hs0000644000000000000000000000575000000000000016602 0ustar0000000000000000-- Copied from https://github.com/haskell/containers {-# LANGUAGE CPP #-} module IntSetValidity (valid) where import Data.Bits (xor, (.&.)) import Data.IntSet.Internal import Test.QuickCheck (Property, counterexample, property, (.&&.)) import Utils.Containers.Internal.BitUtil (bitcount) {-------------------------------------------------------------------- Assertions --------------------------------------------------------------------} -- | Returns true iff the internal structure of the IntSet is valid. valid :: IntSet -> Property valid t = counterexample "nilNeverChildOfBin" (nilNeverChildOfBin t) .&&. counterexample "maskPowerOfTwo" (maskPowerOfTwo t) .&&. counterexample "commonPrefix" (commonPrefix t) .&&. counterexample "markRespected" (maskRespected t) .&&. counterexample "tipsValid" (tipsValid t) -- Invariant: Nil is never found as a child of Bin. nilNeverChildOfBin :: IntSet -> Bool nilNeverChildOfBin t = case t of Nil -> True Tip _ _ -> True Bin _ _ l r -> noNilInSet l && noNilInSet r where noNilInSet t' = case t' of Nil -> False Tip _ _ -> True Bin _ _ l' r' -> noNilInSet l' && noNilInSet r' -- Invariant: The Mask is a power of 2. It is the largest bit position at which -- two elements of the set differ. maskPowerOfTwo :: IntSet -> Bool maskPowerOfTwo t = case t of Nil -> True Tip _ _ -> True Bin _ m l r -> bitcount 0 (fromIntegral m) == 1 && maskPowerOfTwo l && maskPowerOfTwo r -- Invariant: Prefix is the common high-order bits that all elements share to -- the left of the Mask bit. commonPrefix :: IntSet -> Bool commonPrefix t = case t of Nil -> True Tip _ _ -> True b@(Bin p _ l r) -> all (sharedPrefix p) (elems b) && commonPrefix l && commonPrefix r where sharedPrefix :: Prefix -> Int -> Bool sharedPrefix p a = p == p .&. a -- Invariant: In Bin prefix mask left right, left consists of the elements that -- don't have the mask bit set; right is all the elements that do. maskRespected :: IntSet -> Bool maskRespected t = case t of Nil -> True Tip _ _ -> True Bin _ binMask l r -> all (\x -> zero x binMask) (elems l) && all (\x -> not (zero x binMask)) (elems r) && maskRespected l && maskRespected r -- Invariant: The Prefix is zero for the last 5 (on 32 bit arches) or 6 bits -- (on 64 bit arches). The values of the set represented by a tip -- are the prefix plus the indices of the set bits in the bit map. -- -- Note: Valid entries stored in tip omitted. tipsValid :: IntSet -> Bool tipsValid t = case t of Nil -> True tip@(Tip p b) -> validTipPrefix p Bin _ _ l r -> tipsValid l && tipsValid r validTipPrefix :: Prefix -> Bool #if WORD_SIZE_IN_BITS==32 -- Last 5 bits of the prefix must be zero for 32 bit arches. validTipPrefix p = (0x0000001F .&. p) == 0 #else -- Last 6 bits of the prefix must be zero 64 bit anches. validTipPrefix p = (0x000000000000003F .&. p) == 0 #endif enummapset-0.6.0.1/tests/intset-properties.hs0000644000000000000000000003657400000000000017376 0ustar0000000000000000-- Copied from https://github.com/haskell/containers and tweaked slithgly {-# LANGUAGE CPP #-} import Data.Bits (popCount, (.&.)) import Data.EnumSet import Data.IntSet.Internal (IntSet (Bin)) import Data.List (nub, sort) import qualified Data.List as List import Data.Monoid (mempty) import qualified Data.Set as Set import Data.Word (Word) import qualified IntSetValidity as IntSetValidity (valid) import Prelude hiding (filter, foldl, foldr, lookup, map, null) import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test, Testable) import Test.QuickCheck hiding ((.&.)) valid :: EnumSet k -> Property valid = IntSetValidity.valid . enumSetToIntSet main :: IO () main = defaultMain [ testCase "lookupLT" test_lookupLT , testCase "lookupGT" test_lookupGT , testCase "lookupLE" test_lookupLE , testCase "lookupGE" test_lookupGE , testCase "split" test_split , testProperty "prop_Valid" prop_Valid , testProperty "prop_EmptyValid" prop_EmptyValid , testProperty "prop_SingletonValid" prop_SingletonValid , testProperty "prop_InsertIntoEmptyValid" prop_InsertIntoEmptyValid , testProperty "prop_Single" prop_Single , testProperty "prop_Member" prop_Member , testProperty "prop_NotMember" prop_NotMember , testProperty "prop_LookupLT" prop_LookupLT , testProperty "prop_LookupGT" prop_LookupGT , testProperty "prop_LookupLE" prop_LookupLE , testProperty "prop_LookupGE" prop_LookupGE , testProperty "prop_InsertDelete" prop_InsertDelete , testProperty "prop_MemberFromList" prop_MemberFromList , testProperty "prop_UnionInsert" prop_UnionInsert , testProperty "prop_UnionAssoc" (prop_UnionAssoc :: EnumSet Ordering -> EnumSet Ordering -> EnumSet Ordering -> Bool) , testProperty "prop_UnionComm" (prop_UnionComm :: EnumSet Integer -> EnumSet Integer -> Bool) , testProperty "prop_Diff" prop_Diff , testProperty "prop_Int" prop_Int , testProperty "prop_Ordered" prop_Ordered , testProperty "prop_List" prop_List , testProperty "prop_DescList" prop_DescList , testProperty "prop_AscDescList" prop_AscDescList , testProperty "prop_fromList" prop_fromList -- , testProperty "prop_MaskPow2" prop_MaskPow2 -- , testProperty "prop_Prefix" prop_Prefix -- , testProperty "prop_LeftRight" prop_LeftRight , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf , testProperty "prop_isProperSubsetOf2" (prop_isProperSubsetOf2 :: EnumSet Double -> EnumSet Double -> Bool) , testProperty "prop_isSubsetOf" prop_isSubsetOf , testProperty "prop_isSubsetOf2" (prop_isSubsetOf2 :: EnumSet Bool -> EnumSet Bool -> Bool) -- , testProperty "prop_disjoint" prop_disjoint , testProperty "prop_size" prop_size , testProperty "prop_findMax" prop_findMax , testProperty "prop_findMin" prop_findMin , testProperty "prop_ord" prop_ord , testProperty "prop_readShow" prop_readShow , testProperty "prop_foldR" prop_foldR , testProperty "prop_foldR'" prop_foldR' , testProperty "prop_foldL" prop_foldL , testProperty "prop_foldL'" prop_foldL' , testProperty "prop_map" (prop_map :: EnumSet Char -> Bool) , testProperty "prop_maxView" prop_maxView , testProperty "prop_minView" prop_minView , testProperty "prop_split" prop_split , testProperty "prop_splitMember" prop_splitMember -- , testProperty "prop_splitRoot" prop_splitRoot , testProperty "prop_partition" prop_partition , testProperty "prop_filter" prop_filter , testProperty "prop_bitcount" prop_bitcount ] ---------------------------------------------------------------- -- Unit tests ---------------------------------------------------------------- test_lookupLT :: Assertion test_lookupLT = do lookupLT 3 (fromList [3, 5]) @?= Nothing lookupLT 5 (fromList [3, 5]) @?= Just 3 test_lookupGT :: Assertion test_lookupGT = do lookupGT 4 (fromList [3, 5]) @?= Just 5 lookupGT 5 (fromList [3, 5]) @?= Nothing test_lookupLE :: Assertion test_lookupLE = do lookupLE 2 (fromList [3, 5]) @?= Nothing lookupLE 4 (fromList [3, 5]) @?= Just 3 lookupLE 5 (fromList [3, 5]) @?= Just 5 test_lookupGE :: Assertion test_lookupGE = do lookupGE 3 (fromList [3, 5]) @?= Just 3 lookupGE 4 (fromList [3, 5]) @?= Just 5 lookupGE 6 (fromList [3, 5]) @?= Nothing test_split :: Assertion test_split = do split 3 (fromList [1..5]) @?= (fromList [1,2], fromList [4,5]) {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} instance (Enum k, Arbitrary k) => Arbitrary (EnumSet k) where arbitrary = do{ xs <- arbitrary ; return (fromList xs) } {-------------------------------------------------------------------- Valid IntMaps --------------------------------------------------------------------} forValid :: Testable a => (EnumSet Int -> a) -> Property forValid f = forAll arbitrary $ \t -> classify (size t == 0) "empty" $ classify (size t > 0 && size t <= 10) "small" $ classify (size t > 10 && size t <= 64) "medium" $ classify (size t > 64) "large" $ f t forValidUnitTree :: Testable a => (EnumSet Int -> a) -> Property forValidUnitTree f = forValid f prop_Valid :: Property prop_Valid = forValidUnitTree $ \t -> valid t {-------------------------------------------------------------------- Construction validity --------------------------------------------------------------------} prop_EmptyValid :: Property prop_EmptyValid = valid empty prop_SingletonValid :: Int -> Property prop_SingletonValid x = valid (singleton x) prop_InsertIntoEmptyValid :: Int -> Property prop_InsertIntoEmptyValid x = valid (insert x empty) {-------------------------------------------------------------------- Single, Member, Insert, Delete, Member, FromList --------------------------------------------------------------------} prop_Single :: Int -> Bool prop_Single x = (insert x empty == singleton x) prop_Member :: [Int] -> Int -> Bool prop_Member xs n = let m = fromList xs in all (\k -> k `member` m == (k `elem` xs)) (n : xs) prop_NotMember :: [Int] -> Int -> Bool prop_NotMember xs n = let m = fromList xs in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs) test_LookupSomething :: (Int -> EnumSet Int -> Maybe Int) -> (Int -> Int -> Bool) -> [Int] -> Bool test_LookupSomething lookup' cmp xs = let odd_sorted_xs = filter_odd $ nub $ sort xs t = fromList odd_sorted_xs test x = case List.filter (`cmp` x) odd_sorted_xs of [] -> lookup' x t == Nothing cs | 0 `cmp` 1 -> lookup' x t == Just (last cs) -- we want largest such element | otherwise -> lookup' x t == Just (head cs) -- we want smallest such element in all test xs where filter_odd [] = [] filter_odd [_] = [] filter_odd (_ : o : xs) = o : filter_odd xs prop_LookupLT :: [Int] -> Bool prop_LookupLT = test_LookupSomething lookupLT (<) prop_LookupGT :: [Int] -> Bool prop_LookupGT = test_LookupSomething lookupGT (>) prop_LookupLE :: [Int] -> Bool prop_LookupLE = test_LookupSomething lookupLE (<=) prop_LookupGE :: [Int] -> Bool prop_LookupGE = test_LookupSomething lookupGE (>=) prop_InsertDelete :: Int -> EnumSet Int -> Property prop_InsertDelete k t = not (member k t) ==> case delete k (insert k t) of t' -> valid t' .&&. t' === t prop_MemberFromList :: [Int] -> Bool prop_MemberFromList xs = all (`member` t) abs_xs && all ((`notMember` t) . negate) abs_xs where abs_xs = [abs x | x <- xs, x /= 0] t = fromList abs_xs {-------------------------------------------------------------------- Union, Difference and Intersection --------------------------------------------------------------------} prop_UnionInsert :: Int -> EnumSet Int -> Property prop_UnionInsert x t = case union t (singleton x) of t' -> valid t' .&&. t' === insert x t prop_UnionAssoc :: EnumSet k -> EnumSet k -> EnumSet k -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: EnumSet k -> EnumSet k -> Bool prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1) prop_Diff :: [Int] -> [Int] -> Property prop_Diff xs ys = case difference (fromList xs) (fromList ys) of t -> valid t .&&. toAscList t === List.sort ((List.\\) (nub xs) (nub ys)) prop_Int :: [Int] -> [Int] -> Property prop_Int xs ys = case intersection (fromList xs) (fromList ys) of t -> valid t .&&. toAscList t === List.sort (nub ((List.intersect) (xs) (ys))) {- prop_disjoint :: EnumSet k -> EnumSet k -> Bool prop_disjoint a b = a `disjoint` b == null (a `intersection` b) -} {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = concat [[i-n,i-n]|i<-[0..2*n :: Int]] in fromAscList xs == fromList xs prop_List :: [Int] -> Bool prop_List xs = (sort (nub xs) == toAscList (fromList xs)) prop_DescList :: [Int] -> Bool prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs)) prop_AscDescList :: [Int] -> Bool prop_AscDescList xs = toAscList s == reverse (toDescList s) where s = fromList xs prop_fromList :: [Int] -> Property prop_fromList xs = case fromList xs of t -> valid t .&&. t === fromAscList sort_xs .&&. t === fromDistinctAscList nub_sort_xs .&&. t === List.foldr insert empty xs where sort_xs = sort xs nub_sort_xs = List.map List.head $ List.group sort_xs {-------------------------------------------------------------------- Bin invariants --------------------------------------------------------------------} powersOf2 :: EnumSet Int powersOf2 = fromList [2^i | i <- [0..63]] {- -- Check the invariant that the mask is a power of 2. prop_MaskPow2 :: EnumSet k -> Bool prop_MaskPow2 (Bin _ msk left right) = member msk powersOf2 && prop_MaskPow2 left && prop_MaskPow2 right prop_MaskPow2 _ = True -- Check that the prefix satisfies its invariant. prop_Prefix :: EnumSet k -> Bool prop_Prefix s@(Bin prefix msk left right) = all (\elem -> match elem prefix msk) (toList s) && prop_Prefix left && prop_Prefix right prop_Prefix _ = True -- Check that the left elements don't have the mask bit set, and the right -- ones do. prop_LeftRight :: EnumSet k -> Bool prop_LeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right] prop_LeftRight _ = True -} {-------------------------------------------------------------------- EnumSet k operations are like Set operations --------------------------------------------------------------------} toSet :: EnumSet Int -> Set.Set Int toSet = Set.fromList . toList -- Check that EnumSet k.isProperSubsetOf is the same as Set.isProperSubsetOf. prop_isProperSubsetOf :: EnumSet Int -> EnumSet Int -> Bool prop_isProperSubsetOf a b = isProperSubsetOf a b == Set.isProperSubsetOf (toSet a) (toSet b) -- In the above test, isProperSubsetOf almost always returns False (since a -- random set is almost never a subset of another random set). So this second -- test checks the True case. prop_isProperSubsetOf2 :: EnumSet k -> EnumSet k -> Bool prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where c = union a b prop_isSubsetOf :: EnumSet Int -> EnumSet Int -> Bool prop_isSubsetOf a b = isSubsetOf a b == Set.isSubsetOf (toSet a) (toSet b) prop_isSubsetOf2 :: EnumSet k -> EnumSet k -> Bool prop_isSubsetOf2 a b = isSubsetOf a (union a b) prop_size :: EnumSet Int -> Property prop_size s = sz === foldl' (\i _ -> i + 1) (0 :: Int) s .&&. sz === List.length (toList s) where sz = size s prop_findMax :: EnumSet Int -> Property prop_findMax s = not (null s) ==> findMax s == maximum (toList s) prop_findMin :: EnumSet Int -> Property prop_findMin s = not (null s) ==> findMin s == minimum (toList s) prop_ord :: EnumSet Int -> EnumSet Int -> Bool prop_ord s1 s2 = s1 `compare` s2 == toList s1 `compare` toList s2 prop_readShow :: EnumSet Int -> Bool prop_readShow s = s == read (show s) prop_foldR :: EnumSet Int -> Bool prop_foldR s = foldr (:) [] s == toList s prop_foldR' :: EnumSet Int -> Bool prop_foldR' s = foldr' (:) [] s == toList s prop_foldL :: EnumSet Int -> Bool prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s) prop_foldL' :: EnumSet Int -> Bool prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s) prop_map :: Enum k => EnumSet k -> Bool prop_map s = map id s == s prop_maxView :: EnumSet Int -> Bool prop_maxView s = case maxView s of Nothing -> null s Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s' prop_minView :: EnumSet Int -> Bool prop_minView s = case minView s of Nothing -> null s Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s' prop_split :: EnumSet Int -> Int -> Property prop_split s i = case split i s of (s1,s2) -> valid s1 .&&. valid s2 .&&. all (i) (toList s2) .&&. i `delete` s === union s1 s2 prop_splitMember :: EnumSet Int -> Int -> Property prop_splitMember s i = case splitMember i s of (s1,t,s2) -> valid s1 .&&. valid s2 .&&. all (i) (toList s2) .&&. t === i `member` s .&&. i `delete` s === union s1 s2 {- prop_splitRoot :: EnumSet k -> Bool prop_splitRoot s = loop ls && (s == unions ls) where ls = splitRoot s loop [] = True loop (s1:rst) = List.null [ (x,y) | x <- toList s1 , y <- toList (unions rst) , x > y ] -} prop_partition :: EnumSet Int -> Int -> Property prop_partition s i = case partition odd s of (s1,s2) -> valid s1 .&&. valid s2 .&&. all odd (toList s1) .&&. all even (toList s2) .&&. s === s1 `union` s2 prop_filter :: EnumSet Int -> Int -> Property prop_filter s i = let parts = partition odd s odds = filter odd s evens = filter even s in valid odds .&&. valid evens .&&. parts === (odds, evens) prop_bitcount :: Int -> Word -> Bool prop_bitcount a w = bitcount_orig a w == bitcount_new a w where bitcount_orig a0 x0 = go a0 x0 where go a 0 = a go a x = go (a + 1) (x .&. (x-1)) bitcount_new a x = a + popCount x