diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,6 @@ +# Revision history for dependent-map + +## 0.3 - 2019-03-21 + +* Change instances of Eq, Ord, Read, Show to use Has' from constraints-extras instead of *Tag classes. +* This ends support for GHC 7.x. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,30 @@ +dependent-map [![Build Status](https://travis-ci.org/mokus0/dependent-map.svg)](https://travis-ci.org/mokus0/dependent-map) +============== + +This library defines a dependently-typed finite map type. It is derived from Data.Map.Map in the containers package, but rather than (conceptually) storing pairs indexed by the first component, it stores `DSum`s (from the `dependent-sum` package) indexed by tag. For example (using the types from the `dependent-sum` package's `FooGADT` example): + + {-# LANGUAGE GADTs #-} + import FooGADT + import Data.Dependent.Map + + x = fromList [Foo :=> pi, Baz :=> "hello there"] + y = singleton Bar 42 + z = union y (read "fromList [Foo :=> (-1.1415926535897931)]") + + addFoo :: Foo v -> v -> v -> v + addFoo Foo x y = x + y + addFoo _ x _ = x + + main = mapM_ print + [ x, y, z + , unionWithKey addFoo x z + ] + +Which prints: + + fromList [Foo :=> 3.141592653589793,Baz :=> "hello there"] + fromList [Bar :=> 42] + fromList [Foo :=> -1.1415926535897931,Bar :=> 42] + fromList [Foo :=> 2.0,Bar :=> 42,Baz :=> "hello there"] + +This library can be found on Hackage: https://hackage.haskell.org/package/dependent-map diff --git a/dependent-map.cabal b/dependent-map.cabal --- a/dependent-map.cabal +++ b/dependent-map.cabal @@ -1,5 +1,5 @@ name: dependent-map -version: 0.2.4.0 +version: 0.3 stability: provisional cabal-version: >= 1.6 @@ -17,14 +17,14 @@ @Data.Map.Map@, allowing keys to specify the type of value that can be associated with them. -tested-with: GHC == 7.0.4, - GHC == 7.2.2, - GHC == 7.4.2, - GHC == 7.6.3, - GHC == 7.8.4, - GHC == 7.10.1, - GHC == 7.11 +extra-source-files: ChangeLog.md + README.md +tested-with: GHC == 8.0.2, + GHC == 8.2.2, + GHC == 8.4.4, + GHC == 8.6.4 + source-repository head type: git location: git://github.com/mokus0/dependent-map.git @@ -32,15 +32,11 @@ Library hs-source-dirs: src ghc-options: -fwarn-unused-imports -fwarn-unused-binds - exposed-modules: Data.Dependent.Map - other-modules: Data.Dependent.Map.Internal, - Data.Dependent.Map.PtrEquality - if impl(ghc < 7.8) - other-modules: Data.Dependent.Map.Typeable - if impl(ghc < 8) - build-depends: semigroups + exposed-modules: Data.Dependent.Map, + Data.Dependent.Map.Lens, + Data.Dependent.Map.Internal + other-modules: Data.Dependent.Map.PtrEquality build-depends: base >= 3 && < 5, - containers, - dependent-sum >= 0.3.2 - if impl(ghc >= 7.2) && impl(ghc < 7.8) - ghc-options: -trust base -trust dependent-sum + containers >= 0.6 && <0.7, + dependent-sum >= 0.6.1 && < 0.7, + constraints-extras >= 0.2.3.0 && < 0.4 diff --git a/src/Data/Dependent/Map.hs b/src/Data/Dependent/Map.hs --- a/src/Data/Dependent/Map.hs +++ b/src/Data/Dependent/Map.hs @@ -8,12 +8,16 @@ #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} + #endif module Data.Dependent.Map ( DMap , DSum(..), Some(..) , GCompare(..), GOrdering(..) - + -- * Operators , (!), (\\) @@ -24,7 +28,7 @@ , notMember , lookup , findWithDefault - + -- * Construction , empty , singleton @@ -37,7 +41,7 @@ , insertWithKey' , insertLookupWithKey , insertLookupWithKey' - + -- ** Delete\/Update , delete , adjust @@ -47,11 +51,12 @@ , updateWithKey , updateLookupWithKey , alter + , alterF -- * Combine -- ** Union - , union + , union , unionWithKey , unions , unionsWithKey @@ -59,9 +64,9 @@ -- ** Difference , difference , differenceWithKey - + -- ** Intersection - , intersection + , intersection , intersectionWithKey -- * Traversal @@ -83,7 +88,7 @@ -- * Conversion , keys , assocs - + -- ** Lists , toList , fromList @@ -96,22 +101,23 @@ , fromAscListWithKey , fromDistinctAscList - -- * Filter + -- * Filter , filter , filterWithKey , partitionWithKey + , mapMaybe , mapMaybeWithKey , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy - -- * Indexed + -- * Indexed , lookupIndex , findIndex , elemAt @@ -131,7 +137,7 @@ , updateMaxWithKey , minViewWithKey , maxViewWithKey - + -- * Debugging , showTree , showTreeWith @@ -149,7 +155,9 @@ #endif import Data.Dependent.Sum +import Data.Constraint.Extras import Data.GADT.Compare +import Data.GADT.Show import Data.Maybe (isJust) #if !MIN_VERSION_base(4,8,0) import Data.Monoid @@ -186,21 +194,21 @@ m1 \\ m2 = difference m1 m2 -- #if __GLASGOW_HASKELL__ --- +-- -- {-------------------------------------------------------------------- --- A Data instance +-- A Data instance -- --------------------------------------------------------------------} --- +-- -- -- This instance preserves data abstraction at the cost of inefficiency. -- -- We omit reflection services for the sake of data abstraction. --- +-- -- instance (Data k, Data a, GCompare k) => Data (DMap k) where -- gfoldl f z m = z fromList `f` toList m -- toConstr _ = error "toConstr" -- gunfold _ _ = error "gunfold" -- dataTypeOf _ = mkNoRepType "Data.Map.Map" -- dataCast2 f = gcast2 f --- +-- -- #endif {-------------------------------------------------------------------- @@ -277,7 +285,7 @@ GEQ -> t -- | /O(log n)/. Insert with a function, combining new value and old value. --- @'insertWith' f key value mp@ +-- @'insertWith' f key value mp@ -- will insert the entry @key :=> value@ into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the entry @key :=> f new_value old_value@. @@ -290,7 +298,7 @@ insertWith' f = insertWithKey' (\_ x' y' -> f x' y') -- | /O(log n)/. Insert with a function, combining key, new value and old value. --- @'insertWithKey' f key value mp@ +-- @'insertWithKey' f key value mp@ -- will insert the entry @key :=> value@ into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the entry @key :=> f key new_value old_value@. @@ -425,7 +433,7 @@ -- | /O(log n)/. Lookup and update. See also 'updateWithKey'. -- The function returns changed value, if it is updated. --- Returns the original key value if the map entry is deleted. +-- Returns the original key value if the map entry is deleted. updateLookupWithKey :: forall k f v. GCompare k => (k v -> f v -> Maybe (f v)) -> k v -> DMap k f -> (Maybe (f v), DMap k f) updateLookupWithKey f k = k `seq` go where @@ -434,7 +442,7 @@ go (Bin sx kx x l r) = case gcompare k kx of GLT -> let (found,l') = go l in (found,balance kx x l' r) - GGT -> let (found,r') = go r in (found,balance kx x l r') + GGT -> let (found,r') = go r in (found,balance kx x l r') GEQ -> case f kx x of Just x' -> (Just x',Bin sx kx x' l r) Nothing -> (Just x,glue l r) @@ -457,6 +465,19 @@ Just x' -> Bin sx kx x' l r Nothing -> glue l r +-- | Works the same as 'alter' except the new value is return in some 'Functor' @f@. +-- In short : @(\v' -> alter (const v') k dm) <$> f (lookup k dm)@ +alterF :: forall k f v g. (GCompare k, Functor f) => k v -> (Maybe (g v) -> f (Maybe (g v))) -> DMap k g -> f (DMap k g) +alterF k f = go + where + go :: DMap k g -> f (DMap k g) + go Tip = maybe Tip (singleton k) <$> f Nothing + + go (Bin sx kx x l r) = case gcompare k kx of + GLT -> (\l' -> balance kx x l' r) <$> go l + GGT -> (\r' -> balance kx x l r') <$> go r + GEQ -> maybe (glue l r) (\x' -> Bin sx kx x' l r) <$> f (Just x) + {-------------------------------------------------------------------- Indexing --------------------------------------------------------------------} @@ -480,7 +501,7 @@ go !idx (Bin _ kx _ l r) = case gcompare k kx of GLT -> go idx l - GGT -> go (idx + size l + 1) r + GGT -> go (idx + size l + 1) r GEQ -> Just (idx + size l) -- | /O(log n)/. Retrieve an element by /index/. Calls 'error' when an @@ -507,7 +528,7 @@ EQ -> case f kx x of Just x' -> Bin sx kx x' l r Nothing -> glue l r - where + where sizeL = size l -- | /O(log n)/. Delete the element at /index/. @@ -584,7 +605,7 @@ go Tip = Tip {-------------------------------------------------------------------- - Union. + Union. --------------------------------------------------------------------} -- | The union of a list of maps: @@ -600,7 +621,7 @@ = foldlStrict (unionWithKey f) empty ts -- | /O(m*log(n\/m + 1)), m <= n/. --- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. +-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). union :: GCompare k => DMap k f -> DMap k f -> DMap k f @@ -635,7 +656,7 @@ Difference --------------------------------------------------------------------} --- | /O(m * log (n\/m + 1)), m <= n/. Difference of two maps. +-- | /O(m * log (n\/m + 1)), m <= n/. Difference of two maps. -- Return elements of the first map not existing in the second map. difference :: GCompare k => DMap k f -> DMap k g -> DMap k f difference Tip _ = Tip @@ -651,7 +672,7 @@ -- | /O(n+m)/. Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). If --- it returns (@'Just' y@), the element is updated with a new value @y@. +-- it returns (@'Just' y@), the element is updated with a new value @y@. differenceWithKey :: GCompare k => (forall v. k v -> f v -> g v -> Maybe (f v)) -> DMap k f -> DMap k g -> DMap k f differenceWithKey _ Tip _ = Tip differenceWithKey _ t1 Tip = t1 @@ -702,8 +723,11 @@ -- | /O(n+m)/. -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' 'eqTagged')@). -- -isSubmapOf :: (GCompare k, EqTag k f) => DMap k f -> DMap k f -> Bool -isSubmapOf m1 m2 = isSubmapOfBy eqTagged m1 m2 +isSubmapOf + :: forall k f + . (GCompare k, Has' Eq k f) + => DMap k f -> DMap k f -> Bool +isSubmapOf m1 m2 = isSubmapOfBy (\k _ x0 x1 -> has' @Eq @f k (x0 == x1)) m1 m2 {- | /O(n+m)/. The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if @@ -724,17 +748,20 @@ where (lt,found,gt) = splitLookupWithKey kx t --- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). +-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' 'eqTagged'@). -isProperSubmapOf :: (GCompare k, EqTag k f) => DMap k f -> DMap k f -> Bool +isProperSubmapOf + :: forall k f + . (GCompare k, Has' Eq k f) + => DMap k f -> DMap k f -> Bool isProperSubmapOf m1 m2 - = isProperSubmapOfBy eqTagged m1 m2 + = isProperSubmapOfBy (\k _ x0 x1 -> has' @Eq @f k (x0 == x1)) m1 m2 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when - applied to their respective keys and values. + applied to their respective keys and values. -} isProperSubmapOfBy :: GCompare k => (forall v. k v -> k v -> f v -> g v -> Bool) -> DMap k f -> DMap k g -> Bool isProperSubmapOfBy f t1 t2 @@ -772,6 +799,10 @@ (l1 :*: l2) = go p l (r1 :*: r2) = go p r +-- | /O(n)/. Map values and collect the 'Just' results. +mapMaybe :: GCompare k => (forall v. f v -> Maybe (g v)) -> DMap k f -> DMap k g +mapMaybe f = mapMaybeWithKey (const f) + -- | /O(n)/. Map keys\/values and collect the 'Just' results. mapMaybeWithKey :: GCompare k => (forall v. k v -> f v -> Maybe (g v)) -> DMap k f -> DMap k g mapMaybeWithKey f = go @@ -852,7 +883,7 @@ -- | /O(n*log n)/. -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. --- +-- -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key. In this case the associated values will be -- combined using @c@. @@ -867,8 +898,8 @@ -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. -- /The precondition is not checked./ -- Semi-formally, we have: --- --- > and [x < y ==> f x < f y | x <- ls, y <- ls] +-- +-- > and [x < y ==> f x < f y | x <- ls, y <- ls] -- > ==> mapKeysMonotonic f s == mapKeys f s -- > where ls = keys s -- @@ -880,7 +911,7 @@ Bin sz (f k) x (mapKeysMonotonic f l) (mapKeysMonotonic f r) {-------------------------------------------------------------------- - Folds + Folds --------------------------------------------------------------------} -- | /O(n)/. Fold the keys and values in the map, such that @@ -918,7 +949,7 @@ -} {-------------------------------------------------------------------- - List variations + List variations --------------------------------------------------------------------} -- | /O(n)/. Return all keys of the map in ascending order. @@ -936,7 +967,7 @@ = toList m {-------------------------------------------------------------------- - Lists + Lists use [foldlStrict] to reduce demand on the control-stack --------------------------------------------------------------------} @@ -944,7 +975,7 @@ -- If the list contains more than one value for the same key, the last value -- for the key is retained. fromList :: GCompare k => [DSum k f] -> DMap k f -fromList xs +fromList xs = foldlStrict ins empty xs where ins :: GCompare k => DMap k f -> DSum k f -> DMap k f @@ -952,7 +983,7 @@ -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. fromListWithKey :: GCompare k => (forall v. k v -> f v -> f v -> f v) -> [DSum k f] -> DMap k f -fromListWithKey f xs +fromListWithKey f xs = foldlStrict (ins f) empty xs where ins :: GCompare k => (forall v. k v -> f v -> f v -> f v) -> DMap k f -> DSum k f -> DMap k f @@ -972,8 +1003,8 @@ {-------------------------------------------------------------------- Building trees from ascending/descending lists can be done in linear time. - - Note that if [xs] is ascending that: + + Note that if [xs] is ascending that: fromAscList xs == fromList xs fromAscListWith f xs == fromListWith f xs --------------------------------------------------------------------} @@ -987,7 +1018,7 @@ -- | /O(n)/. Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ -fromAscListWithKey :: GEq k => (forall v. k v -> f v -> f v -> f v) -> [DSum k f] -> DMap k f +fromAscListWithKey :: GEq k => (forall v. k v -> f v -> f v -> f v) -> [DSum k f] -> DMap k f fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs) where @@ -1013,12 +1044,12 @@ = build const (length xs) xs where -- 1) use continutations so that we use heap space instead of stack space. - -- 2) special case for n==5 to build bushier trees. - + -- 2) special case for n==5 to build bushier trees. + build :: (DMap k f -> [DSum k f] -> b) -> Int -> [DSum k f] -> b build c 0 xs' = c Tip xs' build c 5 xs' = case xs' of - ((k1:=>x1):(k2:=>x2):(k3:=>x3):(k4:=>x4):(k5:=>x5):xx) + ((k1:=>x1):(k2:=>x2):(k3:=>x3):(k4:=>x4):(k5:=>x5):xx) -> c (bin k4 x4 (bin k2 x2 (singleton k1 x1) (singleton k3 x3)) (singleton k5 x5)) xx _ -> error "fromDistinctAscList build" build c n xs' = seq nr $ build (buildR nr c) nl xs' @@ -1029,10 +1060,10 @@ buildR :: Int -> (DMap k f -> [DSum k f] -> b) -> DMap k f -> [DSum k f] -> b buildR n c l ((k:=>x):ys) = build (buildB l k x c) n ys buildR _ _ _ [] = error "fromDistinctAscList buildR []" - + buildB :: DMap k f -> k v -> f v -> (DMap k f -> a -> b) -> DMap k f -> a -> b buildB l k x c r zs = c (bin k x l r) zs - + {-------------------------------------------------------------------- Split --------------------------------------------------------------------} @@ -1087,25 +1118,25 @@ GEQ -> Triple' l (Just (kx, x)) r {-------------------------------------------------------------------- - Eq converts the tree to a list. In a lazy setting, this - actually seems one of the faster methods to compare two trees + Eq converts the tree to a list. In a lazy setting, this + actually seems one of the faster methods to compare two trees and it is certainly the simplest :-) --------------------------------------------------------------------} -instance EqTag k f => Eq (DMap k f) where +instance (GEq k, Has' Eq k f) => Eq (DMap k f) where t1 == t2 = (size t1 == size t2) && (toAscList t1 == toAscList t2) {-------------------------------------------------------------------- - Ord + Ord --------------------------------------------------------------------} -instance OrdTag k f => Ord (DMap k f) where - compare m1 m2 = compare (toAscList m1) (toAscList m2) +instance (GCompare k, Has' Eq k f, Has' Ord k f) => Ord (DMap k f) where + compare m1 m2 = compare (toAscList m1) (toAscList m2) {-------------------------------------------------------------------- Read --------------------------------------------------------------------} -instance (GCompare k, ReadTag k f) => Read (DMap k f) where +instance (GCompare k, GRead k, Has' Read k f) => Read (DMap k f) where readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec @@ -1116,7 +1147,7 @@ {-------------------------------------------------------------------- Show --------------------------------------------------------------------} -instance ShowTag k f => Show (DMap k f) where +instance (GShow k, Has' Show k f) => Show (DMap k f) where showsPrec p m = showParen (p>10) ( showString "fromList " . showsPrec 11 (toList m) @@ -1124,11 +1155,11 @@ -- | /O(n)/. Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. See 'showTreeWith'. -showTree :: ShowTag k f => DMap k f -> String +showTree :: (GShow k, Has' Show k f) => DMap k f -> String showTree m = showTreeWith showElem True False m where - showElem :: ShowTag k f => k v -> f v -> String + showElem :: (GShow k, Has' Show k f) => k v -> f v -> String showElem k x = show (k :=> x) @@ -1147,7 +1178,7 @@ = case t of Tip -> showsBars lbars . showString "|\n" Bin _ kx x Tip Tip - -> showsBars lbars . showString (showelem kx x) . showString "\n" + -> showsBars lbars . showString (showelem kx x) . showString "\n" Bin _ kx x l r -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r . showWide wide rbars . @@ -1158,19 +1189,19 @@ showsTreeHang :: (forall v. k v -> f v -> String) -> Bool -> [String] -> DMap k f -> ShowS showsTreeHang showelem wide bars t = case t of - Tip -> showsBars bars . showString "|\n" + Tip -> showsBars bars . showString "|\n" Bin _ kx x Tip Tip - -> showsBars bars . showString (showelem kx x) . showString "\n" + -> showsBars bars . showString (showelem kx x) . showString "\n" Bin _ kx x l r - -> showsBars bars . showString (showelem kx x) . showString "\n" . + -> showsBars bars . showString (showelem kx x) . showString "\n" . showWide wide bars . showsTreeHang showelem wide (withBar bars) l . showWide wide bars . showsTreeHang showelem wide (withEmpty bars) r showWide :: Bool -> [String] -> String -> String -showWide wide bars - | wide = showString (concat (reverse bars)) . showString "|\n" +showWide wide bars + | wide = showString (concat (reverse bars)) . showString "|\n" | otherwise = id showsBars :: [String] -> ShowS @@ -1231,4 +1262,3 @@ where go z [] = z go z (x:xs) = z `seq` go (f z x) xs - diff --git a/src/Data/Dependent/Map/Lens.hs b/src/Data/Dependent/Map/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Dependent/Map/Lens.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE CPP #-} +-- | +-- Some functions for using lenses with 'DMap'. +module Data.Dependent.Map.Lens + ( -- * At + dmat + -- * Ix + , dmix + ) + where + +import Prelude hiding (lookup) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative (pure)) +#endif + +import Data.Dependent.Map (DMap, alterF, insert, lookup) + +import Data.GADT.Compare (GCompare) + +-- | +-- These functions have been specialised for use with 'DMap' but without any of the +-- specific 'lens' types used so that we have compatilibity without needing the +-- dependency just for these functions. +-- + +-- | +-- This is equivalent to the from : +-- +-- @ +-- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +-- +-- at :: Index m -> Lens' m (Maybe (IxValue m)) +-- @ +-- +-- So the type of 'dmat' is equivalent to: +-- +-- @ +-- dmat :: GCompare k => Lens' (DMap k f) (Maybe (f v)) +-- @ +-- +-- >>> DMap.fromList [AInt :=> Identity 33, AFloat :=> Identity 3.5] & dmat AString ?~ "Hat" +-- DMap.fromList [AString :=> Identity "Hat", AInt :=> Identity 33, AFloat :=> Identity 3.5] +-- +-- >>> DMap.fromList [AString :=> Identity "Shoe", AInt :=> Identity 33, AFloat :=> Identity 3.5] ^? dmat AFloat +-- Just (AFloat :=> 3.5) +-- +dmat :: (GCompare k, Functor f) => k v -> (Maybe (g v) -> f (Maybe (g v))) -> DMap k g -> f (DMap k g) +dmat k f = alterF k f +{-# INLINE dmat #-} + +-- | +-- This is equivalent to the from : +-- +-- @ +-- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t +-- +-- ix :: Index m -> Traversal' m (IxValue m) +-- @ +-- +-- So the type of 'dmix' is equivalent to: +-- +-- @ +-- dmix :: GCompare k => k v -> Traversal' (DMap k f) (f v) +-- @ +-- +-- /NB:/ Setting the value of this +-- +-- will only set the value in 'dmix' if it is already present. +-- +-- If you want to be able to insert /missing/ values, you want 'dmat'. +-- +-- >>> DMap.fromList [AString :=> Identity "Shoe", AInt :=> Identity 33, AFloat :=> Identity 3.5] & dmix AInt %~ f +-- DMap.fromList [AString :=> Identity "Shoe", AInt :=> Identity (f 33), AFloat :=> Identity 3.5] +-- +-- >>> DMap.fromList [AString :=> Identity "Shoe", AInt :=> Identity 33, AFloat :=> Identity 3.5] & dmix AString .~ "Hat" +-- DMap.fromList [AString :=> Identity "Hat", AInt :=> Identity 33, AFloat :=> Identity 3.5] +-- +-- >>> DMap.fromList [AString :=> Identity "Shoe", AInt :=> Identity 33, AFloat :=> Identity 3.5] ^? dmix AFloat +-- Just (AFloat :=> 3.5) +-- +-- >>> DMap.fromList [AString :=> Identity "Shoe", AFloat :=> Identity 3.5] ^? dmix AInt +-- Nothing +dmix :: (GCompare k, Applicative f) => k v -> (g v -> f (g v)) -> DMap k g -> f (DMap k g) +dmix k f dmap = maybe (pure dmap) (fmap (flip (insert k) dmap) . f) $ lookup k dmap +{-# INLINE dmix #-} diff --git a/src/Data/Dependent/Map/Typeable.hs b/src/Data/Dependent/Map/Typeable.hs deleted file mode 100644 --- a/src/Data/Dependent/Map/Typeable.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif -module Data.Dependent.Map.Typeable where - -import Data.Dependent.Map.Internal -import Data.Typeable - -instance (Typeable1 k, Typeable1 f) => Typeable (DMap k f) where - typeOf ds = mkTyConApp dMapCon [typeOfK, typeOfF] - where - typeOfK = typeOf1 $ (undefined :: DMap k f -> k a) ds - typeOfF = typeOf1 $ (undefined :: DMap k f -> f a) ds - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 - dMapCon = mkTyCon3 "dependent-map" "Data.Dependent.Map" "DMap" -#else - dMapCon = mkTyCon "Data.Dependent.Map.DMap" - -#endif