@@ -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
13+--
14+-- 'Data.Map' has @mappend = union@, which is left-biased. AppendMap has
15+-- @mappend = unionWith mappend@ instead.
16+module Data.AppendMap where
17+
18+import Prelude hiding (map)
19+
20+import Control.Lens
21+import Data.Align
22+import Data.Coerce
23+import Data.Default
24+import Data.Map (Map)
25+import qualified Data.Map as Map
26+import Data.Semigroup
27+import Data.Set (Set)
28+import Data.Typeable
29+import GHC.Generics (Generic)
30+import Reflex (FunctorMaybe (..))
31+import Reflex.Patch (Additive, Group (..))
32+
33+newtype AppendMap k m = AppendMap { _unAppendMap :: Map k m }
34+ deriving (Eq, Ord, Show, Read, Typeable, Generic, Functor, Foldable, Traversable, Align)
35+
36+type instance (Index (AppendMap k m)) = k
37+type instance (IxValue (AppendMap k m)) = m
38+
39+instance Ord k => Ixed (AppendMap k m) where
40+ ix i = _Wrapped . ix i
41+
42+instance Ord k => At (AppendMap k m) where
43+ at i = _Wrapped . at i
44+
45+instance FunctorMaybe (AppendMap k) where
46+ fmapMaybe = mapMaybe
47+
48+-- | Deletes a key, returning 'Nothing' if the result is empty.
49+nonEmptyDelete :: Ord k => k -> AppendMap k a -> Maybe (AppendMap k a)
50+nonEmptyDelete k vs =
51+ let deleted = delete k vs
52+ in if Data.AppendMap.null deleted
53+ then Nothing
54+ else Just deleted
55+
56+mapMaybeNoNull :: (a -> Maybe b)
57+ -> AppendMap token a
58+ -> Maybe (AppendMap token b)
59+mapMaybeNoNull f as =
60+ let bs = fmapMaybe f as
61+ in if Data.AppendMap.null bs
62+ then Nothing
63+ else Just bs
64+
65+instance FunctorWithIndex k (AppendMap k) where
66+ imap f = AppendMap . imap f . _unAppendMap
67+ imapped = _Wrapped . imapped
68+
69+instance FoldableWithIndex k (AppendMap k) where
70+ ifolded = _Wrapped . ifolded
71+
72+instance TraversableWithIndex k (AppendMap k) where
73+ itraverse = itraverseOf itraversed
74+ itraversed = _Wrapped . itraversed
75+
76+instance (Ord k, Semigroup m) => Semigroup (AppendMap k m) where
77+ (AppendMap m0) <> (AppendMap m1) = AppendMap $ Map.unionWith (<>) m0 m1
78+
79+instance (Ord k, Semigroup m) => Monoid (AppendMap k m) where
80+ mempty = empty
81+ mappend = (<>)
82+
83+instance (Ord k, Group q) => Group (AppendMap k q) where
84+ negateG = map negateG
85+
86+instance (Ord k, Additive q) => Additive (AppendMap k q)
87+
88+(!) :: forall k a. Ord k => AppendMap k a -> k -> a
89+(!) = coerce ((Map.!) @k @a)
90+infixl 9 !
91+
92+(\\) :: forall k a b. Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
93+(\\) = coerce ((Map.\\) @k @a @b)
94+infixl 9 \\
95+
96+null :: forall k a. AppendMap k a -> Bool
97+null = coerce (Map.null @k @a)
98+
99+size :: forall k a. AppendMap k a -> Int
100+size = coerce (Map.size @k @a)
101+
102+member :: forall k a. Ord k => k -> AppendMap k a -> Bool
103+member = coerce (Map.member @k @a)
104+
105+notMember :: forall k a. Ord k => k -> AppendMap k a -> Bool
106+notMember = coerce (Map.notMember @k @a)
107+
108+lookup :: forall k a. Ord k => k -> AppendMap k a -> Maybe a
109+lookup = coerce (Map.lookup @k @a)
110+
111+findWithDefault :: forall k a. Ord k => a -> k -> AppendMap k a -> a
112+findWithDefault = coerce (Map.findWithDefault @k @a)
113+
114+lookupLT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
115+lookupLT = coerce (Map.lookupLT @k @a)
116+
117+lookupGT :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
118+lookupGT = coerce (Map.lookupGT @k @a)
119+
120+lookupLE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
121+lookupLE = coerce (Map.lookupLE @k @a)
122+
123+lookupGE :: forall k a. Ord k => k -> AppendMap k a -> Maybe (k, a)
124+lookupGE = coerce (Map.lookupGE @k @a)
125+
126+empty :: forall k a. AppendMap k a
127+empty = coerce (Map.empty @k @a)
128+
129+singleton :: forall k a. k -> a -> AppendMap k a
130+singleton = coerce (Map.singleton @k @a)
131+
132+insert :: forall k a. Ord k => k -> a -> AppendMap k a -> AppendMap k a
133+insert = coerce (Map.insert @k @a)
134+
135+insertWith :: Ord k => (a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
136+insertWith f = coerce (Map.insertWith f)
137+
138+insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> AppendMap k a -> AppendMap k a
139+insertWithKey f = coerce (Map.insertWithKey f)
140+
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)
143+
144+delete :: forall k a. Ord k => k -> AppendMap k a -> AppendMap k a
145+delete = coerce (Map.delete @k @a)
146+
147+adjust :: Ord k => (a -> a) -> k -> AppendMap k a -> AppendMap k a
148+adjust f = coerce (Map.adjust f)
149+
150+adjustWithKey :: Ord k => (k -> a -> a) -> k -> AppendMap k a -> AppendMap k a
151+adjustWithKey f = coerce (Map.adjustWithKey f)
152+
153+update :: Ord k => (a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
154+update f = coerce (Map.update f)
155+
156+updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
157+updateWithKey f = coerce (Map.updateWithKey f)
158+
159+updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> AppendMap k a -> (Maybe a, AppendMap k a)
160+updateLookupWithKey f = coerce (Map.updateLookupWithKey f)
161+
162+alter :: Ord k => (Maybe a -> Maybe a) -> k -> AppendMap k a -> AppendMap k a
163+alter f = coerce (Map.alter f)
164+
165+unionWith :: Ord k => (a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
166+unionWith f = coerce (Map.unionWith f)
167+
168+unionWithKey :: Ord k => (k -> a -> a -> a) -> AppendMap k a -> AppendMap k a -> AppendMap k a
169+unionWithKey f = coerce (Map.unionWithKey f)
170+
171+unionsWith :: Ord k => (a -> a -> a) -> [AppendMap k a] -> AppendMap k a
172+unionsWith f = coerce (Map.unionsWith f)
173+
174+difference :: Ord k => AppendMap k a -> AppendMap k b -> AppendMap k a
175+difference = (\\)
176+
177+differenceWith :: Ord k => (a -> b -> Maybe a) -> AppendMap k a -> AppendMap k b -> AppendMap k a
178+differenceWith f = coerce (Map.differenceWith f)
179+
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)
182+
183+intersectionWith :: Ord k => (a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
184+intersectionWith f = coerce (Map.intersectionWith f)
185+
186+intersectionWithKey :: Ord k => (k -> a -> b -> c) -> AppendMap k a -> AppendMap k b -> AppendMap k c
187+intersectionWithKey f = coerce (Map.intersectionWithKey f)
188+
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)
191+
192+map :: (a -> b) -> AppendMap k a -> AppendMap k b
193+map = fmap
194+
195+mapWithKey :: (k -> a -> b) -> AppendMap k a -> AppendMap k b
196+mapWithKey = imap
197+
198+traverseWithKey :: Applicative t => (k -> a -> t b) -> AppendMap k a -> t (AppendMap k b)
199+traverseWithKey = itraverse
200+
201+mapAccum :: (a -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
202+mapAccum f = coerce (Map.mapAccum f)
203+
204+mapAccumWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
205+mapAccumWithKey f = coerce (Map.mapAccumWithKey f)
206+
207+mapAccumRWithKey :: (a -> k -> b -> (a, c)) -> a -> AppendMap k b -> (a, AppendMap k c)
208+mapAccumRWithKey f = coerce (Map.mapAccumRWithKey f)
209+
210+mapKeys :: forall k1 k2 a. Ord k2 => (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
211+mapKeys = coerce (Map.mapKeys @k2 @k1 @a)
212+
213+mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
214+mapKeysWith f = coerce (Map.mapKeysWith f)
215+
216+mapKeysMonotonic :: forall k1 k2 a. (k1 -> k2) -> AppendMap k1 a -> AppendMap k2 a
217+mapKeysMonotonic = coerce (Map.mapKeysMonotonic @k1 @k2 @a)
218+
219+foldr :: (a -> b -> b) -> b -> AppendMap k a -> b
220+foldr f = coerce (Map.foldr f)
221+
222+foldl :: (a -> b -> a) -> a -> AppendMap k b -> a
223+foldl f = coerce (Map.foldl f)
224+
225+foldrWithKey :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
226+foldrWithKey f = coerce (Map.foldrWithKey f)
227+
228+foldlWithKey :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
229+foldlWithKey f = coerce (Map.foldlWithKey f)
230+
231+foldMapWithKey :: Monoid m => (k -> a -> m) -> AppendMap k a -> m
232+foldMapWithKey f = coerce (Map.foldMapWithKey f)
233+
234+foldr' :: (a -> b -> b) -> b -> AppendMap k a -> b
235+foldr' f = coerce (Map.foldr' f)
236+
237+foldl' :: (a -> b -> a) -> a -> AppendMap k b -> a
238+foldl' f = coerce (Map.foldl' f)
239+
240+foldrWithKey' :: (k -> a -> b -> b) -> b -> AppendMap k a -> b
241+foldrWithKey' f = coerce (Map.foldrWithKey' f)
242+
243+foldlWithKey' :: (a -> k -> b -> a) -> a -> AppendMap k b -> a
244+foldlWithKey' f = coerce (Map.foldlWithKey' f)
245+
246+elems :: forall k a. AppendMap k a -> [a]
247+elems = coerce (Map.elems @k @a)
248+
249+keys :: forall k a. AppendMap k a -> [k]
250+keys = coerce (Map.keys @k @a)
251+
252+assocs :: forall k a. AppendMap k a -> [(k, a)]
253+assocs = coerce (Map.assocs @k @a)
254+
255+keysSet :: forall k a. AppendMap k a -> Set k
256+keysSet = coerce (Map.keysSet @k @a)
257+
258+fromSet :: (k -> a) -> Set k -> AppendMap k a
259+fromSet f = coerce (Map.fromSet f)
260+
261+toList :: forall k a. AppendMap k a -> [(k, a)]
262+toList = coerce (Map.toList @k @a)
263+
264+fromList :: forall k a. Ord k => [(k, a)] -> AppendMap k a
265+fromList = coerce (Map.fromList @k @a)
266+
267+fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
268+fromListWith f = coerce (Map.fromListWith f)
269+
270+fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
271+fromListWithKey f = coerce (Map.fromListWithKey f)
272+
273+toAscList :: forall k a. AppendMap k a -> [(k, a)]
274+toAscList = coerce (Map.toAscList @k @a)
275+
276+toDescList :: forall k a. AppendMap k a -> [(k, a)]
277+toDescList = coerce (Map.toDescList @k @a)
278+
279+fromAscList :: forall k a. Eq k => [(k, a)] -> AppendMap k a
280+fromAscList = coerce (Map.fromAscList @k @a)
281+
282+fromAscListWith :: Eq k => (a -> a -> a) -> [(k, a)] -> AppendMap k a
283+fromAscListWith f = coerce (Map.fromAscListWith f)
284+
285+fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k, a)] -> AppendMap k a
286+fromAscListWithKey f = coerce (Map.fromAscListWithKey f)
287+
288+fromDistinctAscList :: forall k a. [(k, a)] -> AppendMap k a
289+fromDistinctAscList = coerce (Map.fromDistinctAscList @k @a)
290+
291+filter :: (a -> Bool) -> AppendMap k a -> AppendMap k a
292+filter f = coerce (Map.filter f)
293+
294+filterWithKey :: (k -> a -> Bool) -> AppendMap k a -> AppendMap k a
295+filterWithKey f = coerce (Map.filterWithKey f)
296+
297+partition :: (a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
298+partition f = coerce (Map.partition f)
299+
300+partitionWithKey :: (k -> a -> Bool) -> AppendMap k a -> (AppendMap k a, AppendMap k a)
301+partitionWithKey f = coerce (Map.partitionWithKey f)
302+
303+mapMaybe :: (a -> Maybe b) -> AppendMap k a -> AppendMap k b
304+mapMaybe f = coerce (Map.mapMaybe f)
305+
306+mapMaybeWithKey :: (k -> a -> Maybe b) -> AppendMap k a -> AppendMap k b
307+mapMaybeWithKey f = coerce (Map.mapMaybeWithKey f)
308+
309+mapEither :: (a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
310+mapEither f = coerce (Map.mapEither f)
311+
312+mapEitherWithKey :: (k -> a -> Either b c) -> AppendMap k a -> (AppendMap k b, AppendMap k c)
313+mapEitherWithKey f = coerce (Map.mapEitherWithKey f)
314+
315+split :: forall k a. Ord k => k -> AppendMap k a -> (AppendMap k a, AppendMap k a)
316+split = coerce (Map.split @k @a)
317+
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)
320+
321+splitRoot :: forall k a. AppendMap k a -> [AppendMap k a]
322+splitRoot = coerce (Map.splitRoot @k @a)
323+
324+isSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
325+isSubmapOf = coerce (Map.isSubmapOf @k @a)
326+
327+isSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
328+isSubmapOfBy f = coerce (Map.isSubmapOfBy f)
329+
330+isProperSubmapOf :: forall k a. (Ord k, Eq a) => AppendMap k a -> AppendMap k a -> Bool
331+isProperSubmapOf = coerce (Map.isProperSubmapOf @k @a)
332+
333+isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> AppendMap k a -> AppendMap k b -> Bool
334+isProperSubmapOfBy f = coerce (Map.isProperSubmapOfBy f)
335+
336+lookupIndex :: forall k a. Ord k => k -> AppendMap k a -> Maybe Int
337+lookupIndex = coerce (Map.lookupIndex @k @a)
338+
339+findIndex :: forall k a. Ord k => k -> AppendMap k a -> Int
340+findIndex = coerce (Map.findIndex @k @a)
341+
342+elemAt :: forall k a. Int -> AppendMap k a -> (k, a)
343+elemAt = coerce (Map.elemAt @k @a)
344+
345+updateAt :: forall k a. (k -> a -> Maybe a) -> Int -> AppendMap k a -> AppendMap k a
346+updateAt = coerce (Map.updateAt @k @a)
347+
348+deleteAt :: forall k a. Int -> AppendMap k a -> AppendMap k a
349+deleteAt = coerce (Map.deleteAt @k @a)
350+
351+findMin :: forall k a. AppendMap k a -> (k, a)
352+findMin = coerce (Map.findMin @k @a)
353+
354+findMax :: forall k a. AppendMap k a -> (k, a)
355+findMax = coerce (Map.findMax @k @a)
356+
357+deleteMin :: forall k a. AppendMap k a -> AppendMap k a
358+deleteMin = coerce (Map.deleteMin @k @ a)
359+
360+deleteMax :: forall k a. AppendMap k a -> AppendMap k a
361+deleteMax = coerce (Map.deleteMax @k @a)
362+
363+deleteFindMin :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
364+deleteFindMin = coerce (Map.deleteFindMin @k @a)
365+
366+deleteFindMax :: forall k a. AppendMap k a -> ((k, a), AppendMap k a)
367+deleteFindMax = coerce (Map.deleteFindMax @k @a)
368+
369+updateMin :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
370+updateMin f = coerce (Map.updateMin f)
371+
372+updateMax :: (a -> Maybe a) -> AppendMap k a -> AppendMap k a
373+updateMax f = coerce (Map.updateMax f)
374+
375+updateMinWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
376+updateMinWithKey f = coerce (Map.updateMinWithKey f)
377+
378+updateMaxWithKey :: (k -> a -> Maybe a) -> AppendMap k a -> AppendMap k a
379+updateMaxWithKey f = coerce (Map.updateMaxWithKey f)
380+
381+minView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
382+minView = coerce (Map.minView @k @a)
383+
384+maxView :: forall k a. AppendMap k a -> Maybe (a, AppendMap k a)
385+maxView = coerce (Map.maxView @k @a)
386+
387+minViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
388+minViewWithKey = coerce (Map.minViewWithKey @k @a)
389+
390+maxViewWithKey :: forall k a. AppendMap k a -> Maybe ((k, a), AppendMap k a)
391+maxViewWithKey = coerce (Map.maxViewWithKey @k @a)
392+
393+showTree :: forall k a. (Show k, Show a) => AppendMap k a -> String
394+showTree = coerce (Map.showTree @k @a)
395+
396+showTreeWith :: (k -> a -> String) -> Bool -> Bool -> AppendMap k a -> String
397+showTreeWith f = coerce (Map.showTreeWith f)
398+
399+valid :: forall k a. Ord k => AppendMap k a -> Bool
400+valid = coerce (Map.valid @k @a)
401+
402+instance Default (AppendMap k a) where
403+ def = empty
404+
405+instance AppendMap k' v' ~ t => Rewrapped (AppendMap k a) t
406+
407+instance Wrapped (AppendMap k a) where
408+ type Unwrapped (AppendMap k a) = Map k a
409+ _Wrapped' = iso (\(AppendMap m) -> m) AppendMap