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