@@ -0,0 +1,409 @@
1+{-# LANGUAGE DeriveFunctor #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE DeriveTraversable #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE RoleAnnotations #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeApplications #-}
11+{-# LANGUAGE TypeFamilies #-}
12+-- | 'Data.Map' with a better 'Monoid' instance
14+-- 'Data.Map' has @mappend = union@, which is left-biased. AppendMap has
15+-- @mappend = unionWith mappend@ instead.
16+module Data.AppendMap where
18+import Prelude hiding (map)
25+import qualified Data.Map as Map
29+import GHC.Generics (Generic)
30+import Reflex (FunctorMaybe (..))
31+import Reflex.Patch (Additive, Group (..))
33+newtype AppendMap k m = AppendMap { _unAppendMap :: Map k m }
34+ deriving (Eq, Ord, Show, Read, Typeable, Generic, Functor, Foldable, Traversable, Align)
36+type instance (Index (AppendMap k m)) = k
37+type instance (IxValue (AppendMap k m)) = m
39+instance Ord k => Ixed (AppendMap k m) where
40+ ix i = _Wrapped . ix i
42+instance Ord k => At (AppendMap k m) where
43+ at i = _Wrapped . at i
45+instance FunctorMaybe (AppendMap k) where
48+-- | Deletes a key, returning 'Nothing' if the result is empty.
49+nonEmptyDelete :: Ord k => k -> AppendMap k a -> Maybe (AppendMap k a)
51+ let deleted = delete k vs
52+ in if Data.AppendMap.null deleted
56+mapMaybeNoNull :: (a -> Maybe b)
58+ -> Maybe (AppendMap token b)
60+ let bs = fmapMaybe f as
61+ in if Data.AppendMap.null bs
65+instance FunctorWithIndex k (AppendMap k) where
66+ imap f = AppendMap . imap f . _unAppendMap
67+ imapped = _Wrapped . imapped
69+instance FoldableWithIndex k (AppendMap k) where
70+ ifolded = _Wrapped . ifolded
72+instance TraversableWithIndex k (AppendMap k) where
73+ itraverse = itraverseOf itraversed
74+ itraversed = _Wrapped . itraversed
76+instance (Ord k, Semigroup m) => Semigroup (AppendMap k m) where
77+ (AppendMap m0) <> (AppendMap m1) = AppendMap $ Map.unionWith (<>) m0 m1
79+instance (Ord k, Semigroup m) => Monoid (AppendMap k m) where
83+instance (Ord k, Group q) => Group (AppendMap k q) where
84+ negateG = map negateG
86+instance (Ord k, Additive q) => Additive (AppendMap k q)
88+(!) :: forall k a. Ord k => AppendMap k a -> k -> a
89+(!) = coerce ((Map.!) @k @a)
92+(\\) :: forall k a b. Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
93+(\\) = coerce ((Map.\\) @k @a @b)
96+null :: forall k a. AppendMap k a -> Bool
97+null = coerce (Map.null @k @a)
99+size :: forall k a. AppendMap k a -> Int
100+size = coerce (Map.size @k @a)
102+member :: forall k a. Ord k => k -> AppendMap k a -> Bool
103+member = coerce (Map.member @k @a)
105+notMember :: forall k a. Ord k => k -> AppendMap k a -> Bool
106+notMember = coerce (Map.notMember @k @a)
108+lookup :: forall k a. Ord k => k -> AppendMap k a -> Maybe a
109+lookup = coerce (Map.lookup @k @a)
111+findWithDefault :: forall k a. Ord k => a -> k -> AppendMap k a -> a
112+findWithDefault = coerce (Map.findWithDefault @k @a)
114+lookupLT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
115+lookupLT = coerce (Map.lookupLT @k @a)
117+lookupGT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
118+lookupGT = coerce (Map.lookupGT @k @a)
120+lookupLE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
121+lookupLE = coerce (Map.lookupLE @k @a)
123+lookupGE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
124+lookupGE = coerce (Map.lookupGE @k @a)
126+empty :: forall k a. AppendMap k a
127+empty = coerce (Map.empty @k @a)
129+singleton :: forall k a. k -> a -> AppendMap k a
130+singleton = coerce (Map.singleton @k @a)
132+insert :: forall k a. Ord k => k -> a -> AppendMap k a -> AppendMap k a
133+insert = coerce (Map.insert @k @a)
135+insertWith :: Ord k => (a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
136+insertWith f = coerce (Map.insertWith f)
138+insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
139+insertWithKey f = coerce (Map.insertWithKey f)
141+insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> AppendMap k a -> (Maybe a, AppendMap k a)
142+insertLookupWithKey f = coerce (Map.insertLookupWithKey f)
144+delete :: forall k a. Ord k => k -> AppendMap k a -> AppendMap k a
145+delete = coerce (Map.delete @k @a)
147+adjust :: Ord k => (a -> a) -> k -> AppendMap k a -> AppendMap k a
148+adjust f = coerce (Map.adjust f)
150+adjustWithKey :: Ord k => (k -> a -> a) -> k -> AppendMap k a -> AppendMap k a
151+adjustWithKey f = coerce (Map.adjustWithKey f)
153+update :: Ord k => (a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
154+update f = coerce (Map.update f)
156+updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
157+updateWithKey f = coerce (Map.updateWithKey f)
159+updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> (Maybe a, AppendMap k a)
160+updateLookupWithKey f = coerce (Map.updateLookupWithKey f)
162+alter :: Ord k => (Maybe a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
163+alter f = coerce (Map.alter f)
165+unionWith :: Ord k => (a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
166+unionWith f = coerce (Map.unionWith f)
168+unionWithKey :: Ord k => (k -> a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
169+unionWithKey f = coerce (Map.unionWithKey f)
171+unionsWith :: Ord k => (a -> a -> a) -> [AppendMap k a] -> AppendMap k a
172+unionsWith f = coerce (Map.unionsWith f)
174+difference :: Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
177+differenceWith :: Ord k => (a -> b -> Maybe a) -> AppendMap k a -> AppendMap k b -> AppendMap k a
178+differenceWith f = coerce (Map.differenceWith f)
180+differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> AppendMap k a -> AppendMap k b -> AppendMap k a
181+differenceWithKey f = coerce (Map.differenceWithKey f)
183+intersectionWith :: Ord k => (a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
184+intersectionWith f = coerce (Map.intersectionWith f)
186+intersectionWithKey :: Ord k => (k -> a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
187+intersectionWithKey f = coerce (Map.intersectionWithKey f)
189+mergeWithKey :: Ord k => (k -> a -> b -> Maybe c) -> (AppendMap k a -> AppendMap k c) -> (AppendMap k b -> AppendMap k c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
190+mergeWithKey f = coerce (Map.mergeWithKey f)
192+map :: (a -> b) -> AppendMap k a -> AppendMap k b
195+mapWithKey :: (k -> a -> b) -> AppendMap k a -> AppendMap k b
198+traverseWithKey :: Applicative t => (k -> a -> t b) -> AppendMap k a -> t (AppendMap k b)
199+traverseWithKey = itraverse
201+mapAccum :: (a -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
202+mapAccum f = coerce (Map.mapAccum f)
204+mapAccumWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
205+mapAccumWithKey f = coerce (Map.mapAccumWithKey f)
207+mapAccumRWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
208+mapAccumRWithKey f = coerce (Map.mapAccumRWithKey f)
210+mapKeys :: forall k1 k2 a. Ord k2 => (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
211+mapKeys = coerce (Map.mapKeys @k2 @k1 @a)
213+mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
214+mapKeysWith f = coerce (Map.mapKeysWith f)
216+mapKeysMonotonic :: forall k1 k2 a. (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
217+mapKeysMonotonic = coerce (Map.mapKeysMonotonic @k1 @k2 @a)
219+foldr :: (a -> b -> b) -> b -> AppendMap k a -> b
220+foldr f = coerce (Map.foldr f)
222+foldl :: (a -> b -> a) -> a -> AppendMap k b -> a
223+foldl f = coerce (Map.foldl f)
225+foldrWithKey :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
226+foldrWithKey f = coerce (Map.foldrWithKey f)
228+foldlWithKey :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
229+foldlWithKey f = coerce (Map.foldlWithKey f)
231+foldMapWithKey :: Monoid m => (k -> a -> m) -> AppendMap k a -> m
232+foldMapWithKey f = coerce (Map.foldMapWithKey f)
234+foldr' :: (a -> b -> b) -> b -> AppendMap k a -> b
235+foldr' f = coerce (Map.foldr' f)
237+foldl' :: (a -> b -> a) -> a -> AppendMap k b -> a
238+foldl' f = coerce (Map.foldl' f)
240+foldrWithKey' :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
241+foldrWithKey' f = coerce (Map.foldrWithKey' f)
243+foldlWithKey' :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
244+foldlWithKey' f = coerce (Map.foldlWithKey' f)
246+elems :: forall k a. AppendMap k a -> [a]
247+elems = coerce (Map.elems @k @a)
249+keys :: forall k a. AppendMap k a -> [k]
250+keys = coerce (Map.keys @k @a)
252+assocs :: forall k a. AppendMap k a -> [(k, a)]
253+assocs = coerce (Map.assocs @k @a)
255+keysSet :: forall k a. AppendMap k a -> Set k
256+keysSet = coerce (Map.keysSet @k @a)
258+fromSet :: (k -> a) -> Set k -> AppendMap k a
259+fromSet f = coerce (Map.fromSet f)
261+toList :: forall k a. AppendMap k a -> [(k, a)]
262+toList = coerce (Map.toList @k @a)
264+fromList :: forall k a. Ord k => [(k, a)] -> AppendMap k a
265+fromList = coerce (Map.fromList @k @a)
267+fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
268+fromListWith f = coerce (Map.fromListWith f)
270+fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
271+fromListWithKey f = coerce (Map.fromListWithKey f)
273+toAscList :: forall k a. AppendMap k a -> [(k, a)]
274+toAscList = coerce (Map.toAscList @k @a)
276+toDescList :: forall k a. AppendMap k a -> [(k, a)]
277+toDescList = coerce (Map.toDescList @k @a)
279+fromAscList :: forall k a. Eq k => [(k, a)] -> AppendMap k a
280+fromAscList = coerce (Map.fromAscList @k @a)
282+fromAscListWith :: Eq k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
283+fromAscListWith f = coerce (Map.fromAscListWith f)
285+fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
286+fromAscListWithKey f = coerce (Map.fromAscListWithKey f)
288+fromDistinctAscList :: forall k a. [(k, a)] -> AppendMap k a
289+fromDistinctAscList = coerce (Map.fromDistinctAscList @k @a)
291+filter :: (a -> Bool) -> AppendMap k a -> AppendMap k a
292+filter f = coerce (Map.filter f)
294+filterWithKey :: (k -> a -> Bool) -> AppendMap k a -> AppendMap k a
295+filterWithKey f = coerce (Map.filterWithKey f)
297+partition :: (a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
298+partition f = coerce (Map.partition f)
300+partitionWithKey :: (k -> a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
301+partitionWithKey f = coerce (Map.partitionWithKey f)
303+mapMaybe :: (a -> Maybe b) -> AppendMap k a -> AppendMap k b
304+mapMaybe f = coerce (Map.mapMaybe f)
306+mapMaybeWithKey :: (k -> a -> Maybe b) -> AppendMap k a -> AppendMap k b
307+mapMaybeWithKey f = coerce (Map.mapMaybeWithKey f)
309+mapEither :: (a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
310+mapEither f = coerce (Map.mapEither f)
312+mapEitherWithKey :: (k -> a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
313+mapEitherWithKey f = coerce (Map.mapEitherWithKey f)
315+split :: forall k a. Ord k => k -> AppendMap k a -> (AppendMap k a, AppendMap k a)
316+split = coerce (Map.split @k @a)
318+splitLookup :: forall k a. Ord k => k -> AppendMap k a -> (AppendMap k a, Maybe a, AppendMap k a)
319+splitLookup = coerce (Map.splitLookup @k @a)
321+splitRoot :: forall k a. AppendMap k a -> [AppendMap k a]
322+splitRoot = coerce (Map.splitRoot @k @a)
324+isSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
325+isSubmapOf = coerce (Map.isSubmapOf @k @a)
327+isSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
328+isSubmapOfBy f = coerce (Map.isSubmapOfBy f)
330+isProperSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
331+isProperSubmapOf = coerce (Map.isProperSubmapOf @k @a)
333+isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
334+isProperSubmapOfBy f = coerce (Map.isProperSubmapOfBy f)
336+lookupIndex :: forall k a. Ord k => k -> AppendMap k a -> Maybe Int
337+lookupIndex = coerce (Map.lookupIndex @k @a)
339+findIndex :: forall k a. Ord k => k -> AppendMap k a -> Int
340+findIndex = coerce (Map.findIndex @k @a)
342+elemAt :: forall k a. Int -> AppendMap k a -> (k, a)
343+elemAt = coerce (Map.elemAt @k @a)
345+updateAt :: forall k a. (k -> a -> Maybe a) -> Int -> AppendMap k a -> AppendMap k a
346+updateAt = coerce (Map.updateAt @k @a)
348+deleteAt :: forall k a. Int -> AppendMap k a -> AppendMap k a
349+deleteAt = coerce (Map.deleteAt @k @a)
351+findMin :: forall k a. AppendMap k a -> (k, a)
352+findMin = coerce (Map.findMin @k @a)
354+findMax :: forall k a. AppendMap k a -> (k, a)
355+findMax = coerce (Map.findMax @k @a)
357+deleteMin :: forall k a. AppendMap k a -> AppendMap k a
358+deleteMin = coerce (Map.deleteMin @k @ a)
360+deleteMax :: forall k a. AppendMap k a -> AppendMap k a
361+deleteMax = coerce (Map.deleteMax @k @a)
363+deleteFindMin :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
364+deleteFindMin = coerce (Map.deleteFindMin @k @a)
366+deleteFindMax :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
367+deleteFindMax = coerce (Map.deleteFindMax @k @a)
369+updateMin :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
370+updateMin f = coerce (Map.updateMin f)
372+updateMax :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
373+updateMax f = coerce (Map.updateMax f)
375+updateMinWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
376+updateMinWithKey f = coerce (Map.updateMinWithKey f)
378+updateMaxWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
379+updateMaxWithKey f = coerce (Map.updateMaxWithKey f)
381+minView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
382+minView = coerce (Map.minView @k @a)
384+maxView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
385+maxView = coerce (Map.maxView @k @a)
387+minViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
388+minViewWithKey = coerce (Map.minViewWithKey @k @a)
390+maxViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
391+maxViewWithKey = coerce (Map.maxViewWithKey @k @a)
393+showTree :: forall k a. (Show k, Show a) => AppendMap k a -> String
394+showTree = coerce (Map.showTree @k @a)
396+showTreeWith :: (k -> a -> String) -> Bool -> Bool -> AppendMap k a -> String
397+showTreeWith f = coerce (Map.showTreeWith f)
399+valid :: forall k a. Ord k => AppendMap k a -> Bool
400+valid = coerce (Map.valid @k @a)
402+instance Default (AppendMap k a) where
405+instance AppendMap k' v' ~ t => Rewrapped (AppendMap k a) t
407+instance Wrapped (AppendMap k a) where
408+ type Unwrapped (AppendMap k a) = Map k a
409+ _Wrapped' = iso (\(AppendMap m) -> m) AppendMap