Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-typerep-map for openSUSE:Factory
checked in at 2021-08-25 20:57:13
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-typerep-map (Old)
and /work/SRC/openSUSE:Factory/.ghc-typerep-map.new.1899 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-typerep-map"
Wed Aug 25 20:57:13 2021 rev:3 rq:912641 version:0.4.0.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-typerep-map/ghc-typerep-map.changes
2020-12-22 11:48:13.369947886 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-typerep-map.new.1899/ghc-typerep-map.changes
2021-08-25 20:58:19.793151607 +0200
@@ -1,0 +2,9 @@
+Wed Aug 4 08:16:38 UTC 2021 - [email protected]
+
+- Update typerep-map to version 0.4.0.0.
+ Upstream has edited the change log file since the last release in
+ a non-trivial way, i.e. they did more than just add a new entry
+ at the top. You can review the file at:
+ http://hackage.haskell.org/package/typerep-map-0.4.0.0/src/CHANGELOG.md
+
+-------------------------------------------------------------------
Old:
----
typerep-map-0.3.3.0.tar.gz
New:
----
typerep-map-0.4.0.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-typerep-map.spec ++++++
--- /var/tmp/diff_new_pack.l0GxPR/_old 2021-08-25 20:58:20.601150547 +0200
+++ /var/tmp/diff_new_pack.l0GxPR/_new 2021-08-25 20:58:20.601150547 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-typerep-map
#
-# Copyright (c) 2020 SUSE LLC
+# Copyright (c) 2021 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
%global has_internal_sub_libraries 1
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.3.3.0
+Version: 0.4.0.0
Release: 0
Summary: Efficient implementation of a dependent map with types as keys
License: MPL-2.0
++++++ typerep-map-0.3.3.0.tar.gz -> typerep-map-0.4.0.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/CHANGELOG.md
new/typerep-map-0.4.0.0/CHANGELOG.md
--- old/typerep-map-0.3.3.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
+++ new/typerep-map-0.4.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
@@ -3,6 +3,23 @@
`typerep-map` uses [PVP Versioning][1].
The changelog is available [on GitHub][2].
+## 0.4.0.0 ??? Aug 3, 2021
+
+* [#109](https://github.com/kowainik/typerep-map/issues/109):
+ Support GHC-9.0.
+* [#30](https://github.com/kowainik/typerep-map/issues/30):
+ Remove `containers` from dependencies.
+* [#94](https://github.com/kowainik/typerep-map/issues/94),
+ [#99](https://github.com/kowainik/typerep-map/issues/99),
+ [#100](https://github.com/kowainik/typerep-map/issues/100):
+ Improve performance of `insert` and `delete`.
+* [#95](https://github.com/kowainik/typerep-map/issues/95):
+ Add `alter`.
+* [#96](https://github.com/kowainik/typerep-map/issues/96):
+ Add `intersection` and `intersectionWith`.
+* [#105](https://github.com/kowainik/typerep-map/issues/105):
+ Add `keysWith` and `toListWith`.
+
## 0.3.3.0 ??? Apr 18, 2020
* [#83](https://github.com/kowainik/typerep-map/issues/83):
@@ -53,4 +70,4 @@
* Initially created.
[1]: https://pvp.haskell.org
-[2]: https://github.com/kowainik/typerep-map/blob/master/CHANGELOG.md
+[2]: https://github.com/kowainik/typerep-map/releases
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/README.md
new/typerep-map-0.4.0.0/README.md
--- old/typerep-map-0.3.3.0/README.md 2001-09-09 03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/README.md 2001-09-09 03:46:40.000000000 +0200
@@ -3,11 +3,7 @@
[](https://github.com/kowainik/typerep-map/actions)
-[](https://travis-ci.org/kowainik/typerep-map)
-[](https://ci.appveyor.com/project/kowainik/typerep-map)
[](https://hackage.haskell.org/package/typerep-map)
-[](http://stackage.org/lts/package/typerep-map)
-[](http://stackage.org/nightly/package/typerep-map)
[](LICENSE)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/benchmark/CMap.hs
new/typerep-map-0.4.0.0/benchmark/CMap.hs
--- old/typerep-map-0.3.3.0/benchmark/CMap.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/typerep-map-0.4.0.0/benchmark/CMap.hs 2001-09-09 03:46:40.000000000
+0200
@@ -17,7 +17,7 @@
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
-import GHC.TypeLits (type (+), KnownNat, Nat)
+import GHC.TypeLits (KnownNat, Nat, type (+))
import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, lookup)
@@ -30,16 +30,16 @@
env (mkMap 10000) $ \ ~bigMap ->
bench name $ nf tenLookups bigMap
, benchInsertSmall = Just $ \name ->
- bench name $ whnf (inserts empty 10) (Proxy @ 99999)
+ bench name $ whnf (inserts empty 10) (Proxy @99999)
, benchInsertBig = Just $ \name ->
env (mkMap 10000) $ \ ~bigMap ->
- bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
+ bench name $ whnf (inserts bigMap 1) (Proxy @99999)
, benchUpdateSmall = Just $ \name ->
env (mkMap 10) $ \ ~smallMap ->
- bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
+ bench name $ whnf (inserts smallMap 10) (Proxy @0)
, benchUpdateBig = Just $ \name ->
env (mkMap 10000) $ \ ~bigMap ->
- bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
+ bench name $ whnf (inserts bigMap 10) (Proxy @0)
}
tenLookups
@@ -49,7 +49,7 @@
)
tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
where
- lp :: forall (a::Nat). Typeable a => Proxy a
+ lp :: forall (a :: Nat) . Typeable a => Proxy a
lp = fromJust $ lookup tmap
inserts
@@ -61,8 +61,8 @@
inserts !c 0 _ = c
inserts !c n x = inserts
(insert x c)
- (n-1)
- (Proxy :: Proxy (a+1))
+ (n - 1)
+ (Proxy :: Proxy (a + 1))
mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
mkMap n = pure $ buildBigMap n (Proxy :: Proxy 0) empty
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/benchmark/CacheMap.hs
new/typerep-map-0.4.0.0/benchmark/CacheMap.hs
--- old/typerep-map-0.3.3.0/benchmark/CacheMap.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/benchmark/CacheMap.hs 2001-09-09
03:46:40.000000000 +0200
@@ -18,7 +18,7 @@
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Exts (fromList)
-import GHC.TypeLits (type (+), KnownNat, Nat)
+import GHC.TypeLits (KnownNat, Nat, type (+))
import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), empty,
insert, lookup)
@@ -31,16 +31,16 @@
env (mkMap 10000) $ \ ~bigMap ->
bench name $ nf tenLookups bigMap
, benchInsertSmall = Just $ \name ->
- bench name $ whnf (inserts empty 10) (Proxy @ 99999)
+ bench name $ whnf (inserts empty 10) (Proxy @99999)
, benchInsertBig = Just $ \name ->
env (mkMap 10000) $ \ ~bigMap ->
- bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
+ bench name $ whnf (inserts bigMap 1) (Proxy @99999)
, benchUpdateSmall = Just $ \name ->
env (mkMap 10) $ \ ~smallMap ->
- bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
+ bench name $ whnf (inserts smallMap 10) (Proxy @0)
, benchUpdateBig = Just $ \name ->
env (mkMap 10000) $ \ ~bigMap ->
- bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
+ bench name $ whnf (inserts bigMap 10) (Proxy @0)
}
tenLookups
@@ -62,7 +62,7 @@
inserts !c 0 _ = c
inserts !c n x = inserts
(insert x c)
- (n-1)
+ (n - 1)
(Proxy :: Proxy (a + 1))
mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/benchmark/DMap.hs
new/typerep-map-0.4.0.0/benchmark/DMap.hs
--- old/typerep-map-0.3.3.0/benchmark/DMap.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/typerep-map-0.4.0.0/benchmark/DMap.hs 2001-09-09 03:46:40.000000000
+0200
@@ -18,7 +18,7 @@
import Data.Kind (Type)
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (..))
-import GHC.TypeLits (type (+), KnownNat, Nat)
+import GHC.TypeLits (KnownNat, Nat, type (+))
import Type.Reflection (TypeRep, Typeable, typeRep)
import Type.Reflection.Unsafe (typeRepFingerprint)
@@ -36,10 +36,10 @@
env mkBigMap $ \ ~(DMapNF bigMap) ->
bench name $ nf tenLookups bigMap
, benchInsertSmall = Just $ \name ->
- bench name $ whnf (inserts empty 10) (Proxy @ 99999)
+ bench name $ whnf (inserts empty 10) (Proxy @99999)
, benchInsertBig = Just $ \name ->
env mkBigMap $ \ ~(DMapNF bigMap) ->
- bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
+ bench name $ whnf (inserts bigMap 1) (Proxy @99999)
, benchUpdateSmall = Nothing -- Not implemented
, benchUpdateBig = Nothing -- Not implemented
}
@@ -62,9 +62,9 @@
-> TypeRepMap (Proxy :: Nat -> Type)
inserts !c 0 _ = c
inserts !c n x = inserts
- (insert (typeRep @ a) x c)
- (n-1)
- (Proxy :: Proxy (a+1))
+ (insert (typeRep @a) x c)
+ (n - 1)
+ (Proxy :: Proxy (a + 1))
-- TypeRepMap of 10000 elements
mkBigMap :: IO (DMapNF (Proxy :: Nat -> Type))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/src/Data/TMap.hs
new/typerep-map-0.4.0.0/src/Data/TMap.hs
--- old/typerep-map-0.3.3.0/src/Data/TMap.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/typerep-map-0.4.0.0/src/Data/TMap.hs 2001-09-09 03:46:40.000000000
+0200
@@ -2,9 +2,12 @@
{-# LANGUAGE Rank2Types #-}
{- |
-Copyright: (c) 2017-2020 Kowainik
-SPDX-License-Identifier: MPL-2.0
-Maintainer: Kowainik <[email protected]>
+Module : Data.TMap
+Copyright : (c) 2017-2021 Kowainik
+SPDX-License-Identifier : MPL-2.0
+Maintainer : Kowainik <[email protected]>
+Stability : Stable
+Portability : Portable
'TMap' is a heterogeneous data structure similar in its essence to
'Data.Map.Map' with types as keys, where each value has the type of its key.
@@ -21,7 +24,6 @@
The runtime representation of 'TMap' is an array, not a tree. This makes
'lookup' significantly more efficient.
-
-}
module Data.TMap
@@ -37,14 +39,19 @@
, delete
, unionWith
, union
+ , intersectionWith
+ , intersection
, map
, adjust
+ , alter
-- * Query
, lookup
, member
, size
, keys
+ , keysWith
+ , toListWith
) where
import Prelude hiding (lookup, map)
@@ -52,7 +59,7 @@
import Data.Functor.Identity (Identity (..))
import Data.Typeable (Typeable)
import GHC.Exts (coerce)
-import Type.Reflection (SomeTypeRep)
+import Type.Reflection (SomeTypeRep, TypeRep)
import qualified Data.TypeRepMap as F
@@ -87,6 +94,7 @@
{- |
Insert a value into a 'TMap'.
+TMap optimizes for fast reads rather than inserts, as a trade-off inserts are
@O(n)@.
prop> size (insert v tm) >= size tm
prop> member @a (insert (x :: a) tm) == True
@@ -98,6 +106,9 @@
{- | Delete a value from a 'TMap'.
+TMap optimizes for fast reads rather than modifications, as a trade-off
deletes are @O(n)@,
+with an @O(log(n))@ optimization for when the element is already missing.
+
prop> size (delete @a tm) <= size tm
prop> member @a (delete @a tm) == False
@@ -114,7 +125,7 @@
{-# INLINE delete #-}
-- | The union of two 'TMap's using a combining function.
-unionWith :: (forall x. Typeable x => x -> x -> x) -> TMap -> TMap -> TMap
+unionWith :: (forall x . Typeable x => x -> x -> x) -> TMap -> TMap -> TMap
unionWith f = F.unionWith fId
where
fId :: forall y . Typeable y => Identity y -> Identity y -> Identity y
@@ -127,6 +138,24 @@
union = F.union
{-# INLINE union #-}
+-- | The intersection of two 'TMap's using a combining function.
+--
+-- @O(n + m)@
+intersectionWith :: (forall x . Typeable x => x -> x -> x) -> TMap -> TMap ->
TMap
+intersectionWith f = F.intersectionWith fId
+ where
+ fId :: forall y . Typeable y => Identity y -> Identity y -> Identity y
+ fId y1 y2 = f (coerce y1) (coerce y2)
+{-# INLINE intersectionWith #-}
+
+-- | The intersection of two 'TMap's.
+-- It keeps all values from the first map whose keys are present in the second.
+--
+-- @O(n + m)@
+intersection :: TMap -> TMap -> TMap
+intersection = F.intersection
+{-# INLINE intersection #-}
+
{- | Lookup a value of the given type in a 'TMap'.
>>> x = lookup $ insert (11 :: Int) empty
@@ -135,7 +164,7 @@
>>> x :: Maybe ()
Nothing
-}
-lookup :: forall a. Typeable a => TMap -> Maybe a
+lookup :: forall a . Typeable a => TMap -> Maybe a
lookup = coerce (F.lookup @a @Identity)
{-# INLINE lookup #-}
@@ -160,8 +189,18 @@
keys = F.keys
{-# INLINE keys #-}
+-- | Return the list of keys by wrapping them with a user-provided function.
+keysWith :: (forall a . TypeRep a -> r) -> TMap -> [r]
+keysWith = F.keysWith
+{-# INLINE keysWith #-}
+
+-- | Return the list of key-value pairs by wrapping them with a user-provided
function.
+toListWith :: (forall a . Typeable a => a -> r) -> TMap -> [r]
+toListWith f = F.toListWith (f . runIdentity)
+{-# INLINE toListWith #-}
+
-- | Map a function over the values.
-map :: (forall a. Typeable a => a -> a) -> TMap -> TMap
+map :: (forall a . Typeable a => a -> a) -> TMap -> TMap
map f = F.hoistWithKey (liftToIdentity f)
{-# INLINE map #-}
@@ -170,5 +209,14 @@
adjust f = F.adjust (liftToIdentity f)
{-# INLINE adjust #-}
-liftToIdentity :: forall a. (a -> a) -> Identity a -> Identity a
+-- | Updates a value at a specific key, whether or not it exists.
+-- This can be used to insert, delete, or update a value of a given type in
the map.
+alter :: Typeable a => (Maybe a -> Maybe a) -> TMap -> TMap
+alter f = F.alter (liftF f)
+ where
+ liftF :: forall a . (Maybe a -> Maybe a) -> Maybe (Identity a) -> Maybe
(Identity a)
+ liftF = coerce
+{-# INLINE alter #-}
+
+liftToIdentity :: forall a . (a -> a) -> Identity a -> Identity a
liftToIdentity = coerce
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/src/Data/TypeRepMap/Internal.hs
new/typerep-map-0.4.0.0/src/Data/TypeRepMap/Internal.hs
--- old/typerep-map-0.3.3.0/src/Data/TypeRepMap/Internal.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/src/Data/TypeRepMap/Internal.hs 2001-09-09
03:46:40.000000000 +0200
@@ -20,9 +20,12 @@
-- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions
-dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}
{- |
-Copyright: (c) 2017-2020 Kowainik
-SPDX-License-Identifier: MPL-2.0
-Maintainer: Kowainik <[email protected]>
+Module : Data.TypeRepMap.Internal
+Copyright : (c) 2017-2021 Kowainik
+SPDX-License-Identifier : MPL-2.0
+Maintainer : Kowainik <[email protected]>
+Stability : Stable
+Portability : Portable
Internal API for 'TypeRepMap' and operations on it. The functions here do
not have any stability guarantees and can change between minor versions.
@@ -42,13 +45,15 @@
import Control.Monad.Zip (mzip)
import Data.Function (on)
import Data.Kind (Type)
-import Data.Type.Equality ((:~:) (..), TestEquality (..))
import Data.List (intercalate, nubBy)
import Data.Maybe (fromMaybe)
-import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray',
readArray, sizeofArray,
- thawArray, unsafeFreezeArray, writeArray)
-import Data.Primitive.PrimArray (PrimArray, indexPrimArray, sizeofPrimArray)
-import Data.Semigroup (Semigroup (..), All(..))
+import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray',
sizeofArray, thawArray,
+ unsafeFreezeArray, writeArray)
+import Data.Primitive.PrimArray (MutablePrimArray, PrimArray, indexPrimArray,
newPrimArray,
+ primArrayFromListN, primArrayToList,
sizeofPrimArray,
+ unsafeFreezePrimArray, writePrimArray)
+import Data.Semigroup (All (..), Semigroup (..))
+import Data.Type.Equality (TestEquality (..), (:~:) (..))
import GHC.Base (Any, Int (..), Int#, (*#), (+#), (<#))
import GHC.Exts (IsList (..), inline, sortWith)
import GHC.Fingerprint (Fingerprint (..))
@@ -64,7 +69,6 @@
import Type.Reflection.Unsafe (typeRepFingerprint)
import Unsafe.Coerce (unsafeCoerce)
-import qualified Data.Map.Strict as Map
import qualified GHC.Exts as GHC (fromList, toList)
{- |
@@ -127,7 +131,7 @@
go i
| i == size tm1 = True
| otherwise = case testEquality tr1i tr2i of
- Nothing -> False
+ Nothing -> False
Just Refl -> repEq tr1i (fromAny tv1i) (fromAny tv2i) && go
(i + 1)
where
tr1i :: TypeRep x
@@ -170,33 +174,49 @@
-}
one :: forall a f . Typeable a => f a -> TypeRepMap f
-one x = insert x empty
+one x = TypeRepMap (primArrayFromListN 1 [fa])
+ (primArrayFromListN 1 [fb])
+ (pure @Array v)
+ (pure @Array k)
+ where
+ (Fingerprint fa fb, v, k) = (calcFp @a, toAny x, unsafeCoerce $ typeRep @a)
{-# INLINE one #-}
{- |
Insert a value into a 'TypeRepMap'.
+TypeRepMap optimizes for fast reads rather than inserts, as a trade-off
inserts are @O(n)@.
prop> size (insert v tm) >= size tm
prop> member @a (insert (x :: f a) tm) == True
-}
insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
-insert x = fromTriples . addX . toTriples
+insert x m
+ | size m == 0 = one x
+ | otherwise = case cachedBinarySearch (typeFp @a) (fingerprintAs m)
(fingerprintBs m) of
+ Nothing -> union m $ one x
+ Just i -> m {trAnys = changeAnyArr i (trAnys m)}
where
- tripleX :: (Fingerprint, Any, Any)
- tripleX@(fpX, _, _) = (calcFp @a, toAny x, unsafeCoerce $ typeRep @a)
-
- addX :: [(Fingerprint, Any, Any)] -> [(Fingerprint, Any, Any)]
- addX l = tripleX : deleteByFst fpX l
+ changeAnyArr :: Int -> Array Any -> Array Any
+ changeAnyArr i trAs = runST $ do
+ let n = sizeofArray trAs
+ mutArr <- thawArray trAs 0 n
+ writeArray mutArr i $ toAny x
+ unsafeFreezeArray mutArr
{-# INLINE insert #-}
-- Extract the kind of a type. We use it to work around lack of syntax for
-- inferred type variables (which are not subject to type applications).
type KindOf (a :: k) = k
+type ArgKindOf (f :: k -> l) = k
+
{- | Delete a value from a 'TypeRepMap'.
+TypeRepMap optimizes for fast reads rather than modifications, as a trade-off
deletes are
+@O(n)@, with an @O(log(n))@ optimization for when the element is already
missing.
+
prop> size (delete @a tm) <= size tm
prop> member @a (delete @a tm) == False
@@ -209,30 +229,60 @@
True
-}
delete :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f ->
TypeRepMap f
-delete = fromTriples . deleteByFst (typeFp @a) . toTriples
+delete m
+ -- Lookups are fast, so check if we even have the element first.
+ | not (member @a m) = m
+ -- We know we have the element, If the map has exactly one element, we can
return the empty map
+ | size m == 1 = empty
+ -- Otherwise, filter out the element in linear time.
+ | otherwise = fromSortedTriples . deleteFirst ((== typeFp @a) . fst3) .
toSortedTriples $ m
{-# INLINE delete #-}
+deleteFirst :: (a -> Bool) -> [a] -> [a]
+deleteFirst _ [] = []
+deleteFirst p (x : xs) = if p x then xs else x : deleteFirst p xs
+
{- |
-Update a value at a specific key with the result of the provided function. When
-the key is not a member of the map, the original map is returned.
+Update a value at a specific key with the result of the provided function.
+When the key is not a member of the map, the original map is returned.
>>> trmap = fromList @(TypeRepMap Identity) [WrapTypeable $ Identity "a"]
>>> lookup @String $ adjust (fmap (++ "ww")) trmap
Just (Identity "aww")
-}
adjust :: forall a f . Typeable a => (f a -> f a) -> TypeRepMap f ->
TypeRepMap f
-adjust fun tr = case cachedBinarySearch (typeFp @a) (fingerprintAs tr)
(fingerprintBs tr) of
- Nothing -> tr
- Just i -> tr {trAnys = changeAnyArr i (trAnys tr)}
+adjust fun = alter (fmap fun)
+{-# INLINE adjust #-}
+
+{- |
+Updates a value at a specific key, whether or not it exists.
+This can be used to insert, delete, or update a value of a given type in the
map.
+
+>>> func = (\case Nothing -> Just (Identity "new"); Just (Identity s) -> Just
(Identity (reverse s)))
+>>> lookup @String $ alter func empty
+Just (Identity "new")
+>>> trmap = fromList @(TypeRepMap Identity) [WrapTypeable $ Identity "helllo"]
+>>> lookup @String $ alter func trmap
+>>> Just (Identity "olleh")
+-}
+alter :: forall a f . Typeable a => (Maybe (f a) -> Maybe (f a)) -> TypeRepMap
f -> TypeRepMap f
+alter fun tr = case cachedBinarySearch (typeFp @a) (fingerprintAs tr)
(fingerprintBs tr) of
+ Nothing ->
+ case (fun Nothing) of
+ Nothing -> tr
+ Just v -> insert v tr
+ Just i ->
+ case fun (Just . fromAny $ indexArray (trAnys tr) i) of
+ Nothing -> delete @a tr
+ Just v -> tr{trAnys = replaceAnyAt i (toAny v) (trAnys tr)}
where
- changeAnyArr :: Int -> Array Any -> Array Any
- changeAnyArr i trAs = runST $ do
+ replaceAnyAt :: Int -> Any -> Array Any -> Array Any
+ replaceAnyAt i v trAs = runST $ do
let n = sizeofArray trAs
mutArr <- thawArray trAs 0 n
- a <- toAny . fun . fromAny <$> readArray mutArr i
- writeArray mutArr i a
+ writeArray mutArr i v
unsafeFreezeArray mutArr
-{-# INLINE adjust #-}
+{-# INLINE alter #-}
{- | Map over the elements of a 'TypeRepMap'.
@@ -266,33 +316,89 @@
withTr t = withTypeable t f
{-# INLINE hoistWithKey #-}
--- | The union of two 'TypeRepMap's using a combining function.
+-- | The union of two 'TypeRepMap's using a combining function for conflicting
entries. @O(n + m)@
unionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) ->
TypeRepMap f -> TypeRepMap f -> TypeRepMap f
-unionWith f m1 m2 = fromTriples
- $ toTripleList
- $ Map.unionWith combine
- (fromTripleList $ toTriples m1)
- (fromTripleList $ toTriples m2)
+unionWith f ma mb = do
+ fromSortedTriples $ mergeMaps (toSortedTriples ma) (toSortedTriples mb)
where
f' :: forall x. TypeRep x -> f x -> f x -> f x
f' tr = withTypeable tr f
- combine :: (Any, Any) -> (Any, Any) -> (Any, Any)
- combine (av, ak) (bv, _) = (toAny $ f' (fromAny ak) (fromAny av) (fromAny
bv), ak)
+ combine :: (Fingerprint, Any, Any) -> (Fingerprint, Any, Any) ->
(Fingerprint, Any, Any)
+ combine (fp, av, ak) (_, bv, _) = (fp, toAny $ f' (fromAny ak) (fromAny
av) (fromAny bv), ak)
- fromTripleList :: Ord a => [(a, b, c)] -> Map.Map a (b, c)
- fromTripleList = Map.fromList . map (\(a, b, c) -> (a, (b, c)))
-
- toTripleList :: Map.Map a (b, c) -> [(a, b, c)]
- toTripleList = map (\(a, (b, c)) -> (a, b, c)) . Map.toList
+ -- Merges two typrepmaps into a sorted, dedup'd list of triples.
+ -- Using 'toSortedTriples' allows us to assume the triples are sorted by
fingerprint,
+ -- Given O(n) performance from 'toSortedTriples', and given that we can
merge-sort in
+ -- O(n + m) time, then can '.fromSortedTriples' back into
cachedBinarySearch order in O(n + m)
+ -- that gives a total of O(n + m).
+ mergeMaps :: [(Fingerprint, Any, Any)] -> [(Fingerprint, Any, Any)] ->
[(Fingerprint, Any, Any)]
+ -- We've addressed all elements from both maps
+ mergeMaps as [] = as
+ mergeMaps [] bs = bs
+ -- Merge
+ mergeMaps (a@(af, _, _) : as) (b@(bf, _, _) : bs) =
+ case compare af bf of
+ -- Fingerprints are equal, union the elements using our function
+ -- If the incoming maps were de-duped, there shouldn't be any
other equivalent
+ -- fingerprints
+ EQ -> combine a b : mergeMaps as bs
+ -- First fingerprint must not be in the second map or we would
have seen it by now
+ -- Add it to the result as-is
+ LT -> a : mergeMaps as (b : bs)
+ -- Second fingerprint must not be in the first map or we would
have seen it by now
+ -- Add it to the result as-is
+ GT -> b : mergeMaps (a:as) bs
{-# INLINE unionWith #-}
--- | The (left-biased) union of two 'TypeRepMap's. It prefers the first map
when
+-- | The (left-biased) union of two 'TypeRepMap's in @O(n + m)@. It prefers
the first map when
-- duplicate keys are encountered, i.e. @'union' == 'unionWith' const@.
union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
union = unionWith const
{-# INLINE union #-}
+-- | The 'intersection' of two 'TypeRepMap's using a combining function
+--
+-- @O(n + m)@
+intersectionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) ->
TypeRepMap f -> TypeRepMap f -> TypeRepMap f
+intersectionWith f ma mb =
+ fromSortedTriples $ mergeMaps (toSortedTriples ma) (toSortedTriples mb)
+ where
+ f' :: forall x. TypeRep x -> f x -> f x -> f x
+ f' tr = withTypeable tr f
+
+ combine :: (Fingerprint, Any, Any) -> (Fingerprint, Any, Any) ->
(Fingerprint, Any, Any)
+ combine (fp, av, ak) (_, bv, _) = (fp, toAny $ f' (fromAny ak) (fromAny
av) (fromAny bv), ak)
+
+ -- Merges two typrepmaps into a sorted, dedup'd list of triples.
+ mergeMaps :: [(Fingerprint, Any, Any)] -> [(Fingerprint, Any, Any)] ->
[(Fingerprint, Any, Any)]
+ -- If either list is empty, the intersection must be finished.
+ mergeMaps _ [] = []
+ mergeMaps [] _ = []
+ -- Merge the two maps considering one element at a time.
+ mergeMaps (a@(af, _, _) : as) (b@(bf, _, _) : bs) =
+ case compare af bf of
+ -- Fingerprints are equal, union the elements using our function
+ -- If the incoming maps were de-duped, there shouldn't be any
other equivalent
+ -- fingerprints
+ EQ -> combine a b : mergeMaps as bs
+ -- First fingerprint must not be in the second map or we would
have seen it by now
+ -- Skip it an move on
+ LT -> mergeMaps as (b : bs)
+ -- Second fingerprint must not be in the first map or we would
have seen it by now
+ -- Skip it an move on
+ GT -> mergeMaps (a:as) bs
+{-# INLINE intersectionWith #-}
+
+-- | The intersection of two 'TypeRepMap's.
+-- It keeps all values from the first map whose keys are present in the second.
+--
+-- @O(n + m)@
+intersection :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
+intersection = intersectionWith const
+{-# INLINE intersection #-}
+
+
{- | Check if a value of the given type is present in a 'TypeRepMap'.
>>> member @Char $ one (Identity 'a')
@@ -328,9 +434,22 @@
-- | Return the list of 'SomeTypeRep' from the keys.
keys :: TypeRepMap f -> [SomeTypeRep]
-keys TypeRepMap{..} = SomeTypeRep . anyToTypeRep <$> toList trKeys
+keys = keysWith SomeTypeRep
{-# INLINE keys #-}
+-- | Return the list of keys by wrapping them with a user-provided function.
+keysWith :: (forall (a :: ArgKindOf f). TypeRep a -> r) -> TypeRepMap f -> [r]
+keysWith f TypeRepMap{..} = f . anyToTypeRep <$> toList trKeys
+{-# INLINE keysWith #-}
+
+-- | Return the list of key-value pairs by wrapping them with a user-provided
function.
+toListWith :: forall f r . (forall (a :: ArgKindOf f) . Typeable a => f a ->
r) -> TypeRepMap f -> [r]
+toListWith f = map toF . toTriples
+ where
+ withTypeRep :: TypeRep a -> f a -> r
+ withTypeRep tr an = withTypeable tr $ f an
+ toF (_, an, k) = withTypeRep (unsafeCoerce k) (fromAny an)
+
-- | Binary searched based on this article
-- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html
-- with modification for our two-vector search case.
@@ -374,8 +493,20 @@
toTriples :: TypeRepMap f -> [(Fingerprint, Any, Any)]
toTriples tm = zip3 (toFingerprints tm) (GHC.toList $ trAnys tm) (GHC.toList $
trKeys tm)
-deleteByFst :: Eq a => a -> [(a, b, c)] -> [(a, b, c)]
-deleteByFst x = filter ((/= x) . fst3)
+-- | Efficiently get sorted triples from a map in O(n) time
+--
+-- We assume the incoming TypeRepMap is already sorted into
'cachedBinarySearch' order using fromSortedList.
+-- Then we can construct the index mapping from the "cached" ordering into
monotonically
+-- increasing order using 'generateOrderMapping' with the length of the TRM.
This takes @O(n).
+-- We then pull those indexes from the source TRM to get the sorted triples in
a total of @O(n).
+toSortedTriples :: TypeRepMap f -> [(Fingerprint, Any, Any)]
+toSortedTriples tm = trip <$> ordering
+ where
+ trip i = ( Fingerprint (indexPrimArray (fingerprintAs tm) i)
(indexPrimArray (fingerprintBs tm) i)
+ , indexArray (trAnys tm) i
+ , indexArray (trKeys tm) i)
+ ordering :: [ Int ]
+ ordering = generateOrderMapping (size tm)
nubByFst :: (Eq a) => [(a, b, c)] -> [(a, b, c)]
nubByFst = nubBy ((==) `on` fst3)
@@ -395,9 +526,6 @@
instance Show (WrapTypeable f) where
show (WrapTypeable (_ :: f a)) = show $ calcFp @a
-wrapTypeable :: TypeRep a -> f a -> WrapTypeable f
-wrapTypeable tr = withTypeable tr WrapTypeable
-
{- |
prop> fromList . toList == 'id'
@@ -425,19 +553,19 @@
k (WrapTypeable (_ :: f a)) = unsafeCoerce $ typeRep @a
toList :: TypeRepMap f -> [WrapTypeable f]
- toList = map toWrapTypeable . toTriples
- where
- toWrapTypeable :: (Fingerprint, Any, Any) -> WrapTypeable f
- toWrapTypeable (_, an, k) = wrapTypeable (unsafeCoerce k) (fromAny an)
+ toList = toListWith WrapTypeable
calcFp :: forall a . Typeable a => Fingerprint
calcFp = typeRepFingerprint $ typeRep @a
fromTriples :: [(Fingerprint, Any, Any)] -> TypeRepMap f
-fromTriples kvs = TypeRepMap (GHC.fromList fpAs) (GHC.fromList fpBs)
(GHC.fromList ans) (GHC.fromList ks)
+fromTriples = fromSortedTriples . sortWith fst3 . nubByFst
+
+fromSortedTriples :: [(Fingerprint, Any, Any)] -> TypeRepMap f
+fromSortedTriples kvs = TypeRepMap (GHC.fromList fpAs) (GHC.fromList fpBs)
(GHC.fromList ans) (GHC.fromList ks)
where
(fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps
- (fps, ans, ks) = unzip3 $ fromSortedList $ sortWith fst3 $ nubByFst kvs
+ (fps, ans, ks) = unzip3 $ fromSortedList kvs
----------------------------------------------------------------------------
-- Tree-like conversion
@@ -464,11 +592,35 @@
writeArray result i (indexArray origin newFirst)
loop (2 * i + 2) (newFirst + 1)
+-- Returns a list of indexes which represents the "sorted" order of an array
generated by
+-- fromSortedList of the provided length.
+-- I.e. fmap (fromSortedList [1, 2, 3, 4, 5, 6] !!) (generateOrderMapping 6)
== [1, 2, 3, 4, 5, 6]
+--
+-- >>> generateOrderMapping 6
+-- [3,1,4,0,5,2]
+--
+-- >>> generateOrderMapping 8
+-- [7,3,1,4,0,5,2,6]
+generateOrderMapping :: Int -> [Int]
+generateOrderMapping len = runST $ do
+ orderMappingArr <- newPrimArray len
+ _ <- loop orderMappingArr 0 0
+ primArrayToList <$> unsafeFreezePrimArray orderMappingArr
+ where
+ loop :: MutablePrimArray s Int -> Int -> Int -> ST s Int
+ loop result i first =
+ if i >= len
+ then pure first
+ else do
+ newFirst <- loop result (2 * i + 1) first
+ writePrimArray result newFirst i
+ loop result (2 * i + 2) (newFirst + 1)
+
----------------------------------------------------------------------------
-- Helper functions.
----------------------------------------------------------------------------
--- | Check that invariant of the structure is hold.
+-- | Check that invariant of the structure holds.
-- The structure maintains the following invariant.
-- For each element @A@ at index @i@:
--
@@ -481,8 +633,8 @@
invariantCheck :: TypeRepMap f -> Bool
invariantCheck TypeRepMap{..} = getAll (check 0)
where
- lastMay [] = Nothing
- lastMay [x] = Just x
+ lastMay [] = Nothing
+ lastMay [x] = Just x
lastMay (_:xs) = lastMay xs
sz = sizeofPrimArray fingerprintAs
check i | i >= sz = All True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/src/Data/TypeRepMap.hs
new/typerep-map-0.4.0.0/src/Data/TypeRepMap.hs
--- old/typerep-map-0.3.3.0/src/Data/TypeRepMap.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/src/Data/TypeRepMap.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,11 +1,14 @@
{-# LANGUAGE NoImplicitPrelude #-}
{- |
-Copyright: (c) 2017-2020 Kowainik
-SPDX-License-Identifier: MPL-2.0
-Maintainer: Kowainik <[email protected]>
+Module : Data.TypeRepMap
+Copyright : (c) 2017-2021 Kowainik
+SPDX-License-Identifier : MPL-2.0
+Maintainer : Kowainik <[email protected]>
+Stability : Stable
+Portability : Portable
- A version of 'Data.TMap.TMap' parametrized by an interpretation @f@. This
+A version of 'Data.TMap.TMap' parametrized by an interpretation @f@. This
sort of parametrization may be familiar to users of @vinyl@ records.
@'TypeRepMap' f@ is a more efficient replacement for @DMap
@@ -44,7 +47,8 @@
"border-color" -> F (rgb 148 0 211)
"border-width" -> F 0.5
@
---}
+-}
+
module Data.TypeRepMap
( -- * Map type
TypeRepMap()
@@ -57,17 +61,22 @@
, insert
, delete
, adjust
+ , alter
, hoist
, hoistA
, hoistWithKey
, unionWith
, union
+ , intersectionWith
+ , intersection
-- * Query
, lookup
, member
, size
, keys
+ , keysWith
+ , toListWith
-- * 'IsList'
, WrapTypeable (..)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/test/Test/TypeRep/TypeRepMap.hs
new/typerep-map-0.4.0.0/test/Test/TypeRep/TypeRepMap.hs
--- old/typerep-map-0.3.3.0/test/Test/TypeRep/TypeRepMap.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/test/Test/TypeRep/TypeRepMap.hs 2001-09-09
03:46:40.000000000 +0200
@@ -5,14 +5,18 @@
import Prelude hiding (lookup)
import Data.Functor.Identity (Identity (..))
-import GHC.Exts (fromList)
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Data.List (sortBy)
+import Data.Ord (comparing)
+import Data.Typeable (cast)
+import GHC.Exts (fromList, toList)
+import Type.Reflection (SomeTypeRep(..), typeRep)
+import Test.Hspec (Spec, describe, it, shouldBe, shouldMatchList,
shouldSatisfy, expectationFailure)
-import Data.TMap (TMap, empty, insert, lookup, one, size, union)
+import Data.TMap (TMap, empty, insert, lookup, one, size, union, keys)
import Data.TypeRepMap.Internal (WrapTypeable (..))
--- Simple test for 'lookup', 'insert' and 'size' functions.
+-- Simple test for 'lookup', 'insert', 'size', 'keys', 'toList' functions.
typeRepMapSpec :: Spec
typeRepMapSpec = describe "TypeRepMap" $ do
describe "Lookup Test" $ do
@@ -39,6 +43,60 @@
lookup m `shouldBe` Just True
lookup @Int m `shouldBe` Nothing
+ describe "Keys Test" $ do
+ it "returns nothing on empty map" $
+ keys empty `shouldBe` []
+ it "returns the correct TypeRep" $
+ keys (one 'a') `shouldBe` [SomeTypeRep $ typeRep @Char]
+ it "returns the correct TypeReps for 10 different types" $
+ keys mapOf10 `shouldMatchList`
+ [ SomeTypeRep $ typeRep @Bool
+ , SomeTypeRep $ typeRep @[Bool]
+ , SomeTypeRep $ typeRep @(Maybe Bool)
+ , SomeTypeRep $ typeRep @(Maybe ())
+ , SomeTypeRep $ typeRep @[()]
+ , SomeTypeRep $ typeRep @()
+ , SomeTypeRep $ typeRep @String
+ , SomeTypeRep $ typeRep @(Maybe Char)
+ , SomeTypeRep $ typeRep @Char
+ , SomeTypeRep $ typeRep @Int
+ ]
+
+ describe "ToList Test" $ do
+ it "returns nothing on empty map" $
+ toList empty `shouldSatisfy` null
+ it "returns correct result when 1 element is inserted" $
+ case toList (one 'a') of
+ [WrapTypeable (Identity x)] -> cast x `shouldBe` Just 'a'
+ _ -> expectationFailure "did not return exactly 1 result"
+ it "returns correct result when 10 elements are inserted" $ do
+ let
+ getTypeRep (WrapTypeable (Identity (_ :: a))) = SomeTypeRep $
typeRep @a
+ got = sortBy (comparing getTypeRep) (toList mapOf10)
+ expected = sortBy (comparing fst)
+ [ (SomeTypeRep $ typeRep @Bool,
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just True)
+ , (SomeTypeRep $ typeRep @[Bool],
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just [True,
False])
+ , (SomeTypeRep $ typeRep @(Maybe Bool),
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just
True))
+ , (SomeTypeRep $ typeRep @(Maybe ()),
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just ()))
+ , (SomeTypeRep $ typeRep @[()],
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just [()])
+ , (SomeTypeRep $ typeRep @(),
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just ())
+ , (SomeTypeRep $ typeRep @String,
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just ("aaa" ::
String))
+ , (SomeTypeRep $ typeRep @(Maybe Char),
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just
'a'))
+ , (SomeTypeRep $ typeRep @Char,
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just 'a')
+ , (SomeTypeRep $ typeRep @Int,
+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (11 ::
Int))
+ ]
+ length got `shouldBe` 10
+ sequence_ $ zipWith snd expected got
mapOf10 :: TMap
mapOf10 = insert True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/typerep-map-0.3.3.0/test/Test/TypeRep/TypeRepMapProperty.hs
new/typerep-map-0.4.0.0/test/Test/TypeRep/TypeRepMapProperty.hs
--- old/typerep-map-0.3.3.0/test/Test/TypeRep/TypeRepMapProperty.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/typerep-map-0.4.0.0/test/Test/TypeRep/TypeRepMapProperty.hs
2001-09-09 03:46:40.000000000 +0200
@@ -20,7 +20,8 @@
import Test.Hspec.Hedgehog (hedgehog)
import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete,
insert, invariantCheck,
- lookup, member)
+ lookup, member, union, generateOrderMapping,
fromSortedList,
+ adjust, alter, intersection)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
@@ -34,6 +35,13 @@
deleteMemberSpec
insertInvariantSpec
deleteInvariantSpec
+ alterInsertSpec
+ alterDeleteSpec
+ alterAdjustSpec
+ alterModifySpec
+ intersectionSpec
+ describe "Internal helpers" $ do
+ generateOrderMappingInvariantSpec
describe "Instance Laws" $ do
semigroupAssocSpec
monoidIdentitySpec
@@ -80,45 +88,66 @@
WrapTypeable (_ :: IntProxy n) <- forAll genTF
assert $ invariantCheck (delete @n m)
+alterInsertSpec :: Property
+alterInsertSpec = it "insert proxy m === alter (const (Just proxy)) m" $
hedgehog $ do
+ m <- forAll genMap
+ WrapTypeable (proxy :: IntProxy n) <- forAll genTF
+ insert proxy m === alter (const (Just proxy)) m
+
+alterDeleteSpec :: Property
+alterDeleteSpec = it "delete proxy m === alter (const Nothing) m" $ hedgehog $
do
+ WrapTypeable (proxy :: IntProxy n) <- forAll genTF
+ m <- insert proxy <$> forAll genMap
+ delete @n @IntProxy m === alter @n @IntProxy (const Nothing) m
+
+alterAdjustSpec :: Property
+alterAdjustSpec = it "adjust f m == alter (fmap f) m" $ hedgehog $ do
+ m <- forAll genMap
+ WrapTypeable (_ :: IntProxy n) <- forAll genTF
+ let f (IntProxy p n) = IntProxy p (n * 10)
+ adjust @n @IntProxy f m === alter @n @IntProxy (fmap f) m
+
+alterModifySpec :: Property
+alterModifySpec = it "lookup k (alter f) == f (lookup k m)" $ hedgehog $ do
+ m <- forAll genMap
+ WrapTypeable (_ :: IntProxy n) <- forAll genTF
+ randInt <- forAll (Gen.int Range.constantBounded)
+ -- Function with some interesting behaviour, which inserts, seletes and
modifies
+ let f Nothing = Just (IntProxy Proxy randInt)
+ f (Just (IntProxy p n))
+ | even n = Nothing
+ | otherwise = Just $ IntProxy p (n * 10)
+ lookup @n @IntProxy (alter @n f m) === f (lookup @n @IntProxy m)
+
+intersectionSpec :: Property
+intersectionSpec = it "m `intersection` (m `union` n) == m" $ hedgehog $ do
+ m <- forAll genMap
+ n <- forAll genMap
+ m `intersection` (m `union` n) === m
+
----------------------------------------------------------------------------
--- Semigroup and Monoid laws
+-- Internal helpers
----------------------------------------------------------------------------
+generateOrderMappingInvariantSpec :: Property
+generateOrderMappingInvariantSpec =
+ it "fmap (fromSortedList [1 .. n] !!) (generateOrderMapping n) == [1 ..
n]" $ hedgehog $ do
+ n <- forAll $ Gen.int (Range.linear 0 100)
+ fmap (fromSortedList [1 .. n] !!) (generateOrderMapping n) === [1 .. n]
-#if __GLASGOW_HASKELL__ < 806
-{- | This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's.
-It's not a good idea to write such 'Eq' instance for 'TypeRepMap' itself
because
-it doesn't compare values so it's not true equality. But this should be enough
-for tests.
--}
-newtype FpMap f = FpMap (TypeRepMap f)
- deriving newtype (Show, Semigroup, Monoid)
-
-instance Eq (FpMap f) where
- FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =
- as1 == as2 && bs1 == bs2
-#endif
+----------------------------------------------------------------------------
+-- Semigroup and Monoid laws
+----------------------------------------------------------------------------
semigroupAssocSpec :: Property
semigroupAssocSpec = it "x <> (y <> z) == (x <> y) <> z" $ hedgehog $ do
-#if __GLASGOW_HASKELL__ >= 806
x <- forAll genMap
y <- forAll genMap
z <- forAll genMap
-#else
- x <- FpMap <$> forAll genMap
- y <- FpMap <$> forAll genMap
- z <- FpMap <$> forAll genMap
-#endif
(x <> (y <> z)) === ((x <> y) <> z)
monoidIdentitySpec :: Property
monoidIdentitySpec = it "x <> mempty == mempty <> x == x" $ hedgehog $ do
-#if __GLASGOW_HASKELL__ >= 806
x <- forAll genMap
-#else
- x <- FpMap <$> forAll genMap
-#endif
-
x <> mempty === x
mempty <> x === x
@@ -139,3 +168,17 @@
case someNatVal randNat of
Just (SomeNat proxyNat) -> pure $ WrapTypeable $ IntProxy proxyNat
randInt
Nothing -> error "Invalid test generator"
+
+----------------------------------------------------------------------------
+-- Helpers
+----------------------------------------------------------------------------
+#if __GLASGOW_HASKELL__ < 806
+{- | We add an orphan Eq instance for old GHC versions just to make testing
easier.
+It's not a good idea to write such 'Eq' instance for 'TypeRepMap' itself
because
+it doesn't compare values so it's not true equality. But this should be enough
+for tests.
+-}
+instance Eq (TypeRepMap f) where
+ TypeRepMap as1 bs1 _ _ == TypeRepMap as2 bs2 _ _ =
+ as1 == as2 && bs1 == bs2
+#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/typerep-map-0.3.3.0/typerep-map.cabal
new/typerep-map-0.4.0.0/typerep-map.cabal
--- old/typerep-map-0.3.3.0/typerep-map.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/typerep-map-0.4.0.0/typerep-map.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,6 +1,6 @@
cabal-version: 2.4
name: typerep-map
-version: 0.3.3.0
+version: 0.4.0.0
synopsis: Efficient implementation of a dependent map with types as
keys
description:
A dependent map from type representations to values of these types.
@@ -23,7 +23,7 @@
license-file: LICENSE
author: Veronika Romashkina, Vladislav Zavialov, Dmitrii Kovanikov
maintainer: Kowainik <[email protected]>
-copyright: 2017-2020 Kowainik
+copyright: 2017-2021 Kowainik
category: Data, Data Structures, Types
build-type: Simple
extra-doc-files: README.md
@@ -31,15 +31,16 @@
tested-with: GHC == 8.2.2
, GHC == 8.4.4
, GHC == 8.6.5
- , GHC == 8.8.3
- , GHC == 8.10.1
+ , GHC == 8.8.4
+ , GHC == 8.10.5
+ , GHC == 9.0.1
source-repository head
type: git
location: https://github.com/kowainik/typerep-map.git
common common-options
- build-depends: base >= 4.10 && < 4.15
+ build-depends: base >= 4.10 && < 4.16
default-language: Haskell2010
default-extensions: BangPatterns
@@ -53,10 +54,8 @@
-Widentities
-Wincomplete-uni-patterns
-Wincomplete-record-updates
- if impl(ghc >= 8.0)
- ghc-options: -Wredundant-constraints
- if impl(ghc >= 8.2)
- ghc-options: -fhide-source-paths
+ -Wredundant-constraints
+ -fhide-source-paths
if impl(ghc >= 8.4)
ghc-options: -Wmissing-export-lists
-Wpartial-fields
@@ -73,8 +72,7 @@
Data.TypeRepMap
Data.TypeRepMap.Internal
- build-depends: containers >= 0.5.10.2 && < 0.7
- , ghc-prim >= 0.5.1.1 && < 0.7
+ build-depends: ghc-prim >= 0.5.1.1 && < 0.8
, primitive ^>= 0.7.0
, deepseq ^>= 1.4
@@ -103,7 +101,7 @@
build-depends: ghc-typelits-knownnat >= 0.4.2 && < 0.8
, hedgehog ^>= 1.0
- , hspec ^>= 2.7.1
+ , hspec >= 2.7.1 && < 2.9
, hspec-hedgehog ^>= 0.0.1
, typerep-map
, typerep-extra-impls
