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

git.iko.soy/typerep-map

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

* [#48] Add adjustWithKey and adjust for TMap * Fix space * Improve adjust function Rename to adjust for TypeRepMap

commit0c141b7132f79a9b2354684447d6a978d41913b0 authorVeronika Romashkina <vrom911@gmail.com> dateMon 20 Aug 2018, 13:51 (8 years ago) parent30686c7

4 files changed+39−6

compare with main

unifiedsplit

CHANGELOG.md+3−1 src/Data/TMap.hs+10−4 src/Data/TypeRepMap.hs+1 src/Data/TypeRepMap/Internal.hs+25−1

CHANGELOG.md+3−1

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

77# 0.3.0

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

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

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

1111 Add `keys` function.

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

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

1214

1315# 0.2.0

1416

src/Data/TMap.hs+10−4

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

3434 , unionWith

3535 , union

3636 , map

37+ , adjust

3738

3839 -- * Query

3940 , lookup

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

157158

158159-- | Map a function over the values.

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

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

161− where

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

163− fIdentity = coerce

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

164162{-# 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

5151 -- * Modification

5252 , insert

5353 , delete

54+ , adjust

5455 , hoist

5556 , hoistA

5657 , hoistWithKey

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

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

2323

2424import Prelude hiding (lookup)

2525

26+import Control.Monad.ST (runST)

2627import Control.Monad.Zip (mzip)

2728import Data.Function (on)

2829import Data.IntMap.Strict (IntMap)

2930import Data.Kind (Type)

3031import Data.List (intercalate, nubBy)

3132import 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)

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

3436import Data.Semigroup (Semigroup (..))

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

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

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

163165{-# INLINE delete #-}

164166

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+

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

166190

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