f562d9a...main · typerep-map

git.iko.soy/typerep-map

4 files changed+94−13

since splitsnapshots

unifiedsplit

src/Data/TMap.hs+13−1 src/Data/TypeRepMap.hs+2 src/Data/TypeRepMap/Internal.hs+17−8 test/Test/TypeRep/TypeRepMap.hs+62−4

src/Data/TMap.hs+13−1

@@ -48,6 +48,8 @@ module Data.TMap

4848 , member

4949 , size

5050 , keys

51+ , keysWith

52+ , toListWith

5153 ) where

5254

5355import Prelude hiding (lookup, map)

@@ -55,7 +57,7 @@ import Prelude hiding (lookup, map)

5557import Data.Functor.Identity (Identity (..))

5658import Data.Typeable (Typeable)

5759import GHC.Exts (coerce)

58−import Type.Reflection (SomeTypeRep)

60+import Type.Reflection (SomeTypeRep, TypeRep)

5961

6062import qualified Data.TypeRepMap as F

6163

@@ -185,6 +187,16 @@ keys :: TMap -> [SomeTypeRep]

185187keys = F.keys

186188{-# INLINE keys #-}

187189

190+-- | Return the list of keys by wrapping them with a user-provided function.

191+keysWith :: (forall a. TypeRep a -> r) -> TMap -> [r]

192+keysWith = F.keysWith

193+{-# INLINE keysWith #-}

194+

195+-- | Return the list of key-value pairs by wrapping them with a user-provided function.

196+toListWith :: (forall a. Typeable a => a -> r) -> TMap -> [r]

197+toListWith = F.toListWith

198+{-# INLINE toListWith #-}

199+

188200-- | Map a function over the values.

189201map :: (forall a. Typeable a => a -> a) -> TMap -> TMap

190202map f = F.hoistWithKey (liftToIdentity f)

src/Data/TypeRepMap.hs+2

@@ -71,6 +71,8 @@ module Data.TypeRepMap

7171 , member

7272 , size

7373 , keys

74+ , keysWith

75+ , toListWith

7476

7577 -- * 'IsList'

7678 , WrapTypeable (..)

src/Data/TypeRepMap/Internal.hs+17−8

@@ -205,6 +205,8 @@ insert x m

205205-- inferred type variables (which are not subject to type applications).

206206type KindOf (a :: k) = k

207207

208+type ArgKindOf (f :: k -> l) = k

209+

208210{- | Delete a value from a 'TypeRepMap'.

209211

210212TypeRepMap optimizes for fast reads rather than modifications, as a trade-off deletes are

@@ -427,9 +429,22 @@ size = sizeofPrimArray . fingerprintAs

427429

428430-- | Return the list of 'SomeTypeRep' from the keys.

429431keys :: TypeRepMap f -> [SomeTypeRep]

430−keys TypeRepMap{..} = SomeTypeRep . anyToTypeRep <$> toList trKeys

432+keys = keysWith SomeTypeRep

431433{-# INLINE keys #-}

432434

435+-- | Return the list of keys by wrapping them with a user-provided function.

436+keysWith :: (forall (a :: ArgKindOf f). TypeRep a -> r) -> TypeRepMap f -> [r]

437+keysWith f TypeRepMap{..} = f . anyToTypeRep <$> toList trKeys

438+{-# INLINE keysWith #-}

439+

440+-- | Return the list of key-value pairs by wrapping them with a user-provided function.

441+toListWith :: forall f r. (forall (a :: ArgKindOf f). Typeable a => f a -> r) -> TypeRepMap f -> [r]

442+toListWith f = map toF . toTriples

443+ where

444+ withTypeRep :: TypeRep a -> f a -> r

445+ withTypeRep tr an = withTypeable tr $ f an

446+ toF (_, an, k) = withTypeRep (unsafeCoerce k) (fromAny an)

447+

433448-- | Binary searched based on this article

434449-- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html

435450-- with modification for our two-vector search case.

@@ -506,9 +521,6 @@ data WrapTypeable f where

506521instance Show (WrapTypeable f) where

507522 show (WrapTypeable (_ :: f a)) = show $ calcFp @a

508523

509−wrapTypeable :: TypeRep a -> f a -> WrapTypeable f

510−wrapTypeable tr = withTypeable tr WrapTypeable

511−

512524{- |

513525

514526prop> fromList . toList == 'id'

@@ -536,10 +548,7 @@ instance IsList (TypeRepMap f) where

536548 k (WrapTypeable (_ :: f a)) = unsafeCoerce $ typeRep @a

537549

538550 toList :: TypeRepMap f -> [WrapTypeable f]

539− toList = map toWrapTypeable . toTriples

540− where

541− toWrapTypeable :: (Fingerprint, Any, Any) -> WrapTypeable f

542− toWrapTypeable (_, an, k) = wrapTypeable (unsafeCoerce k) (fromAny an)

551+ toList = toListWith WrapTypeable

543552

544553calcFp :: forall a . Typeable a => Fingerprint

545554calcFp = typeRepFingerprint $ typeRep @a

test/Test/TypeRep/TypeRepMap.hs+62−4

@@ -5,14 +5,18 @@ module Test.TypeRep.TypeRepMap

55import Prelude hiding (lookup)

77import Data.Functor.Identity (Identity (..))

8−import GHC.Exts (fromList)

9−import Test.Hspec (Spec, describe, it, shouldBe)

8+import Data.List (sortBy)

9+import Data.Ord (comparing)

10+import Data.Typeable (cast)

11+import GHC.Exts (fromList, toList)

12+import Type.Reflection (SomeTypeRep(..), typeRep)

13+import Test.Hspec (Spec, describe, it, shouldBe, shouldMatchList, shouldSatisfy, expectationFailure)

1014

11−import Data.TMap (TMap, empty, insert, lookup, one, size, union)

15+import Data.TMap (TMap, empty, insert, lookup, one, size, union, keys)

1216import Data.TypeRepMap.Internal (WrapTypeable (..))

1317

1418

15−-- Simple test for 'lookup', 'insert' and 'size' functions.

19+-- Simple test for 'lookup', 'insert', 'size', 'keys', 'toList' functions.

1620typeRepMapSpec :: Spec

1721typeRepMapSpec = describe "TypeRepMap" $ do

1822 describe "Lookup Test" $ do

@@ -39,6 +43,60 @@ typeRepMapSpec = describe "TypeRepMap" $ do

3943 lookup m `shouldBe` Just True

4044 lookup @Int m `shouldBe` Nothing

4145

46+ describe "Keys Test" $ do

47+ it "returns nothing on empty map" $

48+ keys empty `shouldBe` []

49+ it "returns the correct TypeRep" $

50+ keys (one 'a') `shouldBe` [SomeTypeRep $ typeRep @Char]

51+ it "returns the correct TypeReps for 10 different types" $

52+ keys mapOf10 `shouldMatchList`

53+ [ SomeTypeRep $ typeRep @Bool

54+ , SomeTypeRep $ typeRep @[Bool]

55+ , SomeTypeRep $ typeRep @(Maybe Bool)

56+ , SomeTypeRep $ typeRep @(Maybe ())

57+ , SomeTypeRep $ typeRep @[()]

58+ , SomeTypeRep $ typeRep @()

59+ , SomeTypeRep $ typeRep @String

60+ , SomeTypeRep $ typeRep @(Maybe Char)

61+ , SomeTypeRep $ typeRep @Char

62+ , SomeTypeRep $ typeRep @Int

63+ ]

64+

65+ describe "ToList Test" $ do

66+ it "returns nothing on empty map" $

67+ toList empty `shouldSatisfy` null

68+ it "returns correct result when 1 element is inserted" $

69+ case toList (one 'a') of

70+ [WrapTypeable (Identity x)] -> cast x `shouldBe` Just 'a'

71+ _ -> expectationFailure "did not return exactly 1 result"

72+ it "returns correct result when 10 elements are inserted" $ do

73+ let

74+ getTypeRep (WrapTypeable (Identity (_ :: a))) = SomeTypeRep $ typeRep @a

75+ got = sortBy (comparing getTypeRep) (toList mapOf10)

76+ expected = sortBy (comparing fst)

77+ [ (SomeTypeRep $ typeRep @Bool,

78+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just True)

79+ , (SomeTypeRep $ typeRep @[Bool],

80+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just [True, False])

81+ , (SomeTypeRep $ typeRep @(Maybe Bool),

82+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just True))

83+ , (SomeTypeRep $ typeRep @(Maybe ()),

84+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just ()))

85+ , (SomeTypeRep $ typeRep @[()],

86+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just [()])

87+ , (SomeTypeRep $ typeRep @(),

88+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just ())

89+ , (SomeTypeRep $ typeRep @String,

90+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just ("aaa" :: String))

91+ , (SomeTypeRep $ typeRep @(Maybe Char),

92+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (Just 'a'))

93+ , (SomeTypeRep $ typeRep @Char,

94+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just 'a')

95+ , (SomeTypeRep $ typeRep @Int,

96+ \(WrapTypeable (Identity x)) -> cast x `shouldBe` Just (11 :: Int))

97+ ]

98+ length got `shouldBe` 10

99+ sequence_ $ zipWith snd expected got

42100

43101mapOf10 :: TMap

44102mapOf10 = insert True