Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

singleton, insert, insertWith and insertWithKey now operate on subtrees

  • Loading branch information...
commit 5091d4c3f7944176abb6d2c273885457d48617de 1 parent ea1ece0
@bovinespirit authored
View
58 Data/EnumMapMap/Base.hs
@@ -153,7 +153,13 @@ type family Plus k1 k2 :: *
type instance Plus (k1 :& t) k2 = k1 :& Plus t k2
class SubKey k1 k2 v where
+ -- k1 should be a prefix of k2. If @k1 ~ k2@ then the 'Result' will be @v@.
type Result k1 k2 v :: *
+ -- | An 'EnumMapMap' with one element
+ --
+ -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
+ -- > singleton (K 5) $ singleton (K 2) "a" == fromList [(5 :& K 3, "a")]
+ singleton :: k1 -> Result k1 k2 v -> EnumMapMap k2 v
-- | Lookup up the value at a key in the 'EnumMapMap'.
--
-- > emm = fromList [(3 :& K 1, "a")]
@@ -168,6 +174,18 @@ class SubKey k1 k2 v where
--
lookup :: (IsKey k1, IsKey k2) =>
k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v)
+ -- | Insert a new key\/value pair into the 'EnumMapMap'. Can also insert submaps.
+ insert :: (IsKey k1, IsKey k2) =>
+ k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+ -- | Insert with a combining function. Can also insert submaps.
+ insertWith :: (IsKey k1, IsKey k2) =>
+ (Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
+ -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+ insertWith f = insertWithKey (\_ -> f)
+ -- | Insert with a combining function. Can also insert submaps.
+ insertWithKey :: (IsKey k1, IsKey k2) =>
+ (k1 -> Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
+ -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
-- | Remove a key and it's value from the 'EnumMapMap'. If the key is not
-- present the original 'EnumMapMap' is returned.
delete :: (IsKey k1, IsKey k2) =>
@@ -176,6 +194,9 @@ class SubKey k1 k2 v where
instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
SubKey (k :& t1) (k :& t2) v where
type Result (k :& t1) (k :& t2) v = Result t1 t2 v
+
+ singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
+
lookup !(key' :& nxt) (KCC emm) = key `seq` go emm
where
go (Bin _ m l r)
@@ -187,6 +208,15 @@ instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
False -> Nothing
go Nil = Nothing
key = fromEnum key'
+
+ insert (key :& nxt) val (KCC emm) =
+ KCC $ insertWith_ (insert nxt val) key (singleton nxt val) emm
+
+ insertWithKey f k@(key :& nxt) val (KCC emm) =
+ KCC $ insertWith_ go key (singleton nxt val) emm
+ where
+ go = insertWithKey (\_ -> f k) nxt val
+
delete !(key :& nxt) (KCC emm) =
KCC $ alter_ (delete nxt) (fromEnum key) emm
@@ -265,19 +295,6 @@ class (Eq k) => IsKey k where
size :: EnumMapMap k v -> Int
-- | Is the key present in the 'EnumMapMap'?
member :: k -> EnumMapMap k v -> Bool
- -- | An 'EnumMapMap' with one element
- --
- -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
- singleton :: k -> v -> EnumMapMap k v
- -- | Insert a new key\/value pair into the 'EnumMapMap'.
- insert :: k -> v -> EnumMapMap k v -> EnumMapMap k v
- -- | Insert with a combining function.
- insertWith :: (v -> v -> v)
- -> k -> v -> EnumMapMap k v -> EnumMapMap k v
- insertWith f = insertWithKey (\_ -> f)
- -- | Insert with a combining function.
- insertWithKey :: (k -> v -> v -> v)
- -> k -> v -> EnumMapMap k v -> EnumMapMap k v
-- | The expression (@'alter' f k emm@) alters the value at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in an 'EnumMapMap'.
alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v
@@ -293,10 +310,11 @@ class (Eq k) => IsKey k where
-- binary operator.
foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t
-- | Convert the 'EnumMapMap' to a list of key\/value pairs.
- toList :: EnumMapMap k v -> [(k, v)]
+ toList :: SubKey k k v =>
+ EnumMapMap k v -> [(k, v)]
toList = foldrWithKey (\k x xs -> (k, x):xs) []
-- | Create a 'EnumMapMap' from a list of key\/value pairs.
- fromList :: [(k, v)] -> EnumMapMap k v
+ fromList :: (SubKey k k v, Result k k v ~ v) => [(k, v)] -> EnumMapMap k v
fromList = foldlStrict (\t (k, x) -> insert k x t) empty
-- | List of elements in ascending order of keys
elems :: EnumMapMap k v -> [v]
@@ -400,16 +418,6 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
Nil -> False
key = fromEnum key'
- singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
-
- insert (key :& nxt) val (KCC emm)
- = KCC $ insertWith_ (insert nxt val) key (singleton nxt val) emm
-
- insertWithKey f k@(key :& nxt) val (KCC emm) =
- KCC $ insertWith_ go key (singleton nxt val) emm
- where
- go = insertWithKey (\_ -> f k) nxt val
-
alter f !(key :& nxt) (KCC emm) =
KCC $ alter_ (alter f nxt) (fromEnum key) emm
View
65 Data/EnumMapMap/Lazy.hs
@@ -143,33 +143,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False
key = fromEnum key'
- singleton !(K key) = KEC . Tip (fromEnum key)
-
- insert !(K key') val (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky _
- | key == ky -> Tip key val
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
- insertWithKey f k@(K key') val (KEC emm) = KEC $ go emm
- where go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky y
- | key == ky -> Tip key (f k val y)
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -275,12 +248,20 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
- lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ singleton !(K key) = KCC . Tip (fromEnum key)
+ lookup !(K key') (KCC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KCC emm) =
+ KCC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
+ singleton !(K key) = KEC . Tip (fromEnum key)
lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KEC emm) =
+ KEC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
lookup_ :: Key -> EMM k v -> Maybe v
@@ -292,6 +273,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing
Nil -> Nothing
+insert_ :: Key -> v -> EMM k v -> EMM k v
+insert_ !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky _
+ | key == ky -> Tip key val
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
+insertWK :: (v -> v -> v) -> Key -> v -> EMM k v -> EMM k v
+insertWK f !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky y
+ | key == ky -> Tip key (f val y)
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
delete_ :: Key -> EMM k v -> EMM k v
delete_ !key emm =
case emm of
View
63 Data/EnumMapMap/Strict.hs
@@ -144,33 +144,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False
key = fromEnum key'
- singleton !(K key) !val = KEC $ Tip (fromEnum key) val
-
- insert !(K key') !val (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky _
- | key == ky -> Tip key val
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
- insertWithKey f k@(K key') !val (KEC emm) = KEC $ go emm
- where go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky y
- | key == ky -> Tip key $! (f k val y)
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -276,12 +249,20 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
+ singleton !(K key) = KCC . Tip (fromEnum key)
lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KCC emm) =
+ KCC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
+ singleton !(K key) !val = KEC $! Tip (fromEnum key) val
lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') !val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') !val (KEC emm) =
+ KEC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
lookup_ :: Key -> EMM k v -> Maybe v
@@ -293,6 +274,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing
Nil -> Nothing
+insert_ :: Key -> v -> EMM k v -> EMM k v
+insert_ !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky _
+ | key == ky -> Tip key val
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
+insertWK :: (v -> v -> v) -> Key -> v -> EMM k v -> EMM k v
+insertWK f !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky y
+ | key == ky -> Tip key (f val y)
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
delete_ :: Key -> EMM k v -> EMM k v
delete_ !key emm =
case emm of
View
77 Data/EnumMapSet/Base.hs
@@ -29,6 +29,7 @@ module Data.EnumMapSet.Base (
empty,
singleton,
insert,
+ insertSub,
delete,
-- * Combine
union,
@@ -136,14 +137,6 @@ instance (Enum k, Eq k) => IsKey (S k) where
go Nil = False
key = fromEnum key'
- singleton (S key') _
- = key `seq` KSC $ Tip (prefixOf key) (bitmapOf key)
- where key = fromEnum key'
-
- insert (S key') _ (KSC ems)
- = key `seq` KSC $ insertBM (prefixOf key) (bitmapOf key) ems
- where key = fromEnum key'
-
foldrWithKey f init (KSC ems)
= case ems of Bin _ m l r | m < 0 -> go (go init l) r
| otherwise -> go (go init r) l
@@ -264,8 +257,6 @@ instance (Enum k, Eq k) => IsKey (S k) where
go Nil Nil = False
go _ _ = True
- insertWith = undefined
- insertWithKey = undefined
alter = undefined
foldr = undefined
map = undefined
@@ -311,12 +302,18 @@ lookup = EMM.lookup
empty :: (IsKey k) => EnumMapSet k
empty = EMM.empty
-singleton :: (IsKey k) => k -> EnumMapSet k
+singleton :: (IsKey k, EMM.SubKey k k (), EMM.Result k k () ~ ()) =>
+ k -> EnumMapSet k
singleton !key = EMM.singleton key ()
-insert :: (IsKey k) => k -> EnumMapSet k -> EnumMapSet k
+insert :: (IsKey k, EMM.SubKey k k (), EMM.Result k k () ~ ()) =>
+ k -> EnumMapSet k -> EnumMapSet k
insert !key = EMM.insert key ()
+insertSub :: (IsKey k1, IsKey k2, EMM.SubKey k1 k2 ()) =>
+ k1 -> EMM.Result k1 k2 () -> EnumMapSet k2 -> EnumMapSet k2
+insertSub !key = EMM.insert key
+
delete :: (EMM.SubKey k1 k2 (), IsKey k1, IsKey k2) =>
k1 -> EnumMapSet k2 -> EnumMapSet k2
delete = EMM.delete
@@ -331,7 +328,7 @@ foldr f = EMM.foldrWithKey go
--
-- It's worth noting that the size of the result may be smaller if,
-- for some @(x,y)@, @x \/= y && f x == f y@
-map :: (IsKey k1, IsKey k2) =>
+map :: (IsKey k1, IsKey k2, EMM.SubKey k2 k2 (), EMM.Result k2 k2 () ~ ()) =>
(k1 -> k2) -> EnumMapSet k1 -> EnumMapSet k2
map f = fromList . List.map f . toList
@@ -348,7 +345,8 @@ intersection = EMM.intersection
Lists
---------------------------------------------------------------------}
-fromList :: IsKey k => [k] -> EnumMapSet k
+fromList :: (IsKey k, EMM.SubKey k k (), EMM.Result k k () ~ ()) =>
+ [k] -> EnumMapSet k
fromList xs
= foldlStrict (\t x -> insert x t) empty xs
@@ -369,6 +367,9 @@ instance EMM.HasSKey (S k) where
instance (Enum k1, k1 ~ k2) => EMM.SubKey (S k1) (k2 :& t2) () where
type Result (S k1) (k2 :& t2) () = EnumMapSet t2
+
+ singleton !(S key) = EMM.KCC . EMM.Tip (fromEnum key)
+
lookup (S key') (EMM.KCC emm) = key `seq` go emm
where
go (EMM.Bin _ m l r)
@@ -380,6 +381,21 @@ instance (Enum k1, k1 ~ k2) => EMM.SubKey (S k1) (k2 :& t2) () where
False -> Nothing
go EMM.Nil = Nothing
key = fromEnum key'
+
+ insert (S key') val (EMM.KCC emm) = key `seq` EMM.KCC $ go emm
+ where
+ go t =
+ case t of
+ EMM.Bin p m l r
+ | nomatch key p m -> EMM.join key (EMM.Tip key val) p t
+ | zero key m -> EMM.Bin p m (go l) r
+ | otherwise -> EMM.Bin p m l (go r)
+ EMM.Tip ky _
+ | key == ky -> EMM.Tip key val
+ | otherwise -> EMM.join key (EMM.Tip key val) ky t
+ EMM.Nil -> EMM.Tip key val
+ key = fromEnum key'
+
delete (S key') (EMM.KCC emm) = key `seq` EMM.KCC $ go emm
where
go t = case t of
@@ -391,28 +407,39 @@ instance (Enum k1, k1 ~ k2) => EMM.SubKey (S k1) (k2 :& t2) () where
EMM.Nil -> EMM.Nil
key = fromEnum key'
+ insertWith = undefined
+ insertWithKey = undefined
+
instance (Enum k) => EMM.SubKey (S k) (S k) () where
- type Result (S k) (S k) () = Bool
+ type Result (S k) (S k) () = ()
+ singleton !(S key') _ = KSC $! Tip (prefixOf key) (bitmapOf key)
+ where key = fromEnum key'
lookup = undefined
+ insert (S key') _ (KSC ems) =
+ key `seq` KSC $ insertBM (prefixOf key) (bitmapOf key) ems
+ where key = fromEnum key'
delete !(S key') (KSC ems) =
key `seq` KSC $ deleteBM (prefixOf key) (bitmapOf key) ems
where key = fromEnum key'
+ insertWith = undefined
+ insertWithKey = undefined
+
{---------------------------------------------------------------------
Helper functions
---------------------------------------------------------------------}
insertBM :: Prefix -> BitMap -> EMS k -> EMS k
-insertBM !kx !bm t
- = case t of
- Bin p m l r
- | nomatch kx p m -> join kx (Tip kx bm) p t
- | zero kx m -> Bin p m (insertBM kx bm l) r
- | otherwise -> Bin p m l (insertBM kx bm r)
- Tip kx' bm'
- | kx' == kx -> Tip kx' (bm .|. bm')
- | otherwise -> join kx (Tip kx bm) kx' t
- Nil -> Tip kx bm
+insertBM !kx !bm t =
+ case t of
+ Bin p m l r
+ | nomatch kx p m -> join kx (Tip kx bm) p t
+ | zero kx m -> Bin p m (insertBM kx bm l) r
+ | otherwise -> Bin p m l (insertBM kx bm r)
+ Tip kx' bm'
+ | kx' == kx -> Tip kx' (bm .|. bm')
+ | otherwise -> join kx (Tip kx bm) kx' t
+ Nil -> Tip kx bm
deleteBM :: Prefix -> BitMap -> EMS k -> EMS k
deleteBM !kx !bm t
View
2  test/EnumMapSetVsIntSet.hs
@@ -18,7 +18,7 @@ type TestSet2 = EnumMapSet (Int :& S Int)
type TestSet3 = EnumMapSet (Int :& Int :& S Int)
list2l1 :: [Int] -> [S Int]
-list2l1 = map (\k -> S k)
+list2l1 = map S
list2l2 :: Int -> [Int] -> [Int :& S Int]
list2l2 k1 = map (\k -> k :& S k1)
View
127 test/UnitEnumMapMap.hs
@@ -26,15 +26,26 @@ instance (Arbitrary a) => Arbitrary (K a) where
arbitrary = liftM K arbitrary
newtype ID1 = ID1 Int
- deriving (Show, Enum, Arbitrary, Eq)
+ deriving (Show, Enum, Arbitrary, Eq, Num)
newtype ID2 = ID2 Int
- deriving (Show, Enum, Arbitrary, Eq)
+ deriving (Show, Enum, Arbitrary, Eq, Num)
newtype ID3 = ID3 Int
- deriving (Show, Enum, Arbitrary, Eq)
+ deriving (Show, Enum, Arbitrary, Eq, Num)
+type TestKey1 = K ID1
+type TestEmm1 = EnumMapMap TestKey1 Int
+type TestKey2 = ID2 :& K ID1
+type TestEmm2 = EnumMapMap TestKey2 Int
type TestKey3 = ID3 :& ID2 :& K ID1
type TestEmm3 = EnumMapMap TestKey3 Int
+type I = K Int
+
+-- Functions that are part of 'SubKey' class can't cope with @K 1@ because GHC
+-- doesn't know it's also an 'Int'.
+k :: Int -> K Int
+k = K
+
tens :: [Int]
tens = [1, 10, 100, 1000, 10000, 100000, 1000000]
@@ -50,23 +61,23 @@ evens = [2, 4..1000]
alls :: [Int]
alls = [1, 2..1000]
-l1tens :: EnumMapMap (K Int) Int
-l1tens = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip [1..7] tens
-l2tens :: EnumMapMap (Int :& K Int) Int
+l1tens :: EnumMapMap I Int
+l1tens = EMM.fromList $ map (\(key, v) -> (K key, v)) $ zip [1..7] tens
+l2tens :: EnumMapMap (Int :& I) Int
l2tens = EMM.fromList $ zip (do
k1 <- [1, 2]
k2 <- [1..7]
return $ k1 :& K k2) $ cycle tens
l1odds :: EnumMapMap (K Int) Int
-l1odds = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip odds odds
+l1odds = EMM.fromList $ map (\(key, v) -> (K key, v)) $ zip odds odds
l2odds :: EnumMapMap (Int :& K Int) Int
l2odds = EMM.fromList $ zip (do
k1 <- fewOdds
k2 <- fewOdds
return $ k1 :& K k2) $ cycle odds
l1evens :: EnumMapMap (K Int) Int
-l1evens = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip evens evens
+l1evens = EMM.fromList $ map (\(key, v) -> (K key, v)) $ zip evens evens
l1alls :: EnumMapMap (K Int) Int
l1alls = EMM.fromList $ zip (map K alls) alls
@@ -102,7 +113,7 @@ main =
key3 = ID3 1 :& ID2 2 :& (K $ ID1 3)
describe "looks up a subtree" $ do
let emm2 :: EnumMapMap (Int :& K Int) Int
- emm2 = EMM.fromList [(1 :& K 2, 5)]
+ emm2 = EMM.fromList [(1 :& k 2, 5)]
key1 :: K ID3
key1 = K $ ID3 1
key2 :: ID3 :& K ID2
@@ -117,27 +128,35 @@ main =
it "looks up a value" $
(EMM.lookup key3 emm3) @?= Just 4
+ describe "singleton" $ do
+ let emm2 :: EnumMapMap (ID1 :& K ID2) String
+ emm2 = EMM.fromList [(ID1 1 :& (K $ ID2 2), "a")]
+ it "creates an EnumMapMap with one value" $
+ (EMM.singleton (ID1 1 :& (K $ ID2 2)) "a") @?= emm2
+ it "creates an EnumMapMap with a sub EnumMapMap" $
+ (EMM.singleton (K $ ID1 1) $ EMM.singleton (K $ ID2 2) "a") @?= emm2
+
describe "insert" $ do
describe "Level 1" $ do
it "creates a value in an empty EMM" $
- EMM.insert (K 1) 1 EMM.empty @?=
- (EMM.fromList [(K 1, 1)]
- :: EnumMapMap (K Int) Int)
+ EMM.insert (k 1) 1 EMM.empty @?=
+ (EMM.fromList [(k 1, 1)]
+ :: EnumMapMap I Int)
it "adds another value to an EMM" $
let
emm :: EnumMapMap (K Int) Int
- emm = EMM.fromList [(K 2, 2)] in
- EMM.insert (K 1) 1 emm @?=
- EMM.fromList [(K 1, 1), (K 2, 2)]
+ emm = EMM.fromList [(k 2, 2)] in
+ EMM.insert (k 1) 1 emm @?=
+ EMM.fromList [(k 1, 1), (k 2, 2)]
it "overwrites a value with the same key in an EMM" $
let emm :: EnumMapMap (K Int) Int
emm = EMM.fromList [(K 1, 1), (K 2, 2)] in
- EMM.insert (K 1) 3 emm @?=
+ EMM.insert (k 1) 3 emm @?=
EMM.fromList [(K 1, 3), (K 2, 2)]
describe "Level 2" $ do
it "creates a value in an empty EMM" $
- EMM.insert (1 :& K 1) 1 EMM.empty @?=
+ EMM.insert ((1 :: Int) :& k 1) 1 EMM.empty @?=
(EMM.fromList [(1 :& K 1, 1)]
:: EnumMapMap (Int :& K Int) Int)
it "adds another value to an EMM on level 1" $
@@ -145,72 +164,84 @@ main =
emm :: EnumMapMap (Int :& K Int) Int
emm = EMM.fromList [(1 :& K 2, 2)]
in
- EMM.insert (1 :& K 1) 1 emm @?=
+ EMM.insert ((1 :: Int) :& k 1) 1 emm @?=
EMM.fromList [(1 :& K 1, 1), (1 :& K 2, 2)]
it "adds another value to an EMM on level 2" $
let
emm :: EnumMapMap (Int :& K Int) Int
emm = EMM.fromList [(1 :& K 1, 1)]
in
- EMM.insert (2 :& K 2) 2 emm @?=
+ EMM.insert ((2 :: Int) :& k 2) 2 emm @?=
EMM.fromList [(1 :& K 1, 1), (2 :& K 2, 2)]
+ describe "Subtrees" $ do
+ let emm2 :: TestEmm2
+ emm2 = EMM.fromList [(ID2 2 :& (K $ ID1 3), 4)]
+ emm1 :: TestEmm1
+ emm1 = EMM.fromList [(K $ ID1 4, 12)]
+ it "inserts a L1 into an empty L3 EMM" $
+ EMM.insert (ID3 2 :& (K $ ID2 3)) emm1 EMM.empty @?=
+ EMM.fromList [(ID3 2 :& ID2 3 :& (K $ ID1 4), 12)]
+ it "inserts a L2 into an empty L3 EMM" $
+ EMM.insert (K $ ID3 1) emm2 EMM.empty @?=
+ EMM.fromList [(ID3 1 :& ID2 2 :& (K $ ID1 3), 4)]
+
describe "insertWithKey" $ do
let undef = undefined -- fail if this is called
describe "Level 1" $ do
it "creates a value in an empty EMM" $
- EMM.insertWithKey undef (K 1) 1 EMM.empty @?=
- (EMM.fromList [(K 1, 1)]
+ EMM.insertWithKey undef (k 1) 1 EMM.empty @?=
+ (EMM.fromList [(k 1, 1)]
:: EnumMapMap (K Int) Int)
it "adds another value to an EMM" $
let
emm :: EnumMapMap (K Int) Int
emm = EMM.fromList [(K 2, 2)] in
- EMM.insertWithKey undef (K 1) 1 emm @?=
- EMM.fromList [(K 1, 1), (K 2, 2)]
+ EMM.insertWithKey undef (k 1) 1 emm @?=
+ EMM.fromList [(k 1, 1), (k 2, 2)]
it "applies the function when overwriting" $
let emm :: EnumMapMap (K Int) Int
- emm = EMM.fromList [(K 1, 1), (K 2, 4)]
+ emm = EMM.fromList [(k 1, 1), (k 2, 4)]
f (K key1) o n = key1 * (o + n)
in
- EMM.insertWithKey f (K 2) 3 emm @?=
- EMM.fromList [(K 1, 1), (K 2, 14)]
+ EMM.insertWithKey f (k 2) 3 emm @?=
+ EMM.fromList [(k 1, 1), (k 2, 14)]
describe "Level 2" $ do
it "creates a value in an empty EMM" $
- EMM.insertWithKey undef (1 :& K 1) 1 EMM.empty @?=
- (EMM.fromList [(1 :& K 1, 1)]
- :: EnumMapMap (Int :& K Int) Int)
+ EMM.insertWithKey undef (ID2 1 :& k 1) 1 EMM.empty @?=
+ (EMM.fromList [(ID2 1 :& k 1, 1)]
+ :: EnumMapMap (ID2 :& K Int) Int)
it "adds another value to an EMM on level 1" $
let
- emm :: EnumMapMap (Int :& K Int) Int
- emm = EMM.fromList [(1 :& K 2, 2)]
+ emm :: EnumMapMap (ID2 :& K Int) Int
+ emm = EMM.fromList [(ID2 1 :& k 2, 2)]
in
- EMM.insertWithKey undef (1 :& K 1) 1 emm @?=
- EMM.fromList [(1 :& K 1, 1), (1 :& K 2, 2)]
+ EMM.insertWithKey undef (ID2 1 :& k 1) 1 emm @?=
+ EMM.fromList [(ID2 1 :& K 1, 1), (ID2 1 :& K 2, 2)]
it "adds another value to an EMM on level 2" $
let
- emm :: EnumMapMap (Int :& K Int) Int
- emm = EMM.fromList [(1 :& K 1, 1)]
+ emm :: EnumMapMap (ID2 :& K Int) Int
+ emm = EMM.fromList [(ID2 1 :& k 1, 1)]
in
- EMM.insertWithKey undef (2 :& K 2) 2 emm @?=
- EMM.fromList [(1 :& K 1, 1), (2 :& K 2, 2)]
+ EMM.insertWithKey undef (ID2 2 :& k 2) 2 emm @?=
+ EMM.fromList [(ID2 1 :& K 1, 1), (ID2 2 :& K 2, 2)]
it "applies the function when overwriting" $
let emm :: EnumMapMap (Int :& K Int) Int
- emm = EMM.fromList [(2 :& K 3, 1), (2 :& K 4, 5)]
+ emm = EMM.fromList [((2 :: Int) :& K 3, 1), ((2 :: Int) :& K 4, 5)]
f (k1 :& K k2) o n = (k1 + k2) * (o + n)
in
- EMM.insertWithKey f (2 :& K 4) 3 emm @?=
- EMM.fromList [(2 :& K 3, 1), (2 :& K 4, 48)]
+ EMM.insertWithKey f (2 :& k 4) 3 emm @?=
+ EMM.fromList [((2 :: Int) :& K 3, 1), ((2 :: Int) :& K 4, 48)]
describe "delete" $ do
describe "leaves no empty subtrees" $ do
- prop "Full key" $ \(k :: ID3 :& ID2 :& K ID1) l ->
- not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
- prop "2 dimensional key" $ \(k :: ID3 :& K ID2) l ->
- not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
- prop "1 dimensional key" $ \(k :: K ID3) l ->
- not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
+ prop "Full key" $ \(key :: ID3 :& ID2 :& K ID1) l ->
+ not $ EMM.emptySubTrees $ EMM.delete key $ (EMM.fromList l :: TestEmm3)
+ prop "2 dimensional key" $ \(key :: ID3 :& K ID2) l ->
+ not $ EMM.emptySubTrees $ EMM.delete key $ (EMM.fromList l :: TestEmm3)
+ prop "1 dimensional key" $ \(key :: K ID3) l ->
+ not $ EMM.emptySubTrees $ EMM.delete key $ (EMM.fromList l :: TestEmm3)
describe "alter" $ do
let f b1 b2 n v = case v of
@@ -218,8 +249,8 @@ main =
Just v' -> case b1 of
True -> Just $ if b2 then v' else n
False -> Nothing
- prop "leaves no empty subtrees" $ \k l b1 b2 n ->
- not $ EMM.emptySubTrees $ EMM.alter (f b1 b2 n) k $
+ prop "leaves no empty subtrees" $ \key l b1 b2 n ->
+ not $ EMM.emptySubTrees $ EMM.alter (f b1 b2 n) key $
(EMM.fromList l :: TestEmm3)
describe "foldrWithKey" $ do
Please sign in to comment.
Something went wrong with that request. Please try again.