1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE CPP #-}
7-- | Warning: This module should be considered highly experimental.
8module Data.Containers where
9
10import Prelude hiding (lookup)
11import Data.Maybe (fromMaybe)
12#if MIN_VERSION_containers(0, 5, 0)
13import qualified Data.Map.Strict as Map
14import qualified Data.IntMap.Strict as IntMap
15#else
16import qualified Data.Map as Map
17import qualified Data.IntMap as IntMap
18#endif
19import qualified Data.HashMap.Strict as HashMap
20import Data.Hashable (Hashable)
21import qualified Data.Set as Set
22import qualified Data.HashSet as HashSet
23import Data.Monoid (Monoid (..))
24import Data.Semigroup (Semigroup)
25import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element, GrowingAppend, ofoldl', otoList)
26import Data.Function (on)
27import qualified Data.List as List
28import qualified Data.IntSet as IntSet
29
30import qualified Data.Text.Lazy as LText
31import qualified Data.Text as Text
32import qualified Data.ByteString.Lazy as LByteString
33import qualified Data.ByteString as ByteString
34import Control.Arrow ((***))
35import GHC.Exts (Constraint)
36
37-- | A container whose values are stored in Key-Value pairs.
38class (Data.Monoid.Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where
39    -- | The type of the key
40    type ContainerKey set
41
42    -- | Check if there is a value with the supplied key
43    -- in the container.
44    member :: ContainerKey set -> set -> Bool
45
46    -- | Check if there isn't a value with the supplied key
47    -- in the container.
48    notMember ::  ContainerKey set -> set -> Bool
49
50    -- | Get the union of two containers.
51    union :: set -> set -> set
52
53    -- | Combine a collection of @SetContainer@s, with left-most values overriding
54    -- when there are matching keys.
55    --
56    -- @since 1.0.0
57    unions :: (MonoFoldable mono, Element mono ~ set) => mono -> set
58    unions = ofoldl' union Data.Monoid.mempty
59    {-# INLINE unions #-}
60
61    -- | Get the difference of two containers.
62    difference :: set -> set -> set
63
64    -- | Get the intersection of two containers.
65    intersection :: set -> set -> set
66
67    -- | Get a list of all of the keys in the container.
68    keys :: set -> [ContainerKey set]
69
70#if MIN_VERSION_containers(0, 5, 0)
71-- | This instance uses the functions from "Data.Map.Strict".
72#endif
73instance Ord k => SetContainer (Map.Map k v) where
74    type ContainerKey (Map.Map k v) = k
75    member = Map.member
76    {-# INLINE member #-}
77    notMember = Map.notMember
78    {-# INLINE notMember #-}
79    union = Map.union
80    {-# INLINE union #-}
81    unions = Map.unions . otoList
82    {-# INLINE unions #-}
83    difference = Map.difference
84    {-# INLINE difference #-}
85    intersection = Map.intersection
86    {-# INLINE intersection #-}
87    keys = Map.keys
88    {-# INLINE keys #-}
89
90#if MIN_VERSION_containers(0, 5, 0)
91-- | This instance uses the functions from "Data.HashMap.Strict".
92#endif
93instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where
94    type ContainerKey (HashMap.HashMap key value) = key
95    member = HashMap.member
96    {-# INLINE member #-}
97    notMember k = not . HashMap.member k
98    {-# INLINE notMember #-}
99    union = HashMap.union
100    {-# INLINE union #-}
101    unions = HashMap.unions . otoList
102    {-# INLINE unions #-}
103    difference = HashMap.difference
104    {-# INLINE difference #-}
105    intersection = HashMap.intersection
106    {-# INLINE intersection #-}
107    keys = HashMap.keys
108    {-# INLINE keys #-}
109
110#if MIN_VERSION_containers(0, 5, 0)
111-- | This instance uses the functions from "Data.IntMap.Strict".
112#endif
113instance SetContainer (IntMap.IntMap value) where
114    type ContainerKey (IntMap.IntMap value) = Int
115    member = IntMap.member
116    {-# INLINE member #-}
117    notMember = IntMap.notMember
118    {-# INLINE notMember #-}
119    union = IntMap.union
120    {-# INLINE union #-}
121    unions = IntMap.unions . otoList
122    {-# INLINE unions #-}
123    difference = IntMap.difference
124    {-# INLINE difference #-}
125    intersection = IntMap.intersection
126    {-# INLINE intersection #-}
127    keys = IntMap.keys
128    {-# INLINE keys #-}
129
130instance Ord element => SetContainer (Set.Set element) where
131    type ContainerKey (Set.Set element) = element
132    member = Set.member
133    {-# INLINE member #-}
134    notMember = Set.notMember
135    {-# INLINE notMember #-}
136    union = Set.union
137    {-# INLINE union #-}
138    unions = Set.unions . otoList
139    {-# INLINE unions #-}
140    difference = Set.difference
141    {-# INLINE difference #-}
142    intersection = Set.intersection
143    {-# INLINE intersection #-}
144    keys = Set.toList
145    {-# INLINE keys #-}
146
147instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where
148    type ContainerKey (HashSet.HashSet element) = element
149    member = HashSet.member
150    {-# INLINE member #-}
151    notMember e = not . HashSet.member e
152    {-# INLINE notMember #-}
153    union = HashSet.union
154    {-# INLINE union #-}
155    difference = HashSet.difference
156    {-# INLINE difference #-}
157    intersection = HashSet.intersection
158    {-# INLINE intersection #-}
159    keys = HashSet.toList
160    {-# INLINE keys #-}
161
162instance SetContainer IntSet.IntSet where
163    type ContainerKey IntSet.IntSet = Int
164    member = IntSet.member
165    {-# INLINE member #-}
166    notMember = IntSet.notMember
167    {-# INLINE notMember #-}
168    union = IntSet.union
169    {-# INLINE union #-}
170    difference = IntSet.difference
171    {-# INLINE difference #-}
172    intersection = IntSet.intersection
173    {-# INLINE intersection #-}
174    keys = IntSet.toList
175    {-# INLINE keys #-}
176
177instance Eq key => SetContainer [(key, value)] where
178    type ContainerKey [(key, value)] = key
179    member k = List.any ((== k) . fst)
180    {-# INLINE member #-}
181    notMember k = not . member k
182    {-# INLINE notMember #-}
183    union = List.unionBy ((==) `on` fst)
184    {-# INLINE union #-}
185    x `difference` y =
186        loop x
187      where
188        loop [] = []
189        loop ((k, v):rest) =
190            case lookup k y of
191                Nothing -> (k, v) : loop rest
192                Just _ -> loop rest
193    intersection = List.intersectBy ((==) `on` fst)
194    {-# INLINE intersection #-}
195    keys = map fst
196    {-# INLINE keys #-}
197
198-- | A guaranteed-polymorphic @Map@, which allows for more polymorphic versions
199-- of functions.
200class PolyMap map where
201    -- | Get the difference between two maps, using the left map's values.
202    differenceMap :: map value1 -> map value2 -> map value1
203    {-
204    differenceWithMap :: (value1 -> value2 -> Maybe value1)
205                      -> map value1 -> map value2 -> map value1
206    -}
207
208    -- | Get the intersection of two maps, using the left map's values.
209    intersectionMap :: map value1 -> map value2 -> map value1
210
211    -- | Get the intersection of two maps with a supplied function
212    -- that takes in the left map's value and the right map's value.
213    intersectionWithMap :: (value1 -> value2 -> value3)
214                        -> map value1 -> map value2 -> map value3
215
216#if MIN_VERSION_containers(0, 5, 0)
217-- | This instance uses the functions from "Data.Map.Strict".
218#endif
219instance Ord key => PolyMap (Map.Map key) where
220    differenceMap = Map.difference
221    {-# INLINE differenceMap #-}
222    --differenceWithMap = Map.differenceWith
223    intersectionMap = Map.intersection
224    {-# INLINE intersectionMap #-}
225    intersectionWithMap = Map.intersectionWith
226    {-# INLINE intersectionWithMap #-}
227
228#if MIN_VERSION_containers(0, 5, 0)
229-- | This instance uses the functions from "Data.HashMap.Strict".
230#endif
231instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where
232    differenceMap = HashMap.difference
233    {-# INLINE differenceMap #-}
234    --differenceWithMap = HashMap.differenceWith
235    intersectionMap = HashMap.intersection
236    {-# INLINE intersectionMap #-}
237    intersectionWithMap = HashMap.intersectionWith
238    {-# INLINE intersectionWithMap #-}
239
240#if MIN_VERSION_containers(0, 5, 0)
241-- | This instance uses the functions from "Data.IntMap.Strict".
242#endif
243instance PolyMap IntMap.IntMap where
244    differenceMap = IntMap.difference
245    {-# INLINE differenceMap #-}
246    --differenceWithMap = IntMap.differenceWith
247    intersectionMap = IntMap.intersection
248    {-# INLINE intersectionMap #-}
249    intersectionWithMap = IntMap.intersectionWith
250    {-# INLINE intersectionWithMap #-}
251
252-- | A @Map@ type polymorphic in both its key and value.
253class BiPolyMap map where
254    type BPMKeyConstraint map key :: Constraint
255    mapKeysWith :: (BPMKeyConstraint map k1, BPMKeyConstraint map k2)
256                => (v -> v -> v) -- ^ combine values that now overlap
257                -> (k1 -> k2)
258                -> map k1 v
259                -> map k2 v
260instance BiPolyMap Map.Map where
261    type BPMKeyConstraint Map.Map key = Ord key
262    mapKeysWith = Map.mapKeysWith
263    {-# INLINE mapKeysWith #-}
264instance BiPolyMap HashMap.HashMap where
265    type BPMKeyConstraint HashMap.HashMap key = (Hashable key, Eq key)
266    mapKeysWith g f =
267        mapFromList . unionsWith g . map go . mapToList
268      where
269        go (k, v) = [(f k, v)]
270    {-# INLINE mapKeysWith #-}
271
272-- | Polymorphic typeclass for interacting with different map types
273class (MonoTraversable map, SetContainer map) => IsMap map where
274    -- | In some cases, 'MapValue' and 'Element' will be different, e.g., the
275    -- 'IsMap' instance of associated lists.
276    type MapValue map
277
278    -- | Look up a value in a map with a specified key.
279    lookup       :: ContainerKey map -> map -> Maybe (MapValue map)
280
281    -- | Insert a key-value pair into a map.
282    insertMap    :: ContainerKey map -> MapValue map -> map -> map
283
284    -- | Delete a key-value pair of a map using a specified key.
285    deleteMap    :: ContainerKey map -> map -> map
286
287    -- | Create a map from a single key-value pair.
288    singletonMap :: ContainerKey map -> MapValue map -> map
289
290    -- | Convert a list of key-value pairs to a map
291    mapFromList  :: [(ContainerKey map, MapValue map)] -> map
292
293    -- | Convert a map to a list of key-value pairs.
294    mapToList    :: map -> [(ContainerKey map, MapValue map)]
295
296    -- | Like 'lookup', but uses a default value when the key does
297    -- not exist in the map.
298    findWithDefault :: MapValue map -> ContainerKey map -> map -> MapValue map
299    findWithDefault def key = fromMaybe def . lookup key
300
301    -- | Insert a key-value pair into a map.
302    --
303    -- Inserts the value directly if the key does not exist in the map. Otherwise,
304    -- apply a supplied function that accepts the new value and the previous value
305    -- and insert that result into the map.
306    insertWith :: (MapValue map -> MapValue map -> MapValue map)
307                  -- ^ function that accepts the new value and the
308                  -- previous value and returns the value that will be
309                  -- set in the map.
310               -> ContainerKey map -- ^ key
311               -> MapValue map     -- ^ new value to insert
312               -> map              -- ^ input map
313               -> map              -- ^ resulting map
314    insertWith f k v m =
315        v' `seq` insertMap k v' m
316      where
317        v' =
318            case lookup k m of
319                Nothing -> v
320                Just vold -> f v vold
321
322    -- | Insert a key-value pair into a map.
323    --
324    -- Inserts the value directly if the key does not exist in the map. Otherwise,
325    -- apply a supplied function that accepts the key, the new value, and the
326    -- previous value and insert that result into the map.
327    insertWithKey
328        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
329           -- ^ function that accepts the key, the new value, and the
330           -- previous value and returns the value that will be
331           -- set in the map.
332        -> ContainerKey map -- ^ key
333        -> MapValue map     -- ^ new value to insert
334        -> map              -- ^ input map
335        -> map              -- ^ resulting map
336    insertWithKey f k v m =
337        v' `seq` insertMap k v' m
338      where
339        v' =
340            case lookup k m of
341                Nothing -> v
342                Just vold -> f k v vold
343
344    -- | Insert a key-value pair into a map, return the previous key's value
345    -- if it existed.
346    --
347    -- Inserts the value directly if the key does not exist in the map. Otherwise,
348    -- apply a supplied function that accepts the key, the new value, and the
349    -- previous value and insert that result into the map.
350    insertLookupWithKey
351        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
352           -- ^ function that accepts the key, the new value, and the
353           -- previous value and returns the value that will be
354           -- set in the map.
355        -> ContainerKey map            -- ^ key
356        -> MapValue map                -- ^ new value to insert
357        -> map                         -- ^ input map
358        -> (Maybe (MapValue map), map) -- ^ previous value and the resulting map
359    insertLookupWithKey f k v m =
360        v' `seq` (mold, insertMap k v' m)
361      where
362        (mold, v') =
363            case lookup k m of
364                Nothing -> (Nothing, v)
365                Just vold -> (Just vold, f k v vold)
366
367    -- | Apply a function to the value of a given key.
368    --
369    -- Returns the input map when the key-value pair does not exist.
370    adjustMap
371        :: (MapValue map -> MapValue map)
372           -- ^ function to apply to the previous value
373        -> ContainerKey map -- ^ key
374        -> map              -- ^ input map
375        -> map              -- ^ resulting map
376    adjustMap f k m =
377        case lookup k m of
378            Nothing -> m
379            Just v ->
380                let v' = f v
381                 in v' `seq` insertMap k v' m
382
383    -- | Equivalent to 'adjustMap', but the function accepts the key,
384    -- as well as the previous value.
385    adjustWithKey
386        :: (ContainerKey map -> MapValue map -> MapValue map)
387           -- ^ function that accepts the key and the previous value
388           -- and returns the new value
389        -> ContainerKey map -- ^ key
390        -> map              -- ^ input map
391        -> map              -- ^ resulting map
392    adjustWithKey f k m =
393        case lookup k m of
394            Nothing -> m
395            Just v ->
396                let v' = f k v
397                 in v' `seq` insertMap k v' m
398
399    -- | Apply a function to the value of a given key.
400    --
401    -- If the function returns 'Nothing', this deletes the key-value pair.
402    --
403    -- Returns the input map when the key-value pair does not exist.
404    updateMap
405        :: (MapValue map -> Maybe (MapValue map))
406           -- ^ function that accepts the previous value
407           -- and returns the new value or 'Nothing'
408        -> ContainerKey map -- ^ key
409        -> map              -- ^ input map
410        -> map              -- ^ resulting map
411    updateMap f k m =
412        case lookup k m of
413            Nothing -> m
414            Just v ->
415                case f v of
416                    Nothing -> deleteMap k m
417                    Just v' -> v' `seq` insertMap k v' m
418
419    -- | Equivalent to 'updateMap', but the function accepts the key,
420    -- as well as the previous value.
421    updateWithKey
422        :: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
423           -- ^ function that accepts the key and the previous value
424           -- and returns the new value or 'Nothing'
425        -> ContainerKey map -- ^ key
426        -> map              -- ^ input map
427        -> map              -- ^ resulting map
428    updateWithKey f k m =
429        case lookup k m of
430            Nothing -> m
431            Just v ->
432                case f k v of
433                    Nothing -> deleteMap k m
434                    Just v' -> v' `seq` insertMap k v' m
435
436    -- | Apply a function to the value of a given key.
437    --
438    -- If the map does not contain the key this returns 'Nothing'
439    -- and the input map.
440    --
441    -- If the map does contain the key but the function returns 'Nothing',
442    -- this returns the previous value and the map with the key-value pair removed.
443    --
444    -- If the map contains the key and the function returns a value,
445    -- this returns the new value and the map with the key-value pair with the new value.
446    updateLookupWithKey
447        :: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
448           -- ^ function that accepts the key and the previous value
449           -- and returns the new value or 'Nothing'
450        -> ContainerKey map            -- ^ key
451        -> map                         -- ^ input map
452        -> (Maybe (MapValue map), map) -- ^ previous/new value and the resulting map
453    updateLookupWithKey f k m =
454        case lookup k m of
455            Nothing -> (Nothing, m)
456            Just v ->
457                case f k v of
458                    Nothing -> (Just v, deleteMap k m)
459                    Just v' -> v' `seq` (Just v', insertMap k v' m)
460
461    -- | Update/Delete the value of a given key.
462    --
463    -- Applies a function to previous value of a given key, if it results in 'Nothing'
464    -- delete the key-value pair from the map, otherwise replace the previous value
465    -- with the new value.
466    alterMap
467        :: (Maybe (MapValue map) -> Maybe (MapValue map))
468           -- ^ function that accepts the previous value and
469           -- returns the new value or 'Nothing'
470        -> ContainerKey map -- ^ key
471        -> map              -- ^ input map
472        -> map              -- ^ resulting map
473    alterMap f k m =
474        case f mold of
475            Nothing ->
476                case mold of
477                    Nothing -> m
478                    Just _ -> deleteMap k m
479            Just v -> insertMap k v m
480      where
481        mold = lookup k m
482
483    -- | Combine two maps.
484    --
485    -- When a key exists in both maps, apply a function
486    -- to both of the values and use the result of that as the value
487    -- of the key in the resulting map.
488    unionWith
489        :: (MapValue map -> MapValue map -> MapValue map)
490           -- ^ function that accepts the first map's value and the second map's value
491           -- and returns the new value that will be used
492        -> map -- ^ first map
493        -> map -- ^ second map
494        -> map -- ^ resulting map
495    unionWith f x y =
496        mapFromList $ loop $ mapToList x ++ mapToList y
497      where
498        loop [] = []
499        loop ((k, v):rest) =
500            case List.lookup k rest of
501                Nothing -> (k, v) : loop rest
502                Just v' -> (k, f v v') : loop (deleteMap k rest)
503
504    -- Equivalent to 'unionWith', but the function accepts the key,
505    -- as well as both of the map's values.
506    unionWithKey
507        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
508           -- ^ function that accepts the key, the first map's value and the
509           -- second map's value and returns the new value that will be used
510        -> map -- ^ first map
511        -> map -- ^ second map
512        -> map -- ^ resulting map
513    unionWithKey f x y =
514        mapFromList $ loop $ mapToList x ++ mapToList y
515      where
516        loop [] = []
517        loop ((k, v):rest) =
518            case List.lookup k rest of
519                Nothing -> (k, v) : loop rest
520                Just v' -> (k, f k v v') : loop (deleteMap k rest)
521
522    -- | Combine a list of maps.
523    --
524    -- When a key exists in two different maps, apply a function
525    -- to both of the values and use the result of that as the value
526    -- of the key in the resulting map.
527    unionsWith
528        :: (MapValue map -> MapValue map -> MapValue map)
529           -- ^ function that accepts the first map's value and the second map's value
530           -- and returns the new value that will be used
531        -> [map] -- ^ input list of maps
532        -> map   -- ^ resulting map
533    unionsWith _ [] = mempty
534    unionsWith _ [x] = x
535    unionsWith f (x:y:z) = unionsWith f (unionWith f x y:z)
536
537    -- | Apply a function over every key-value pair of a map.
538    mapWithKey
539        :: (ContainerKey map -> MapValue map -> MapValue map)
540           -- ^ function that accepts the key and the previous value
541           -- and returns the new value
542        -> map -- ^ input map
543        -> map -- ^ resulting map
544    mapWithKey f =
545        mapFromList . map go . mapToList
546      where
547        go (k, v) = (k, f k v)
548
549    -- | Apply a function over every key of a pair and run
550    -- 'unionsWith' over the results.
551    omapKeysWith
552        :: (MapValue map -> MapValue map -> MapValue map)
553           -- ^ function that accepts the first map's value and the second map's value
554           -- and returns the new value that will be used
555        -> (ContainerKey map -> ContainerKey map)
556           -- ^ function that accepts the previous key and
557           -- returns the new key
558        -> map -- ^ input map
559        -> map -- ^ resulting map
560    omapKeysWith g f =
561        mapFromList . unionsWith g . map go . mapToList
562      where
563        go (k, v) = [(f k, v)]
564
565    -- | Filter values in a map.
566    --
567    -- @since 1.0.9.0
568    filterMap :: IsMap map => (MapValue map -> Bool) -> map -> map
569    filterMap p = mapFromList . filter (p . snd) . mapToList
570
571#if MIN_VERSION_containers(0, 5, 0)
572-- | This instance uses the functions from "Data.Map.Strict".
573#endif
574instance Ord key => IsMap (Map.Map key value) where
575    type MapValue (Map.Map key value) = value
576    lookup = Map.lookup
577    {-# INLINE lookup #-}
578    insertMap = Map.insert
579    {-# INLINE insertMap #-}
580    deleteMap = Map.delete
581    {-# INLINE deleteMap #-}
582    singletonMap = Map.singleton
583    {-# INLINE singletonMap #-}
584    mapFromList = Map.fromList
585    {-# INLINE mapFromList #-}
586    mapToList = Map.toList
587    {-# INLINE mapToList #-}
588
589    findWithDefault = Map.findWithDefault
590    {-# INLINE findWithDefault #-}
591    insertWith = Map.insertWith
592    {-# INLINE insertWith #-}
593    insertWithKey = Map.insertWithKey
594    {-# INLINE insertWithKey #-}
595    insertLookupWithKey = Map.insertLookupWithKey
596    {-# INLINE insertLookupWithKey #-}
597    adjustMap = Map.adjust
598    {-# INLINE adjustMap #-}
599    adjustWithKey = Map.adjustWithKey
600    {-# INLINE adjustWithKey #-}
601    updateMap = Map.update
602    {-# INLINE updateMap #-}
603    updateWithKey = Map.updateWithKey
604    {-# INLINE updateWithKey #-}
605    updateLookupWithKey = Map.updateLookupWithKey
606    {-# INLINE updateLookupWithKey #-}
607    alterMap = Map.alter
608    {-# INLINE alterMap #-}
609    unionWith = Map.unionWith
610    {-# INLINE unionWith #-}
611    unionWithKey = Map.unionWithKey
612    {-# INLINE unionWithKey #-}
613    unionsWith = Map.unionsWith
614    {-# INLINE unionsWith #-}
615    mapWithKey = Map.mapWithKey
616    {-# INLINE mapWithKey #-}
617    omapKeysWith = Map.mapKeysWith
618    {-# INLINE omapKeysWith #-}
619    filterMap = Map.filter
620    {-# INLINE filterMap #-}
621
622#if MIN_VERSION_containers(0, 5, 0)
623-- | This instance uses the functions from "Data.HashMap.Strict".
624#endif
625instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where
626    type MapValue (HashMap.HashMap key value) = value
627    lookup = HashMap.lookup
628    {-# INLINE lookup #-}
629    insertMap = HashMap.insert
630    {-# INLINE insertMap #-}
631    deleteMap = HashMap.delete
632    {-# INLINE deleteMap #-}
633    singletonMap = HashMap.singleton
634    {-# INLINE singletonMap #-}
635    mapFromList = HashMap.fromList
636    {-# INLINE mapFromList #-}
637    mapToList = HashMap.toList
638    {-# INLINE mapToList #-}
639
640    --findWithDefault = HashMap.findWithDefault
641    insertWith = HashMap.insertWith
642    {-# INLINE insertWith #-}
643    --insertWithKey = HashMap.insertWithKey
644    --insertLookupWithKey = HashMap.insertLookupWithKey
645    adjustMap = HashMap.adjust
646    {-# INLINE adjustMap #-}
647    --adjustWithKey = HashMap.adjustWithKey
648    --updateMap = HashMap.update
649    --updateWithKey = HashMap.updateWithKey
650    --updateLookupWithKey = HashMap.updateLookupWithKey
651    --alterMap = HashMap.alter
652    unionWith = HashMap.unionWith
653    {-# INLINE unionWith #-}
654    --unionWithKey = HashMap.unionWithKey
655    --unionsWith = HashMap.unionsWith
656    --mapWithKey = HashMap.mapWithKey
657    --mapKeysWith = HashMap.mapKeysWith
658    filterMap = HashMap.filter
659    {-# INLINE filterMap #-}
660
661#if MIN_VERSION_containers(0, 5, 0)
662-- | This instance uses the functions from "Data.IntMap.Strict".
663#endif
664instance IsMap (IntMap.IntMap value) where
665    type MapValue (IntMap.IntMap value) = value
666    lookup = IntMap.lookup
667    {-# INLINE lookup #-}
668    insertMap = IntMap.insert
669    {-# INLINE insertMap #-}
670    deleteMap = IntMap.delete
671    {-# INLINE deleteMap #-}
672    singletonMap = IntMap.singleton
673    {-# INLINE singletonMap #-}
674    mapFromList = IntMap.fromList
675    {-# INLINE mapFromList #-}
676    mapToList = IntMap.toList
677    {-# INLINE mapToList #-}
678
679    findWithDefault = IntMap.findWithDefault
680    {-# INLINE findWithDefault #-}
681    insertWith = IntMap.insertWith
682    {-# INLINE insertWith #-}
683    insertWithKey = IntMap.insertWithKey
684    {-# INLINE insertWithKey #-}
685    insertLookupWithKey = IntMap.insertLookupWithKey
686    {-# INLINE insertLookupWithKey #-}
687    adjustMap = IntMap.adjust
688    {-# INLINE adjustMap #-}
689    adjustWithKey = IntMap.adjustWithKey
690    {-# INLINE adjustWithKey #-}
691    updateMap = IntMap.update
692    {-# INLINE updateMap #-}
693    updateWithKey = IntMap.updateWithKey
694    {-# INLINE updateWithKey #-}
695    --updateLookupWithKey = IntMap.updateLookupWithKey
696    alterMap = IntMap.alter
697    {-# INLINE alterMap #-}
698    unionWith = IntMap.unionWith
699    {-# INLINE unionWith #-}
700    unionWithKey = IntMap.unionWithKey
701    {-# INLINE unionWithKey #-}
702    unionsWith = IntMap.unionsWith
703    {-# INLINE unionsWith #-}
704    mapWithKey = IntMap.mapWithKey
705    {-# INLINE mapWithKey #-}
706#if MIN_VERSION_containers(0, 5, 0)
707    omapKeysWith = IntMap.mapKeysWith
708    {-# INLINE omapKeysWith #-}
709#endif
710    filterMap = IntMap.filter
711    {-# INLINE filterMap #-}
712
713instance Eq key => IsMap [(key, value)] where
714    type MapValue [(key, value)] = value
715    lookup = List.lookup
716    {-# INLINE lookup #-}
717    insertMap k v = ((k, v):) . deleteMap k
718    {-# INLINE insertMap #-}
719    deleteMap k = List.filter ((/= k) . fst)
720    {-# INLINE deleteMap #-}
721    singletonMap k v = [(k, v)]
722    {-# INLINE singletonMap #-}
723    mapFromList = id
724    {-# INLINE mapFromList #-}
725    mapToList = id
726    {-# INLINE mapToList #-}
727
728-- | Polymorphic typeclass for interacting with different set types
729class (SetContainer set, Element set ~ ContainerKey set) => IsSet set where
730    -- | Insert a value into a set.
731    insertSet :: Element set -> set -> set
732
733    -- | Delete a value from a set.
734    deleteSet :: Element set -> set -> set
735
736    -- | Create a set from a single element.
737    singletonSet :: Element set -> set
738
739    -- | Convert a list to a set.
740    setFromList :: [Element set] -> set
741
742    -- | Convert a set to a list.
743    setToList :: set -> [Element set]
744
745    -- | Filter values in a set.
746    --
747    -- @since 1.0.12.0
748    filterSet :: (Element set -> Bool) -> set -> set
749    filterSet p = setFromList . filter p . setToList
750
751instance Ord element => IsSet (Set.Set element) where
752    insertSet = Set.insert
753    {-# INLINE insertSet #-}
754    deleteSet = Set.delete
755    {-# INLINE deleteSet #-}
756    singletonSet = Set.singleton
757    {-# INLINE singletonSet #-}
758    setFromList = Set.fromList
759    {-# INLINE setFromList #-}
760    setToList = Set.toList
761    {-# INLINE setToList #-}
762    filterSet = Set.filter
763    {-# INLINE filterSet #-}
764
765instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where
766    insertSet = HashSet.insert
767    {-# INLINE insertSet #-}
768    deleteSet = HashSet.delete
769    {-# INLINE deleteSet #-}
770    singletonSet = HashSet.singleton
771    {-# INLINE singletonSet #-}
772    setFromList = HashSet.fromList
773    {-# INLINE setFromList #-}
774    setToList = HashSet.toList
775    {-# INLINE setToList #-}
776    filterSet = HashSet.filter
777    {-# INLINE filterSet #-}
778
779instance IsSet IntSet.IntSet where
780    insertSet = IntSet.insert
781    {-# INLINE insertSet #-}
782    deleteSet = IntSet.delete
783    {-# INLINE deleteSet #-}
784    singletonSet = IntSet.singleton
785    {-# INLINE singletonSet #-}
786    setFromList = IntSet.fromList
787    {-# INLINE setFromList #-}
788    setToList = IntSet.toList
789    {-# INLINE setToList #-}
790    filterSet = IntSet.filter
791    {-# INLINE filterSet #-}
792
793
794-- | Zip operations on 'MonoFunctor's.
795class MonoFunctor mono => MonoZip mono where
796    -- | Combine each element of two 'MonoZip's using a supplied function.
797    ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono
798
799    -- | Take two 'MonoZip's and return a list of the pairs of their elements.
800    ozip :: mono -> mono -> [(Element mono, Element mono)]
801
802    -- | Take a list of pairs of elements and return a 'MonoZip' of the first
803    -- components and a 'MonoZip' of the second components.
804    ounzip :: [(Element mono, Element mono)] -> (mono, mono)
805
806
807instance MonoZip ByteString.ByteString where
808    ozip     = ByteString.zip
809    ounzip   = ByteString.unzip
810    ozipWith f xs = ByteString.pack . ByteString.zipWith f xs
811    {-# INLINE ozip #-}
812    {-# INLINE ounzip #-}
813    {-# INLINE ozipWith #-}
814instance MonoZip LByteString.ByteString where
815    ozip     = LByteString.zip
816    ounzip   = LByteString.unzip
817    ozipWith f xs = LByteString.pack . LByteString.zipWith f xs
818    {-# INLINE ozip #-}
819    {-# INLINE ounzip #-}
820    {-# INLINE ozipWith #-}
821instance MonoZip Text.Text where
822    ozip     = Text.zip
823    ounzip   = (Text.pack *** Text.pack) . List.unzip
824    ozipWith = Text.zipWith
825    {-# INLINE ozip #-}
826    {-# INLINE ounzip #-}
827    {-# INLINE ozipWith #-}
828instance MonoZip LText.Text where
829    ozip     = LText.zip
830    ounzip   = (LText.pack *** LText.pack) . List.unzip
831    ozipWith = LText.zipWith
832    {-# INLINE ozip #-}
833    {-# INLINE ounzip #-}
834    {-# INLINE ozipWith #-}
835
836-- | Type class for maps whose keys can be converted into sets.
837class SetContainer set => HasKeysSet set where
838    -- | Type of the key set.
839    type KeySet set
840
841    -- | Convert a map into a set of its keys.
842    keysSet :: set -> KeySet set
843
844instance Ord k => HasKeysSet (Map.Map k v) where
845    type KeySet (Map.Map k v) = Set.Set k
846    keysSet = Map.keysSet
847instance HasKeysSet (IntMap.IntMap v) where
848    type KeySet (IntMap.IntMap v) = IntSet.IntSet
849    keysSet = IntMap.keysSet
850instance (Hashable k, Eq k) => HasKeysSet (HashMap.HashMap k v) where
851    type KeySet (HashMap.HashMap k v) = HashSet.HashSet k
852    keysSet = setFromList . HashMap.keys
853