@@ -0,0 +1,417 @@
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 StandaloneDeriving #-}
11+{-# LANGUAGE TemplateHaskell #-}
12+{-# LANGUAGE TypeApplications #-}
13+{-# LANGUAGE TypeFamilies #-}
14+-- | 'Data.Map' with a better 'Monoid' instance
16+-- 'Data.Map' has @mappend = union@, which is left-biased. AppendMap has
17+-- @mappend = unionWith mappend@ instead.
18+module Data.AppendMap where
20+import Prelude hiding (map)
27+import qualified Data.Map as Map
31+import GHC.Generics (Generic)
32+import Reflex (FunctorMaybe (..))
33+import Reflex.Patch (Additive, Group (..))
35+newtype AppendMap k m = AppendMap { _unAppendMap :: Map k m }
36+ deriving (Eq, Ord, Show, Read, Typeable, Generic, Functor, Foldable, Traversable, Align)
38+type instance (Index (AppendMap k m)) = k
39+type instance (IxValue (AppendMap k m)) = m
41+instance Ord k => Ixed (AppendMap k m) where
42+ ix i = _Wrapped . ix i
44+instance Ord k => At (AppendMap k m) where
45+ at i = _Wrapped . at i
47+instance FunctorMaybe (AppendMap k) where
50+-- | Deletes a key, returning 'Nothing' if the result is empty.
51+nonEmptyDelete :: Ord k => k -> AppendMap k a -> Maybe (AppendMap k a)
53+ let deleted = delete k vs
54+ in if Data.AppendMap.null deleted
58+mapMaybeNoNull :: (a -> Maybe b)
60+ -> Maybe (AppendMap token b)
62+ let bs = fmapMaybe f as
63+ in if Data.AppendMap.null bs
67+instance FunctorWithIndex k (AppendMap k) where
68+ imap f = AppendMap . imap f . _unAppendMap
69+ imapped = _Wrapped . imapped
71+instance FoldableWithIndex k (AppendMap k) where
72+ ifolded = _Wrapped . ifolded
74+instance TraversableWithIndex k (AppendMap k) where
75+ itraverse = itraverseOf itraversed
76+ itraversed = _Wrapped . itraversed
78+instance (Ord k, Semigroup m) => Semigroup (AppendMap k m) where
79+ (AppendMap m0) <> (AppendMap m1) = AppendMap $ Map.unionWith (<>) m0 m1
81+instance (Ord k, Semigroup m) => Monoid (AppendMap k m) where
85+instance (Ord k, Group q) => Group (AppendMap k q) where
86+ negateG = map negateG
88+instance (Ord k, Additive q) => Additive (AppendMap k q)
90+(!) :: forall k a. Ord k => AppendMap k a -> k -> a
91+(!) = coerce ((Map.!) @k @a)
94+(\\) :: forall k a b. Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
95+(\\) = coerce ((Map.\\) @k @a @b)
98+null :: forall k a. AppendMap k a -> Bool
99+null = coerce (Map.null @k @a)
101+size :: forall k a. AppendMap k a -> Int
102+size = coerce (Map.size @k @a)
104+member :: forall k a. Ord k => k -> AppendMap k a -> Bool
105+member = coerce (Map.member @k @a)
107+notMember :: forall k a. Ord k => k -> AppendMap k a -> Bool
108+notMember = coerce (Map.notMember @k @a)
110+lookup :: forall k a. Ord k => k -> AppendMap k a -> Maybe a
111+lookup = coerce (Map.lookup @k @a)
113+findWithDefault :: forall k a. Ord k => a -> k -> AppendMap k a -> a
114+findWithDefault = coerce (Map.findWithDefault @k @a)
116+lookupLT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
117+lookupLT = coerce (Map.lookupLT @k @a)
119+lookupGT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
120+lookupGT = coerce (Map.lookupGT @k @a)
122+lookupLE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
123+lookupLE = coerce (Map.lookupLE @k @a)
125+lookupGE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
126+lookupGE = coerce (Map.lookupGE @k @a)
128+empty :: forall k a. AppendMap k a
129+empty = coerce (Map.empty @k @a)
131+singleton :: forall k a. k -> a -> AppendMap k a
132+singleton = coerce (Map.singleton @k @a)
134+insert :: forall k a. Ord k => k -> a -> AppendMap k a -> AppendMap k a
135+insert = coerce (Map.insert @k @a)
137+insertWith :: Ord k => (a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
138+insertWith f = coerce (Map.insertWith f)
140+insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
141+insertWithKey f = coerce (Map.insertWithKey f)
143+insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> AppendMap k a -> (Maybe a, AppendMap k a)
144+insertLookupWithKey f = coerce (Map.insertLookupWithKey f)
146+delete :: forall k a. Ord k => k -> AppendMap k a -> AppendMap k a
147+delete = coerce (Map.delete @k @a)
149+adjust :: Ord k => (a -> a) -> k -> AppendMap k a -> AppendMap k a
150+adjust f = coerce (Map.adjust f)
152+adjustWithKey :: Ord k => (k -> a -> a) -> k -> AppendMap k a -> AppendMap k a
153+adjustWithKey f = coerce (Map.adjustWithKey f)
155+update :: Ord k => (a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
156+update f = coerce (Map.update f)
158+updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
159+updateWithKey f = coerce (Map.updateWithKey f)
161+updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> (Maybe a, AppendMap k a)
162+updateLookupWithKey f = coerce (Map.updateLookupWithKey f)
164+alter :: Ord k => (Maybe a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
165+alter f = coerce (Map.alter f)
167+unionWith :: Ord k => (a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
168+unionWith f = coerce (Map.unionWith f)
170+unionWithKey :: Ord k => (k -> a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
171+unionWithKey f = coerce (Map.unionWithKey f)
173+unionsWith :: Ord k => (a -> a -> a) -> [AppendMap k a] -> AppendMap k a
174+unionsWith f = coerce (Map.unionsWith f)
176+difference :: Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
179+differenceWith :: Ord k => (a -> b -> Maybe a) -> AppendMap k a -> AppendMap k b -> AppendMap k a
180+differenceWith f = coerce (Map.differenceWith f)
182+differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> AppendMap k a -> AppendMap k b -> AppendMap k a
183+differenceWithKey f = coerce (Map.differenceWithKey f)
185+intersectionWith :: Ord k => (a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
186+intersectionWith f = coerce (Map.intersectionWith f)
188+intersectionWithKey :: Ord k => (k -> a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
189+intersectionWithKey f = coerce (Map.intersectionWithKey f)
191+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
192+mergeWithKey f = coerce (Map.mergeWithKey f)
194+map :: (a -> b) -> AppendMap k a -> AppendMap k b
197+mapWithKey :: (k -> a -> b) -> AppendMap k a -> AppendMap k b
200+traverseWithKey :: Applicative t => (k -> a -> t b) -> AppendMap k a -> t (AppendMap k b)
201+traverseWithKey = itraverse
203+mapAccum :: (a -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
204+mapAccum f = coerce (Map.mapAccum f)
206+mapAccumWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
207+mapAccumWithKey f = coerce (Map.mapAccumWithKey f)
209+mapAccumRWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
210+mapAccumRWithKey f = coerce (Map.mapAccumRWithKey f)
212+mapKeys :: forall k1 k2 a. Ord k2 => (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
213+mapKeys = coerce (Map.mapKeys @k2 @k1 @a)
215+mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
216+mapKeysWith f = coerce (Map.mapKeysWith f)
218+mapKeysMonotonic :: forall k1 k2 a. (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
219+mapKeysMonotonic = coerce (Map.mapKeysMonotonic @k1 @k2 @a)
221+foldr :: (a -> b -> b) -> b -> AppendMap k a -> b
222+foldr f = coerce (Map.foldr f)
224+foldl :: (a -> b -> a) -> a -> AppendMap k b -> a
225+foldl f = coerce (Map.foldl f)
227+foldrWithKey :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
228+foldrWithKey f = coerce (Map.foldrWithKey f)
230+foldlWithKey :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
231+foldlWithKey f = coerce (Map.foldlWithKey f)
233+foldMapWithKey :: Monoid m => (k -> a -> m) -> AppendMap k a -> m
234+foldMapWithKey f = coerce (Map.foldMapWithKey f)
236+foldr' :: (a -> b -> b) -> b -> AppendMap k a -> b
237+foldr' f = coerce (Map.foldr' f)
239+foldl' :: (a -> b -> a) -> a -> AppendMap k b -> a
240+foldl' f = coerce (Map.foldl' f)
242+foldrWithKey' :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
243+foldrWithKey' f = coerce (Map.foldrWithKey' f)
245+foldlWithKey' :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
246+foldlWithKey' f = coerce (Map.foldlWithKey' f)
248+elems :: forall k a. AppendMap k a -> [a]
249+elems = coerce (Map.elems @k @a)
251+keys :: forall k a. AppendMap k a -> [k]
252+keys = coerce (Map.keys @k @a)
254+assocs :: forall k a. AppendMap k a -> [(k, a)]
255+assocs = coerce (Map.assocs @k @a)
257+keysSet :: forall k a. AppendMap k a -> Set k
258+keysSet = coerce (Map.keysSet @k @a)
260+fromSet :: (k -> a) -> Set k -> AppendMap k a
261+fromSet f = coerce (Map.fromSet f)
263+toList :: forall k a. AppendMap k a -> [(k, a)]
264+toList = coerce (Map.toList @k @a)
266+fromList :: forall k a. Ord k => [(k, a)] -> AppendMap k a
267+fromList = coerce (Map.fromList @k @a)
269+fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
270+fromListWith f = coerce (Map.fromListWith f)
272+fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
273+fromListWithKey f = coerce (Map.fromListWithKey f)
275+toAscList :: forall k a. AppendMap k a -> [(k, a)]
276+toAscList = coerce (Map.toAscList @k @a)
278+toDescList :: forall k a. AppendMap k a -> [(k, a)]
279+toDescList = coerce (Map.toDescList @k @a)
281+fromAscList :: forall k a. Eq k => [(k, a)] -> AppendMap k a
282+fromAscList = coerce (Map.fromAscList @k @a)
284+fromAscListWith :: Eq k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
285+fromAscListWith f = coerce (Map.fromAscListWith f)
287+fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
288+fromAscListWithKey f = coerce (Map.fromAscListWithKey f)
290+fromDistinctAscList :: forall k a. [(k, a)] -> AppendMap k a
291+fromDistinctAscList = coerce (Map.fromDistinctAscList @k @a)
293+filter :: (a -> Bool) -> AppendMap k a -> AppendMap k a
294+filter f = coerce (Map.filter f)
296+filterWithKey :: (k -> a -> Bool) -> AppendMap k a -> AppendMap k a
297+filterWithKey f = coerce (Map.filterWithKey f)
299+partition :: (a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
300+partition f = coerce (Map.partition f)
302+partitionWithKey :: (k -> a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
303+partitionWithKey f = coerce (Map.partitionWithKey f)
305+mapMaybe :: (a -> Maybe b) -> AppendMap k a -> AppendMap k b
306+mapMaybe f = coerce (Map.mapMaybe f)
308+mapMaybeWithKey :: (k -> a -> Maybe b) -> AppendMap k a -> AppendMap k b
309+mapMaybeWithKey f = coerce (Map.mapMaybeWithKey f)
311+mapEither :: (a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
312+mapEither f = coerce (Map.mapEither f)
314+mapEitherWithKey :: (k -> a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
315+mapEitherWithKey f = coerce (Map.mapEitherWithKey f)
317+split :: forall k a. Ord k => k -> AppendMap k a -> (AppendMap k a, AppendMap k a)
318+split = coerce (Map.split @k @a)
320+splitLookup :: forall k a. Ord k => k -> AppendMap k a -> (AppendMap k a, Maybe a, AppendMap k a)
321+splitLookup = coerce (Map.splitLookup @k @a)
323+splitRoot :: forall k a. AppendMap k a -> [AppendMap k a]
324+splitRoot = coerce (Map.splitRoot @k @a)
326+isSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
327+isSubmapOf = coerce (Map.isSubmapOf @k @a)
329+isSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
330+isSubmapOfBy f = coerce (Map.isSubmapOfBy f)
332+isProperSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
333+isProperSubmapOf = coerce (Map.isProperSubmapOf @k @a)
335+isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
336+isProperSubmapOfBy f = coerce (Map.isProperSubmapOfBy f)
338+lookupIndex :: forall k a. Ord k => k -> AppendMap k a -> Maybe Int
339+lookupIndex = coerce (Map.lookupIndex @k @a)
341+findIndex :: forall k a. Ord k => k -> AppendMap k a -> Int
342+findIndex = coerce (Map.findIndex @k @a)
344+elemAt :: forall k a. Int -> AppendMap k a -> (k, a)
345+elemAt = coerce (Map.elemAt @k @a)
347+updateAt :: forall k a. (k -> a -> Maybe a) -> Int -> AppendMap k a -> AppendMap k a
348+updateAt = coerce (Map.updateAt @k @a)
350+deleteAt :: forall k a. Int -> AppendMap k a -> AppendMap k a
351+deleteAt = coerce (Map.deleteAt @k @a)
353+findMin :: forall k a. AppendMap k a -> (k, a)
354+findMin = coerce (Map.findMin @k @a)
356+findMax :: forall k a. AppendMap k a -> (k, a)
357+findMax = coerce (Map.findMax @k @a)
359+deleteMin :: forall k a. AppendMap k a -> AppendMap k a
360+deleteMin = coerce (Map.deleteMin @k @ a)
362+deleteMax :: forall k a. AppendMap k a -> AppendMap k a
363+deleteMax = coerce (Map.deleteMax @k @a)
365+deleteFindMin :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
366+deleteFindMin = coerce (Map.deleteFindMin @k @a)
368+deleteFindMax :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
369+deleteFindMax = coerce (Map.deleteFindMax @k @a)
371+updateMin :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
372+updateMin f = coerce (Map.updateMin f)
374+updateMax :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
375+updateMax f = coerce (Map.updateMax f)
377+updateMinWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
378+updateMinWithKey f = coerce (Map.updateMinWithKey f)
380+updateMaxWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
381+updateMaxWithKey f = coerce (Map.updateMaxWithKey f)
383+minView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
384+minView = coerce (Map.minView @k @a)
386+maxView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
387+maxView = coerce (Map.maxView @k @a)
389+minViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
390+minViewWithKey = coerce (Map.minViewWithKey @k @a)
392+maxViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
393+maxViewWithKey = coerce (Map.maxViewWithKey @k @a)
395+showTree :: forall k a. (Show k, Show a) => AppendMap k a -> String
396+showTree = coerce (Map.showTree @k @a)
398+showTreeWith :: (k -> a -> String) -> Bool -> Bool -> AppendMap k a -> String
399+showTreeWith f = coerce (Map.showTreeWith f)
401+valid :: forall k a. Ord k => AppendMap k a -> Bool
402+valid = coerce (Map.valid @k @a)
404+instance Default (AppendMap k a) where
407+instance AppendMap k' v' ~ t => Rewrapped (AppendMap k a) t
409+instance Wrapped (AppendMap k a) where
410+ type Unwrapped (AppendMap k a) = Map k a
411+ _Wrapped' = iso (\(AppendMap m) -> m) AppendMap
413+-- | Operator for creating a singleton 'Map'
414+(=:) :: k -> a -> AppendMap k a
415+k =: v = singleton k v