0c141b7 · typerep-map · git.iko.soy

git.iko.soy/typerep-map

on main help sign in

[#48] Add adjustWithKey and adjust for TMap (#50)

0c141b7Veronika Romashkina8 years ago

CHANGELOG.md+3−1

compare with main

unifiedsplit

@@ -6,9 +6,11 @@ The change log is available [on GitHub][2].

7# 0.3.0

9−* [#43](https://github.com/kowainik/typerep-map/issues/43):

9+* [#46](https://github.com/kowainik/typerep-map/issues/46):

10 Make `Show` instance for `TypeRepMap` show keys.

11 Add `keys` function.

12+* [#48](https://github.com/kowainik/typerep-map/issues/48):

13+ Add `adjust` function for `TypeRepMap` and `TMap`.

13# 0.2.0

15# 0.2.0

src/Data/TMap.hs+10−4

@@ -34,6 +34,7 @@ module Data.TMap

34 , unionWith

35 , union

36 , map

37+ , adjust

38 -- * Query

39 -- * Query

39 , lookup

40 , lookup

@@ -157,8 +158,13 @@ keys = F.keys

157

158

158-- | Map a function over the values.

159-- | Map a function over the values.

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

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

160−map f = F.hoistWithKey (fIdentity f)

161+map f = F.hoistWithKey (liftToIdentity f)

161− where

162− fIdentity :: forall a. Typeable a => (a -> a) -> Identity a -> Identity a

163− fIdentity = coerce

164{-# INLINE map #-}

162{-# INLINE map #-}

163+

164+-- | Update a value with the result of the provided function.

165+adjust :: Typeable a => (a -> a) -> TMap -> TMap

166+adjust f = F.adjust (liftToIdentity f)

167+{-# INLINE adjust #-}

168+

169+liftToIdentity :: forall a. Typeable a => (a -> a) -> Identity a -> Identity a

170+liftToIdentity = coerce

src/Data/TypeRepMap.hs+1

@@ -51,6 +51,7 @@ module Data.TypeRepMap

51 -- * Modification

52 , insert

53 , delete

54+ , adjust

54 , hoist

55 , hoist

55 , hoistA

56 , hoistA

56 , hoistWithKey

57 , hoistWithKey

src/Data/TypeRepMap/Internal.hs+25−1

@@ -23,13 +23,15 @@ module Data.TypeRepMap.Internal where

24import Prelude hiding (lookup)

26+import Control.Monad.ST (runST)

26import Control.Monad.Zip (mzip)

27import Control.Monad.Zip (mzip)

27import Data.Function (on)

28import Data.Function (on)

28import Data.IntMap.Strict (IntMap)

29import Data.IntMap.Strict (IntMap)

29import Data.Kind (Type)

30import Data.Kind (Type)

30import Data.List (intercalate, nubBy)

31import Data.List (intercalate, nubBy)

31import Data.Maybe (fromJust)

32import Data.Maybe (fromJust)

32−import Data.Primitive.Array (Array, indexArray, mapArray')

33+import Data.Primitive.Array (Array, freezeArray, indexArray, mapArray', readArray, sizeofArray,

34+ thawArray, writeArray)

33import Data.Primitive.PrimArray (PrimArray, indexPrimArray, sizeofPrimArray)

35import Data.Primitive.PrimArray (PrimArray, indexPrimArray, sizeofPrimArray)

34import Data.Semigroup (Semigroup (..))

36import Data.Semigroup (Semigroup (..))

35import GHC.Base (Any, Int (..), Int#, (*#), (+#), (<#))

37import GHC.Base (Any, Int (..), Int#, (*#), (+#), (<#))

@@ -162,6 +164,28 @@ delete :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f -> TypeR

162delete = fromTriples . deleteByFst (typeFp @a) . toTriples

164delete = fromTriples . deleteByFst (typeFp @a) . toTriples

163{-# INLINE delete #-}

165{-# INLINE delete #-}

164

166

167+{- |

168+Update a value at a specific key with the result of the provided function. When

169+the key is not a member of the map, the original map is returned.

170+

171+>>> trmap = fromList @(TypeRepMap Identity) [WrapTypeable $ Identity "a"]

172+>>> lookup @String $ adjust (fmap (++ "ww")) trmap

173+Just (Identity "aww")

174+-}

175+adjust :: forall a f . Typeable a => (f a -> f a) -> TypeRepMap f -> TypeRepMap f

176+adjust fun tr = case cachedBinarySearch (typeFp @a) (fingerprintAs tr) (fingerprintBs tr) of

177+ Nothing -> tr

178+ Just i -> tr {trAnys = changeAnyArr i (trAnys tr)}

179+ where

180+ changeAnyArr :: Int -> Array Any -> Array Any

181+ changeAnyArr i trAs = runST $ do

182+ let n = sizeofArray trAs

183+ mutArr <- thawArray trAs 0 n

184+ a <- toAny . fun . fromAny <$> readArray mutArr i

185+ writeArray mutArr i a

186+ freezeArray mutArr 0 n

187+{-# INLINE adjust #-}

188+

165{- | Map over the elements of a 'TypeRepMap'.

189{- | Map over the elements of a 'TypeRepMap'.

166

190

167>>> tm = insert (Identity True) $ one (Identity 'a')

191>>> tm = insert (Identity True) $ one (Identity 'a')