main..f562d9a · typerep-map

git.iko.soy/typerep-map

on f562d9a help sign in

src/Data/TMap.hs+1−13

since splitsnapshots

unifiedsplit

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

48 , member

49 , size

50 , keys

51− , keysWith

52− , toListWith

53 ) where

51 ) where

55import Prelude hiding (lookup, map)

53import Prelude hiding (lookup, map)

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

57import Data.Functor.Identity (Identity (..))

55import Data.Functor.Identity (Identity (..))

58import Data.Typeable (Typeable)

56import Data.Typeable (Typeable)

59import GHC.Exts (coerce)

57import GHC.Exts (coerce)

60−import Type.Reflection (SomeTypeRep, TypeRep)

58+import Type.Reflection (SomeTypeRep)

62import qualified Data.TypeRepMap as F

60import qualified Data.TypeRepMap as F

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

187keys = F.keys

185keys = F.keys

188{-# INLINE keys #-}

186{-# INLINE keys #-}

189

187

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−

200-- | Map a function over the values.

188-- | Map a function over the values.

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

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

202map f = F.hoistWithKey (liftToIdentity f)

190map f = F.hoistWithKey (liftToIdentity f)

src/Data/TypeRepMap.hs−2

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

71 , member

72 , size

73 , keys

74− , keysWith

75− , toListWith

77 -- * 'IsList'

75 -- * 'IsList'

78 , WrapTypeable (..)

76 , WrapTypeable (..)

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

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

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

206type KindOf (a :: k) = k

207

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

209−

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

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

211

209

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

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

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

429

427

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

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

431keys :: TypeRepMap f -> [SomeTypeRep]

429keys :: TypeRepMap f -> [SomeTypeRep]

432−keys = keysWith SomeTypeRep

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

433{-# INLINE keys #-}

431{-# INLINE keys #-}

434

432

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−

448-- | Binary searched based on this article

433-- | Binary searched based on this article

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

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

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

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

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

521instance Show (WrapTypeable f) where

506instance Show (WrapTypeable f) where

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

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

523

508

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

510+wrapTypeable tr = withTypeable tr WrapTypeable

511+

524{- |

512{- |

525

513

526prop> fromList . toList == 'id'

514prop> fromList . toList == 'id'

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

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

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

549

537

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

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

551− toList = toListWith WrapTypeable

539+ toList = map toWrapTypeable . toTriples

540+ where

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

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

552

543

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

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

554calcFp = typeRepFingerprint $ typeRep @a

545calcFp = typeRepFingerprint $ typeRep @a

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

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

5import Prelude hiding (lookup)

7import Data.Functor.Identity (Identity (..))

8−import Data.List (sortBy)

9−import Data.Ord (comparing)

10−import Data.Typeable (cast)

11−import GHC.Exts (fromList, toList)

8+import GHC.Exts (fromList)

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

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

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

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

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

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

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

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

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

20typeRepMapSpec :: Spec

16typeRepMapSpec :: Spec

21typeRepMapSpec = describe "TypeRepMap" $ do

17typeRepMapSpec = describe "TypeRepMap" $ do

22 describe "Lookup Test" $ do

18 describe "Lookup Test" $ do

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

43 lookup m `shouldBe` Just True

39 lookup m `shouldBe` Just True

44 lookup @Int m `shouldBe` Nothing

40 lookup @Int m `shouldBe` Nothing

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

100

101mapOf10 :: TMap

43mapOf10 :: TMap

102mapOf10 = insert True

44mapOf10 = insert True