{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
-- | Warning: This module should be considered highly experimental.
module Data.Containers where

import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable (Hashable)
import qualified Data.Set as Set
import qualified Data.HashSet as HashSet
import Data.Monoid (Monoid (..))
import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element, GrowingAppend, ofoldl', otoList)
import Data.Function (on)
import qualified Data.List as List
import qualified Data.IntSet as IntSet

import qualified Data.Text.Lazy as LText
import qualified Data.Text as Text
import qualified Data.ByteString.Lazy as LByteString
import qualified Data.ByteString as ByteString
import Control.Arrow ((***))
import GHC.Exts (Constraint)

-- | A container whose values are stored in Key-Value pairs.
class (Data.Monoid.Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where
    -- | The type of the key
    type ContainerKey set

    -- | Check if there is a value with the supplied key
    -- in the container.
    member :: ContainerKey set -> set -> Bool

    -- | Check if there isn't a value with the supplied key
    -- in the container.
    notMember ::  ContainerKey set -> set -> Bool

    -- | Get the union of two containers.
    union :: set -> set -> set

    -- | Combine a collection of @SetContainer@s, with left-most values overriding
    -- when there are matching keys.
    --
    -- @since 1.0.0
    unions :: (MonoFoldable mono, Element mono ~ set) => mono -> set
    unions = forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
ofoldl' forall set. SetContainer set => set -> set -> set
union forall a. Monoid a => a
Data.Monoid.mempty
    {-# INLINE unions #-}

    -- | Get the difference of two containers.
    difference :: set -> set -> set

    -- | Get the intersection of two containers.
    intersection :: set -> set -> set

    -- | Get a list of all of the keys in the container.
    keys :: set -> [ContainerKey set]

-- | This instance uses the functions from "Data.Map.Strict".
instance Ord k => SetContainer (Map.Map k v) where
    type ContainerKey (Map.Map k v) = k
    member :: ContainerKey (Map k v) -> Map k v -> Bool
member = forall k a. Ord k => k -> Map k a -> Bool
Map.member
    {-# INLINE member #-}
    notMember :: ContainerKey (Map k v) -> Map k v -> Bool
notMember = forall k a. Ord k => k -> Map k a -> Bool
Map.notMember
    {-# INLINE notMember #-}
    union :: Map k v -> Map k v -> Map k v
union = forall k v. Ord k => Map k v -> Map k v -> Map k v
Map.union
    {-# INLINE union #-}
    unions :: forall mono.
(MonoFoldable mono, Element mono ~ Map k v) =>
mono -> Map k v
unions = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    {-# INLINE unions #-}
    difference :: Map k v -> Map k v -> Map k v
difference = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference
    {-# INLINE difference #-}
    intersection :: Map k v -> Map k v -> Map k v
intersection = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection
    {-# INLINE intersection #-}
    keys :: Map k v -> [ContainerKey (Map k v)]
keys = forall k a. Map k a -> [k]
Map.keys
    {-# INLINE keys #-}

-- | This instance uses the functions from "Data.HashMap.Strict".
instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where
    type ContainerKey (HashMap.HashMap key value) = key
    member :: ContainerKey (HashMap key value) -> HashMap key value -> Bool
member = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member
    {-# INLINE member #-}
    notMember :: ContainerKey (HashMap key value) -> HashMap key value -> Bool
notMember ContainerKey (HashMap key value)
k = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member ContainerKey (HashMap key value)
k
    {-# INLINE notMember #-}
    union :: HashMap key value -> HashMap key value -> HashMap key value
union = forall key value.
(Eq key, Hashable key) =>
HashMap key value -> HashMap key value -> HashMap key value
HashMap.union
    {-# INLINE union #-}
    unions :: forall mono.
(MonoFoldable mono, Element mono ~ HashMap key value) =>
mono -> HashMap key value
unions = forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    {-# INLINE unions #-}
    difference :: HashMap key value -> HashMap key value -> HashMap key value
difference = forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference
    {-# INLINE difference #-}
    intersection :: HashMap key value -> HashMap key value -> HashMap key value
intersection = forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.intersection
    {-# INLINE intersection #-}
    keys :: HashMap key value -> [ContainerKey (HashMap key value)]
keys = forall k v. HashMap k v -> [k]
HashMap.keys
    {-# INLINE keys #-}

-- | This instance uses the functions from "Data.IntMap.Strict".
instance SetContainer (IntMap.IntMap value) where
    type ContainerKey (IntMap.IntMap value) = Int
    member :: ContainerKey (IntMap value) -> IntMap value -> Bool
member = forall a. Int -> IntMap a -> Bool
IntMap.member
    {-# INLINE member #-}
    notMember :: ContainerKey (IntMap value) -> IntMap value -> Bool
notMember = forall a. Int -> IntMap a -> Bool
IntMap.notMember
    {-# INLINE notMember #-}
    union :: IntMap value -> IntMap value -> IntMap value
union = forall value. IntMap value -> IntMap value -> IntMap value
IntMap.union
    {-# INLINE union #-}
    unions :: forall mono.
(MonoFoldable mono, Element mono ~ IntMap value) =>
mono -> IntMap value
unions = forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IntMap.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    {-# INLINE unions #-}
    difference :: IntMap value -> IntMap value -> IntMap value
difference = forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference
    {-# INLINE difference #-}
    intersection :: IntMap value -> IntMap value -> IntMap value
intersection = forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.intersection
    {-# INLINE intersection #-}
    keys :: IntMap value -> [ContainerKey (IntMap value)]
keys = forall a. IntMap a -> [Int]
IntMap.keys
    {-# INLINE keys #-}

instance Ord element => SetContainer (Set.Set element) where
    type ContainerKey (Set.Set element) = element
    member :: ContainerKey (Set element) -> Set element -> Bool
member = forall a. Ord a => a -> Set a -> Bool
Set.member
    {-# INLINE member #-}
    notMember :: ContainerKey (Set element) -> Set element -> Bool
notMember = forall a. Ord a => a -> Set a -> Bool
Set.notMember
    {-# INLINE notMember #-}
    union :: Set element -> Set element -> Set element
union = forall element.
Ord element =>
Set element -> Set element -> Set element
Set.union
    {-# INLINE union #-}
    unions :: forall mono.
(MonoFoldable mono, Element mono ~ Set element) =>
mono -> Set element
unions = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
    {-# INLINE unions #-}
    difference :: Set element -> Set element -> Set element
difference = forall element.
Ord element =>
Set element -> Set element -> Set element
Set.difference
    {-# INLINE difference #-}
    intersection :: Set element -> Set element -> Set element
intersection = forall element.
Ord element =>
Set element -> Set element -> Set element
Set.intersection
    {-# INLINE intersection #-}
    keys :: Set element -> [ContainerKey (Set element)]
keys = forall a. Set a -> [a]
Set.toList
    {-# INLINE keys #-}

instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where
    type ContainerKey (HashSet.HashSet element) = element
    member :: ContainerKey (HashSet element) -> HashSet element -> Bool
member = forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member
    {-# INLINE member #-}
    notMember :: ContainerKey (HashSet element) -> HashSet element -> Bool
notMember ContainerKey (HashSet element)
e = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member ContainerKey (HashSet element)
e
    {-# INLINE notMember #-}
    union :: HashSet element -> HashSet element -> HashSet element
union = forall element.
(Eq element, Hashable element) =>
HashSet element -> HashSet element -> HashSet element
HashSet.union
    {-# INLINE union #-}
    difference :: HashSet element -> HashSet element -> HashSet element
difference = forall element.
(Eq element, Hashable element) =>
HashSet element -> HashSet element -> HashSet element
HashSet.difference
    {-# INLINE difference #-}
    intersection :: HashSet element -> HashSet element -> HashSet element
intersection = forall element.
(Eq element, Hashable element) =>
HashSet element -> HashSet element -> HashSet element
HashSet.intersection
    {-# INLINE intersection #-}
    keys :: HashSet element -> [ContainerKey (HashSet element)]
keys = forall a. HashSet a -> [a]
HashSet.toList
    {-# INLINE keys #-}

instance SetContainer IntSet.IntSet where
    type ContainerKey IntSet.IntSet = Int
    member :: ContainerKey IntSet -> IntSet -> Bool
member = Int -> IntSet -> Bool
IntSet.member
    {-# INLINE member #-}
    notMember :: ContainerKey IntSet -> IntSet -> Bool
notMember = Int -> IntSet -> Bool
IntSet.notMember
    {-# INLINE notMember #-}
    union :: IntSet -> IntSet -> IntSet
union = IntSet -> IntSet -> IntSet
IntSet.union
    {-# INLINE union #-}
    difference :: IntSet -> IntSet -> IntSet
difference = IntSet -> IntSet -> IntSet
IntSet.difference
    {-# INLINE difference #-}
    intersection :: IntSet -> IntSet -> IntSet
intersection = IntSet -> IntSet -> IntSet
IntSet.intersection
    {-# INLINE intersection #-}
    keys :: IntSet -> [ContainerKey IntSet]
keys = IntSet -> [Int]
IntSet.toList
    {-# INLINE keys #-}

instance Eq key => SetContainer [(key, value)] where
    type ContainerKey [(key, value)] = key
    member :: ContainerKey [(key, value)] -> [(key, value)] -> Bool
member ContainerKey [(key, value)]
k = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any ((forall a. Eq a => a -> a -> Bool
== ContainerKey [(key, value)]
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    {-# INLINE member #-}
    notMember :: ContainerKey [(key, value)] -> [(key, value)] -> Bool
notMember ContainerKey [(key, value)]
k = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall set. SetContainer set => ContainerKey set -> set -> Bool
member ContainerKey [(key, value)]
k
    {-# INLINE notMember #-}
    union :: [(key, value)] -> [(key, value)] -> [(key, value)]
union = forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.unionBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
    {-# INLINE union #-}
    [(key, value)]
x difference :: [(key, value)] -> [(key, value)] -> [(key, value)]
`difference` [(key, value)]
y =
        [(key, value)] -> [(key, value)]
loop [(key, value)]
x
      where
        loop :: [(key, value)] -> [(key, value)]
loop [] = []
        loop ((key
k, value
v):[(key, value)]
rest) =
            case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup key
k [(key, value)]
y of
                Maybe (MapValue [(key, value)])
Nothing -> (key
k, value
v) forall a. a -> [a] -> [a]
: [(key, value)] -> [(key, value)]
loop [(key, value)]
rest
                Just MapValue [(key, value)]
_ -> [(key, value)] -> [(key, value)]
loop [(key, value)]
rest
    intersection :: [(key, value)] -> [(key, value)] -> [(key, value)]
intersection = forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.intersectBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
    {-# INLINE intersection #-}
    keys :: [(key, value)] -> [ContainerKey [(key, value)]]
keys = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
    {-# INLINE keys #-}

-- | A guaranteed-polymorphic @Map@, which allows for more polymorphic versions
-- of functions.
class PolyMap map where
    -- | Get the difference between two maps, using the left map's values.
    differenceMap :: map value1 -> map value2 -> map value1
    {-
    differenceWithMap :: (value1 -> value2 -> Maybe value1)
                      -> map value1 -> map value2 -> map value1
    -}

    -- | Get the intersection of two maps, using the left map's values.
    intersectionMap :: map value1 -> map value2 -> map value1

    -- | Get the intersection of two maps with a supplied function
    -- that takes in the left map's value and the right map's value.
    intersectionWithMap :: (value1 -> value2 -> value3)
                        -> map value1 -> map value2 -> map value3

-- | This instance uses the functions from "Data.Map.Strict".
instance Ord key => PolyMap (Map.Map key) where
    differenceMap :: forall value1 value2.
Map key value1 -> Map key value2 -> Map key value1
differenceMap = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference
    {-# INLINE differenceMap #-}
    --differenceWithMap = Map.differenceWith
    intersectionMap :: forall value1 value2.
Map key value1 -> Map key value2 -> Map key value1
intersectionMap = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection
    {-# INLINE intersectionMap #-}
    intersectionWithMap :: forall value1 value2 value3.
(value1 -> value2 -> value3)
-> Map key value1 -> Map key value2 -> Map key value3
intersectionWithMap = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
    {-# INLINE intersectionWithMap #-}

-- | This instance uses the functions from "Data.HashMap.Strict".
instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where
    differenceMap :: forall value1 value2.
HashMap key value1 -> HashMap key value2 -> HashMap key value1
differenceMap = forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference
    {-# INLINE differenceMap #-}
    --differenceWithMap = HashMap.differenceWith
    intersectionMap :: forall value1 value2.
HashMap key value1 -> HashMap key value2 -> HashMap key value1
intersectionMap = forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.intersection
    {-# INLINE intersectionMap #-}
    intersectionWithMap :: forall value1 value2 value3.
(value1 -> value2 -> value3)
-> HashMap key value1 -> HashMap key value2 -> HashMap key value3
intersectionWithMap = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith
    {-# INLINE intersectionWithMap #-}

-- | This instance uses the functions from "Data.IntMap.Strict".
instance PolyMap IntMap.IntMap where
    differenceMap :: forall a b. IntMap a -> IntMap b -> IntMap a
differenceMap = forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference
    {-# INLINE differenceMap #-}
    --differenceWithMap = IntMap.differenceWith
    intersectionMap :: forall a b. IntMap a -> IntMap b -> IntMap a
intersectionMap = forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.intersection
    {-# INLINE intersectionMap #-}
    intersectionWithMap :: forall value1 value2 value3.
(value1 -> value2 -> value3)
-> IntMap value1 -> IntMap value2 -> IntMap value3
intersectionWithMap = forall value1 value2 value3.
(value1 -> value2 -> value3)
-> IntMap value1 -> IntMap value2 -> IntMap value3
IntMap.intersectionWith
    {-# INLINE intersectionWithMap #-}

-- | A @Map@ type polymorphic in both its key and value.
class BiPolyMap map where
    type BPMKeyConstraint map key :: Constraint
    mapKeysWith :: (BPMKeyConstraint map k1, BPMKeyConstraint map k2)
                => (v -> v -> v) -- ^ combine values that now overlap
                -> (k1 -> k2)
                -> map k1 v
                -> map k2 v
instance BiPolyMap Map.Map where
    type BPMKeyConstraint Map.Map key = Ord key
    mapKeysWith :: forall k1 k2 v.
(BPMKeyConstraint Map k1, BPMKeyConstraint Map k2) =>
(v -> v -> v) -> (k1 -> k2) -> Map k1 v -> Map k2 v
mapKeysWith = forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
    {-# INLINE mapKeysWith #-}
instance BiPolyMap HashMap.HashMap where
    type BPMKeyConstraint HashMap.HashMap key = (Hashable key, Eq key)
    mapKeysWith :: forall k1 k2 v.
(BPMKeyConstraint HashMap k1, BPMKeyConstraint HashMap k2) =>
(v -> v -> v) -> (k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeysWith v -> v -> v
g k1 -> k2
f =
        forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map.
IsMap map =>
(MapValue map -> MapValue map -> MapValue map) -> [map] -> map
unionsWith v -> v -> v
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (k1, v) -> [(k2, v)]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList
      where
        go :: (k1, v) -> [(k2, v)]
go (k1
k, v
v) = [(k1 -> k2
f k1
k, v
v)]
    {-# INLINE mapKeysWith #-}

-- | Polymorphic typeclass for interacting with different map types
class (MonoTraversable map, SetContainer map) => IsMap map where
    -- | In some cases, 'MapValue' and 'Element' will be different, e.g., the
    -- 'IsMap' instance of associated lists.
    type MapValue map

    -- | Look up a value in a map with a specified key.
    lookup       :: ContainerKey map -> map -> Maybe (MapValue map)

    -- | Insert a key-value pair into a map.
    insertMap    :: ContainerKey map -> MapValue map -> map -> map

    -- | Delete a key-value pair of a map using a specified key.
    deleteMap    :: ContainerKey map -> map -> map

    -- | Create a map from a single key-value pair.
    singletonMap :: ContainerKey map -> MapValue map -> map

    -- | Convert a list of key-value pairs to a map
    mapFromList  :: [(ContainerKey map, MapValue map)] -> map

    -- | Convert a map to a list of key-value pairs.
    mapToList    :: map -> [(ContainerKey map, MapValue map)]

    -- | Like 'lookup', but uses a default value when the key does
    -- not exist in the map.
    findWithDefault :: MapValue map -> ContainerKey map -> map -> MapValue map
    findWithDefault MapValue map
def ContainerKey map
key = forall a. a -> Maybe a -> a
fromMaybe MapValue map
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
key

    -- | Insert a key-value pair into a map.
    --
    -- Inserts the value directly if the key does not exist in the map. Otherwise,
    -- apply a supplied function that accepts the new value and the previous value
    -- and insert that result into the map.
    insertWith :: (MapValue map -> MapValue map -> MapValue map)
                  -- ^ function that accepts the new value and the
                  -- previous value and returns the value that will be
                  -- set in the map.
               -> ContainerKey map -- ^ key
               -> MapValue map     -- ^ new value to insert
               -> map              -- ^ input map
               -> map              -- ^ resulting map
    insertWith MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v map
m =
        MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m
      where
        v' :: MapValue map
v' =
            case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
                Maybe (MapValue map)
Nothing -> MapValue map
v
                Just MapValue map
vold -> MapValue map -> MapValue map -> MapValue map
f MapValue map
v MapValue map
vold

    -- | Insert a key-value pair into a map.
    --
    -- Inserts the value directly if the key does not exist in the map. Otherwise,
    -- apply a supplied function that accepts the key, the new value, and the
    -- previous value and insert that result into the map.
    insertWithKey
        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the key, the new value, and the
           -- previous value and returns the value that will be
           -- set in the map.
        -> ContainerKey map -- ^ key
        -> MapValue map     -- ^ new value to insert
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    insertWithKey ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v map
m =
        MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m
      where
        v' :: MapValue map
v' =
            case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
                Maybe (MapValue map)
Nothing -> MapValue map
v
                Just MapValue map
vold -> ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v MapValue map
vold

    -- | Insert a key-value pair into a map, return the previous key's value
    -- if it existed.
    --
    -- Inserts the value directly if the key does not exist in the map. Otherwise,
    -- apply a supplied function that accepts the key, the new value, and the
    -- previous value and insert that result into the map.
    insertLookupWithKey
        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the key, the new value, and the
           -- previous value and returns the value that will be
           -- set in the map.
        -> ContainerKey map            -- ^ key
        -> MapValue map                -- ^ new value to insert
        -> map                         -- ^ input map
        -> (Maybe (MapValue map), map) -- ^ previous value and the resulting map
    insertLookupWithKey ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v map
m =
        MapValue map
v' seq :: forall a b. a -> b -> b
`seq` (Maybe (MapValue map)
mold, forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m)
      where
        (Maybe (MapValue map)
mold, MapValue map
v') =
            case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
                Maybe (MapValue map)
Nothing -> (forall a. Maybe a
Nothing, MapValue map
v)
                Just MapValue map
vold -> (forall a. a -> Maybe a
Just MapValue map
vold, ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v MapValue map
vold)

    -- | Apply a function to the value of a given key.
    --
    -- Returns the input map when the key-value pair does not exist.
    adjustMap
        :: (MapValue map -> MapValue map)
           -- ^ function to apply to the previous value
        -> ContainerKey map -- ^ key
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    adjustMap MapValue map -> MapValue map
f ContainerKey map
k map
m =
        case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
            Maybe (MapValue map)
Nothing -> map
m
            Just MapValue map
v ->
                let v' :: MapValue map
v' = MapValue map -> MapValue map
f MapValue map
v
                 in MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m

    -- | Equivalent to 'adjustMap', but the function accepts the key,
    -- as well as the previous value.
    adjustWithKey
        :: (ContainerKey map -> MapValue map -> MapValue map)
           -- ^ function that accepts the key and the previous value
           -- and returns the new value
        -> ContainerKey map -- ^ key
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    adjustWithKey ContainerKey map -> MapValue map -> MapValue map
f ContainerKey map
k map
m =
        case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
            Maybe (MapValue map)
Nothing -> map
m
            Just MapValue map
v ->
                let v' :: MapValue map
v' = ContainerKey map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v
                 in MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m

    -- | Apply a function to the value of a given key.
    --
    -- If the function returns 'Nothing', this deletes the key-value pair.
    --
    -- Returns the input map when the key-value pair does not exist.
    updateMap
        :: (MapValue map -> Maybe (MapValue map))
           -- ^ function that accepts the previous value
           -- and returns the new value or 'Nothing'
        -> ContainerKey map -- ^ key
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    updateMap MapValue map -> Maybe (MapValue map)
f ContainerKey map
k map
m =
        case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
            Maybe (MapValue map)
Nothing -> map
m
            Just MapValue map
v ->
                case MapValue map -> Maybe (MapValue map)
f MapValue map
v of
                    Maybe (MapValue map)
Nothing -> forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k map
m
                    Just MapValue map
v' -> MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m

    -- | Equivalent to 'updateMap', but the function accepts the key,
    -- as well as the previous value.
    updateWithKey
        :: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
           -- ^ function that accepts the key and the previous value
           -- and returns the new value or 'Nothing'
        -> ContainerKey map -- ^ key
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    updateWithKey ContainerKey map -> MapValue map -> Maybe (MapValue map)
f ContainerKey map
k map
m =
        case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
            Maybe (MapValue map)
Nothing -> map
m
            Just MapValue map
v ->
                case ContainerKey map -> MapValue map -> Maybe (MapValue map)
f ContainerKey map
k MapValue map
v of
                    Maybe (MapValue map)
Nothing -> forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k map
m
                    Just MapValue map
v' -> MapValue map
v' seq :: forall a b. a -> b -> b
`seq` forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m

    -- | Apply a function to the value of a given key.
    --
    -- If the map does not contain the key this returns 'Nothing'
    -- and the input map.
    --
    -- If the map does contain the key but the function returns 'Nothing',
    -- this returns the previous value and the map with the key-value pair removed.
    --
    -- If the map contains the key and the function returns a value,
    -- this returns the new value and the map with the key-value pair with the new value.
    updateLookupWithKey
        :: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
           -- ^ function that accepts the key and the previous value
           -- and returns the new value or 'Nothing'
        -> ContainerKey map            -- ^ key
        -> map                         -- ^ input map
        -> (Maybe (MapValue map), map) -- ^ previous/new value and the resulting map
    updateLookupWithKey ContainerKey map -> MapValue map -> Maybe (MapValue map)
f ContainerKey map
k map
m =
        case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m of
            Maybe (MapValue map)
Nothing -> (forall a. Maybe a
Nothing, map
m)
            Just MapValue map
v ->
                case ContainerKey map -> MapValue map -> Maybe (MapValue map)
f ContainerKey map
k MapValue map
v of
                    Maybe (MapValue map)
Nothing -> (forall a. a -> Maybe a
Just MapValue map
v, forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k map
m)
                    Just MapValue map
v' -> MapValue map
v' seq :: forall a b. a -> b -> b
`seq` (forall a. a -> Maybe a
Just MapValue map
v', forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v' map
m)

    -- | Update/Delete the value of a given key.
    --
    -- Applies a function to previous value of a given key, if it results in 'Nothing'
    -- delete the key-value pair from the map, otherwise replace the previous value
    -- with the new value.
    alterMap
        :: (Maybe (MapValue map) -> Maybe (MapValue map))
           -- ^ function that accepts the previous value and
           -- returns the new value or 'Nothing'
        -> ContainerKey map -- ^ key
        -> map              -- ^ input map
        -> map              -- ^ resulting map
    alterMap Maybe (MapValue map) -> Maybe (MapValue map)
f ContainerKey map
k map
m =
        case Maybe (MapValue map) -> Maybe (MapValue map)
f Maybe (MapValue map)
mold of
            Maybe (MapValue map)
Nothing ->
                case Maybe (MapValue map)
mold of
                    Maybe (MapValue map)
Nothing -> map
m
                    Just MapValue map
_ -> forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k map
m
            Just MapValue map
v -> forall map.
IsMap map =>
ContainerKey map -> MapValue map -> map -> map
insertMap ContainerKey map
k MapValue map
v map
m
      where
        mold :: Maybe (MapValue map)
mold = forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup ContainerKey map
k map
m

    -- | Combine two maps.
    --
    -- When a key exists in both maps, apply a function
    -- to both of the values and use the result of that as the value
    -- of the key in the resulting map.
    unionWith
        :: (MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the first map's value and the second map's value
           -- and returns the new value that will be used
        -> map -- ^ first map
        -> map -- ^ second map
        -> map -- ^ resulting map
    unionWith MapValue map -> MapValue map -> MapValue map
f map
x map
y =
        forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall a b. (a -> b) -> a -> b
$ [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop forall a b. (a -> b) -> a -> b
$ forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList map
x forall a. [a] -> [a] -> [a]
++ forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList map
y
      where
        loop :: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop [] = []
        loop ((ContainerKey map
k, MapValue map
v):[(ContainerKey map, MapValue map)]
rest) =
            case forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup ContainerKey map
k [(ContainerKey map, MapValue map)]
rest of
                Maybe (MapValue map)
Nothing -> (ContainerKey map
k, MapValue map
v) forall a. a -> [a] -> [a]
: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop [(ContainerKey map, MapValue map)]
rest
                Just MapValue map
v' -> (ContainerKey map
k, MapValue map -> MapValue map -> MapValue map
f MapValue map
v MapValue map
v') forall a. a -> [a] -> [a]
: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop (forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k [(ContainerKey map, MapValue map)]
rest)

    -- Equivalent to 'unionWith', but the function accepts the key,
    -- as well as both of the map's values.
    unionWithKey
        :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the key, the first map's value and the
           -- second map's value and returns the new value that will be used
        -> map -- ^ first map
        -> map -- ^ second map
        -> map -- ^ resulting map
    unionWithKey ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f map
x map
y =
        forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall a b. (a -> b) -> a -> b
$ [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop forall a b. (a -> b) -> a -> b
$ forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList map
x forall a. [a] -> [a] -> [a]
++ forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList map
y
      where
        loop :: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop [] = []
        loop ((ContainerKey map
k, MapValue map
v):[(ContainerKey map, MapValue map)]
rest) =
            case forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup ContainerKey map
k [(ContainerKey map, MapValue map)]
rest of
                Maybe (MapValue map)
Nothing -> (ContainerKey map
k, MapValue map
v) forall a. a -> [a] -> [a]
: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop [(ContainerKey map, MapValue map)]
rest
                Just MapValue map
v' -> (ContainerKey map
k, ContainerKey map -> MapValue map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v MapValue map
v') forall a. a -> [a] -> [a]
: [(ContainerKey map, MapValue map)]
-> [(ContainerKey map, MapValue map)]
loop (forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey map
k [(ContainerKey map, MapValue map)]
rest)

    -- | Combine a list of maps.
    --
    -- When a key exists in two different maps, apply a function
    -- to both of the values and use the result of that as the value
    -- of the key in the resulting map.
    unionsWith
        :: (MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the first map's value and the second map's value
           -- and returns the new value that will be used
        -> [map] -- ^ input list of maps
        -> map   -- ^ resulting map
    unionsWith MapValue map -> MapValue map -> MapValue map
_ [] = forall a. Monoid a => a
mempty
    unionsWith MapValue map -> MapValue map -> MapValue map
_ [map
x] = map
x
    unionsWith MapValue map -> MapValue map -> MapValue map
f (map
x:map
y:[map]
z) = forall map.
IsMap map =>
(MapValue map -> MapValue map -> MapValue map) -> [map] -> map
unionsWith MapValue map -> MapValue map -> MapValue map
f (forall map.
IsMap map =>
(MapValue map -> MapValue map -> MapValue map) -> map -> map -> map
unionWith MapValue map -> MapValue map -> MapValue map
f map
x map
yforall a. a -> [a] -> [a]
:[map]
z)

    -- | Apply a function over every key-value pair of a map.
    mapWithKey
        :: (ContainerKey map -> MapValue map -> MapValue map)
           -- ^ function that accepts the key and the previous value
           -- and returns the new value
        -> map -- ^ input map
        -> map -- ^ resulting map
    mapWithKey ContainerKey map -> MapValue map -> MapValue map
f =
        forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ContainerKey map, MapValue map)
-> (ContainerKey map, MapValue map)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList
      where
        go :: (ContainerKey map, MapValue map)
-> (ContainerKey map, MapValue map)
go (ContainerKey map
k, MapValue map
v) = (ContainerKey map
k, ContainerKey map -> MapValue map -> MapValue map
f ContainerKey map
k MapValue map
v)

    -- | Apply a function over every key of a pair and run
    -- 'unionsWith' over the results.
    omapKeysWith
        :: (MapValue map -> MapValue map -> MapValue map)
           -- ^ function that accepts the first map's value and the second map's value
           -- and returns the new value that will be used
        -> (ContainerKey map -> ContainerKey map)
           -- ^ function that accepts the previous key and
           -- returns the new key
        -> map -- ^ input map
        -> map -- ^ resulting map
    omapKeysWith MapValue map -> MapValue map -> MapValue map
g ContainerKey map -> ContainerKey map
f =
        forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map.
IsMap map =>
(MapValue map -> MapValue map -> MapValue map) -> [map] -> map
unionsWith MapValue map -> MapValue map -> MapValue map
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ContainerKey map, MapValue map)
-> [(ContainerKey map, MapValue map)]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList
      where
        go :: (ContainerKey map, MapValue map)
-> [(ContainerKey map, MapValue map)]
go (ContainerKey map
k, MapValue map
v) = [(ContainerKey map -> ContainerKey map
f ContainerKey map
k, MapValue map
v)]

    -- | Filter values in a map.
    --
    -- @since 1.0.9.0
    filterMap :: IsMap map => (MapValue map -> Bool) -> map -> map
    filterMap MapValue map -> Bool
p = forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (MapValue map -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map. IsMap map => map -> [(ContainerKey map, MapValue map)]
mapToList

-- | This instance uses the functions from "Data.Map.Strict".
instance Ord key => IsMap (Map.Map key value) where
    type MapValue (Map.Map key value) = value
    lookup :: ContainerKey (Map key value)
-> Map key value -> Maybe (MapValue (Map key value))
lookup = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
    {-# INLINE lookup #-}
    insertMap :: ContainerKey (Map key value)
-> MapValue (Map key value) -> Map key value -> Map key value
insertMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
    {-# INLINE insertMap #-}
    deleteMap :: ContainerKey (Map key value) -> Map key value -> Map key value
deleteMap = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete
    {-# INLINE deleteMap #-}
    singletonMap :: ContainerKey (Map key value)
-> MapValue (Map key value) -> Map key value
singletonMap = forall k a. k -> a -> Map k a
Map.singleton
    {-# INLINE singletonMap #-}
    mapFromList :: [(ContainerKey (Map key value), MapValue (Map key value))]
-> Map key value
mapFromList = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    {-# INLINE mapFromList #-}
    mapToList :: Map key value
-> [(ContainerKey (Map key value), MapValue (Map key value))]
mapToList = forall k a. Map k a -> [(k, a)]
Map.toList
    {-# INLINE mapToList #-}

    findWithDefault :: MapValue (Map key value)
-> ContainerKey (Map key value)
-> Map key value
-> MapValue (Map key value)
findWithDefault = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
    {-# INLINE findWithDefault #-}
    insertWith :: (MapValue (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> ContainerKey (Map key value)
-> MapValue (Map key value)
-> Map key value
-> Map key value
insertWith = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
    {-# INLINE insertWith #-}
    insertWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value))
-> ContainerKey (Map key value)
-> MapValue (Map key value)
-> Map key value
-> Map key value
insertWithKey = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWithKey
    {-# INLINE insertWithKey #-}
    insertLookupWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value))
-> ContainerKey (Map key value)
-> MapValue (Map key value)
-> Map key value
-> (Maybe (MapValue (Map key value)), Map key value)
insertLookupWithKey = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.insertLookupWithKey
    {-# INLINE insertLookupWithKey #-}
    adjustMap :: (MapValue (Map key value) -> MapValue (Map key value))
-> ContainerKey (Map key value) -> Map key value -> Map key value
adjustMap = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
    {-# INLINE adjustMap #-}
    adjustWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> ContainerKey (Map key value) -> Map key value -> Map key value
adjustWithKey = forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
Map.adjustWithKey
    {-# INLINE adjustWithKey #-}
    updateMap :: (MapValue (Map key value) -> Maybe (MapValue (Map key value)))
-> ContainerKey (Map key value) -> Map key value -> Map key value
updateMap = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update
    {-# INLINE updateMap #-}
    updateWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value) -> Maybe (MapValue (Map key value)))
-> ContainerKey (Map key value) -> Map key value -> Map key value
updateWithKey = forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
Map.updateWithKey
    {-# INLINE updateWithKey #-}
    updateLookupWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value) -> Maybe (MapValue (Map key value)))
-> ContainerKey (Map key value)
-> Map key value
-> (Maybe (MapValue (Map key value)), Map key value)
updateLookupWithKey = forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey
    {-# INLINE updateLookupWithKey #-}
    alterMap :: (Maybe (MapValue (Map key value))
 -> Maybe (MapValue (Map key value)))
-> ContainerKey (Map key value) -> Map key value -> Map key value
alterMap = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
    {-# INLINE alterMap #-}
    unionWith :: (MapValue (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> Map key value -> Map key value -> Map key value
unionWith = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith
    {-# INLINE unionWith #-}
    unionWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value)
 -> MapValue (Map key value))
-> Map key value -> Map key value -> Map key value
unionWithKey = forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey
    {-# INLINE unionWithKey #-}
    unionsWith :: (MapValue (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> [Map key value] -> Map key value
unionsWith = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith
    {-# INLINE unionsWith #-}
    mapWithKey :: (ContainerKey (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> Map key value -> Map key value
mapWithKey = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
    {-# INLINE mapWithKey #-}
    omapKeysWith :: (MapValue (Map key value)
 -> MapValue (Map key value) -> MapValue (Map key value))
-> (ContainerKey (Map key value) -> ContainerKey (Map key value))
-> Map key value
-> Map key value
omapKeysWith = forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
    {-# INLINE omapKeysWith #-}
    filterMap :: IsMap (Map key value) =>
(MapValue (Map key value) -> Bool)
-> Map key value -> Map key value
filterMap = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
    {-# INLINE filterMap #-}

-- | This instance uses the functions from "Data.HashMap.Strict".
instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where
    type MapValue (HashMap.HashMap key value) = value
    lookup :: ContainerKey (HashMap key value)
-> HashMap key value -> Maybe (MapValue (HashMap key value))
lookup = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup
    {-# INLINE lookup #-}
    insertMap :: ContainerKey (HashMap key value)
-> MapValue (HashMap key value)
-> HashMap key value
-> HashMap key value
insertMap = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert
    {-# INLINE insertMap #-}
    deleteMap :: ContainerKey (HashMap key value)
-> HashMap key value -> HashMap key value
deleteMap = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete
    {-# INLINE deleteMap #-}
    singletonMap :: ContainerKey (HashMap key value)
-> MapValue (HashMap key value) -> HashMap key value
singletonMap = forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton
    {-# INLINE singletonMap #-}
    mapFromList :: [(ContainerKey (HashMap key value), MapValue (HashMap key value))]
-> HashMap key value
mapFromList = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    {-# INLINE mapFromList #-}
    mapToList :: HashMap key value
-> [(ContainerKey (HashMap key value),
     MapValue (HashMap key value))]
mapToList = forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    {-# INLINE mapToList #-}

    --findWithDefault = HashMap.findWithDefault
    insertWith :: (MapValue (HashMap key value)
 -> MapValue (HashMap key value) -> MapValue (HashMap key value))
-> ContainerKey (HashMap key value)
-> MapValue (HashMap key value)
-> HashMap key value
-> HashMap key value
insertWith = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith
    {-# INLINE insertWith #-}
    --insertWithKey = HashMap.insertWithKey
    --insertLookupWithKey = HashMap.insertLookupWithKey
    adjustMap :: (MapValue (HashMap key value) -> MapValue (HashMap key value))
-> ContainerKey (HashMap key value)
-> HashMap key value
-> HashMap key value
adjustMap = forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust
    {-# INLINE adjustMap #-}
    --adjustWithKey = HashMap.adjustWithKey
    --updateMap = HashMap.update
    --updateWithKey = HashMap.updateWithKey
    --updateLookupWithKey = HashMap.updateLookupWithKey
    --alterMap = HashMap.alter
    unionWith :: (MapValue (HashMap key value)
 -> MapValue (HashMap key value) -> MapValue (HashMap key value))
-> HashMap key value -> HashMap key value -> HashMap key value
unionWith = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
    {-# INLINE unionWith #-}
    --unionWithKey = HashMap.unionWithKey
    --unionsWith = HashMap.unionsWith
    --mapWithKey = HashMap.mapWithKey
    --mapKeysWith = HashMap.mapKeysWith
    filterMap :: IsMap (HashMap key value) =>
(MapValue (HashMap key value) -> Bool)
-> HashMap key value -> HashMap key value
filterMap = forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter
    {-# INLINE filterMap #-}

-- | This instance uses the functions from "Data.IntMap.Strict".
instance IsMap (IntMap.IntMap value) where
    type MapValue (IntMap.IntMap value) = value
    lookup :: ContainerKey (IntMap value)
-> IntMap value -> Maybe (MapValue (IntMap value))
lookup = forall a. Int -> IntMap a -> Maybe a
IntMap.lookup
    {-# INLINE lookup #-}
    insertMap :: ContainerKey (IntMap value)
-> MapValue (IntMap value) -> IntMap value -> IntMap value
insertMap = forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert
    {-# INLINE insertMap #-}
    deleteMap :: ContainerKey (IntMap value) -> IntMap value -> IntMap value
deleteMap = forall a. Int -> IntMap a -> IntMap a
IntMap.delete
    {-# INLINE deleteMap #-}
    singletonMap :: ContainerKey (IntMap value)
-> MapValue (IntMap value) -> IntMap value
singletonMap = forall a. Int -> a -> IntMap a
IntMap.singleton
    {-# INLINE singletonMap #-}
    mapFromList :: [(ContainerKey (IntMap value), MapValue (IntMap value))]
-> IntMap value
mapFromList = forall a. [(Int, a)] -> IntMap a
IntMap.fromList
    {-# INLINE mapFromList #-}
    mapToList :: IntMap value
-> [(ContainerKey (IntMap value), MapValue (IntMap value))]
mapToList = forall a. IntMap a -> [(Int, a)]
IntMap.toList
    {-# INLINE mapToList #-}

    findWithDefault :: MapValue (IntMap value)
-> ContainerKey (IntMap value)
-> IntMap value
-> MapValue (IntMap value)
findWithDefault = forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault
    {-# INLINE findWithDefault #-}
    insertWith :: (MapValue (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> ContainerKey (IntMap value)
-> MapValue (IntMap value)
-> IntMap value
-> IntMap value
insertWith = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith
    {-# INLINE insertWith #-}
    insertWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value))
-> ContainerKey (IntMap value)
-> MapValue (IntMap value)
-> IntMap value
-> IntMap value
insertWithKey = forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWithKey
    {-# INLINE insertWithKey #-}
    insertLookupWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value))
-> ContainerKey (IntMap value)
-> MapValue (IntMap value)
-> IntMap value
-> (Maybe (MapValue (IntMap value)), IntMap value)
insertLookupWithKey = forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
IntMap.insertLookupWithKey
    {-# INLINE insertLookupWithKey #-}
    adjustMap :: (MapValue (IntMap value) -> MapValue (IntMap value))
-> ContainerKey (IntMap value) -> IntMap value -> IntMap value
adjustMap = forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IntMap.adjust
    {-# INLINE adjustMap #-}
    adjustWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> ContainerKey (IntMap value) -> IntMap value -> IntMap value
adjustWithKey = forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a
IntMap.adjustWithKey
    {-# INLINE adjustWithKey #-}
    updateMap :: (MapValue (IntMap value) -> Maybe (MapValue (IntMap value)))
-> ContainerKey (IntMap value) -> IntMap value -> IntMap value
updateMap = forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.update
    {-# INLINE updateMap #-}
    updateWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value) -> Maybe (MapValue (IntMap value)))
-> ContainerKey (IntMap value) -> IntMap value -> IntMap value
updateWithKey = forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.updateWithKey
    {-# INLINE updateWithKey #-}
    --updateLookupWithKey = IntMap.updateLookupWithKey
    alterMap :: (Maybe (MapValue (IntMap value))
 -> Maybe (MapValue (IntMap value)))
-> ContainerKey (IntMap value) -> IntMap value -> IntMap value
alterMap = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter
    {-# INLINE alterMap #-}
    unionWith :: (MapValue (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> IntMap value -> IntMap value -> IntMap value
unionWith = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith
    {-# INLINE unionWith #-}
    unionWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value)
 -> MapValue (IntMap value))
-> IntMap value -> IntMap value -> IntMap value
unionWithKey = forall a. (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWithKey
    {-# INLINE unionWithKey #-}
    unionsWith :: (MapValue (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> [IntMap value] -> IntMap value
unionsWith = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith
    {-# INLINE unionsWith #-}
    mapWithKey :: (ContainerKey (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> IntMap value -> IntMap value
mapWithKey = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey
    {-# INLINE mapWithKey #-}
    omapKeysWith :: (MapValue (IntMap value)
 -> MapValue (IntMap value) -> MapValue (IntMap value))
-> (ContainerKey (IntMap value) -> ContainerKey (IntMap value))
-> IntMap value
-> IntMap value
omapKeysWith = forall a. (a -> a -> a) -> (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysWith
    {-# INLINE omapKeysWith #-}
    filterMap :: IsMap (IntMap value) =>
(MapValue (IntMap value) -> Bool) -> IntMap value -> IntMap value
filterMap = forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter
    {-# INLINE filterMap #-}

instance Eq key => IsMap [(key, value)] where
    type MapValue [(key, value)] = value
    lookup :: ContainerKey [(key, value)]
-> [(key, value)] -> Maybe (MapValue [(key, value)])
lookup = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup
    {-# INLINE lookup #-}
    insertMap :: ContainerKey [(key, value)]
-> MapValue [(key, value)] -> [(key, value)] -> [(key, value)]
insertMap ContainerKey [(key, value)]
k MapValue [(key, value)]
v = ((ContainerKey [(key, value)]
k, MapValue [(key, value)]
v)forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall map. IsMap map => ContainerKey map -> map -> map
deleteMap ContainerKey [(key, value)]
k
    {-# INLINE insertMap #-}
    deleteMap :: ContainerKey [(key, value)] -> [(key, value)] -> [(key, value)]
deleteMap ContainerKey [(key, value)]
k = forall a. (a -> Bool) -> [a] -> [a]
List.filter ((forall a. Eq a => a -> a -> Bool
/= ContainerKey [(key, value)]
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    {-# INLINE deleteMap #-}
    singletonMap :: ContainerKey [(key, value)]
-> MapValue [(key, value)] -> [(key, value)]
singletonMap ContainerKey [(key, value)]
k MapValue [(key, value)]
v = [(ContainerKey [(key, value)]
k, MapValue [(key, value)]
v)]
    {-# INLINE singletonMap #-}
    mapFromList :: [(ContainerKey [(key, value)], MapValue [(key, value)])]
-> [(key, value)]
mapFromList = forall a. a -> a
id
    {-# INLINE mapFromList #-}
    mapToList :: [(key, value)]
-> [(ContainerKey [(key, value)], MapValue [(key, value)])]
mapToList = forall a. a -> a
id
    {-# INLINE mapToList #-}

-- | Polymorphic typeclass for interacting with different set types
class (SetContainer set, Element set ~ ContainerKey set) => IsSet set where
    -- | Insert a value into a set.
    insertSet :: Element set -> set -> set

    -- | Delete a value from a set.
    deleteSet :: Element set -> set -> set

    -- | Create a set from a single element.
    singletonSet :: Element set -> set

    -- | Convert a list to a set.
    setFromList :: [Element set] -> set

    -- | Convert a set to a list.
    setToList :: set -> [Element set]

    -- | Filter values in a set.
    --
    -- @since 1.0.12.0
    filterSet :: (Element set -> Bool) -> set -> set
    filterSet Element set -> Bool
p = forall set. IsSet set => [Element set] -> set
setFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Element set -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall set. IsSet set => set -> [Element set]
setToList

instance Ord element => IsSet (Set.Set element) where
    insertSet :: Element (Set element) -> Set element -> Set element
insertSet = forall a. Ord a => a -> Set a -> Set a
Set.insert
    {-# INLINE insertSet #-}
    deleteSet :: Element (Set element) -> Set element -> Set element
deleteSet = forall a. Ord a => a -> Set a -> Set a
Set.delete
    {-# INLINE deleteSet #-}
    singletonSet :: Element (Set element) -> Set element
singletonSet = forall a. a -> Set a
Set.singleton
    {-# INLINE singletonSet #-}
    setFromList :: [Element (Set element)] -> Set element
setFromList = forall a. Ord a => [a] -> Set a
Set.fromList
    {-# INLINE setFromList #-}
    setToList :: Set element -> [Element (Set element)]
setToList = forall a. Set a -> [a]
Set.toList
    {-# INLINE setToList #-}
    filterSet :: (Element (Set element) -> Bool) -> Set element -> Set element
filterSet = forall a. (a -> Bool) -> Set a -> Set a
Set.filter
    {-# INLINE filterSet #-}

instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where
    insertSet :: Element (HashSet element) -> HashSet element -> HashSet element
insertSet = forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert
    {-# INLINE insertSet #-}
    deleteSet :: Element (HashSet element) -> HashSet element -> HashSet element
deleteSet = forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete
    {-# INLINE deleteSet #-}
    singletonSet :: Element (HashSet element) -> HashSet element
singletonSet = forall a. Hashable a => a -> HashSet a
HashSet.singleton
    {-# INLINE singletonSet #-}
    setFromList :: [Element (HashSet element)] -> HashSet element
setFromList = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    {-# INLINE setFromList #-}
    setToList :: HashSet element -> [Element (HashSet element)]
setToList = forall a. HashSet a -> [a]
HashSet.toList
    {-# INLINE setToList #-}
    filterSet :: (Element (HashSet element) -> Bool)
-> HashSet element -> HashSet element
filterSet = forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter
    {-# INLINE filterSet #-}

instance IsSet IntSet.IntSet where
    insertSet :: Element IntSet -> IntSet -> IntSet
insertSet = Int -> IntSet -> IntSet
IntSet.insert
    {-# INLINE insertSet #-}
    deleteSet :: Element IntSet -> IntSet -> IntSet
deleteSet = Int -> IntSet -> IntSet
IntSet.delete
    {-# INLINE deleteSet #-}
    singletonSet :: Element IntSet -> IntSet
singletonSet = Int -> IntSet
IntSet.singleton
    {-# INLINE singletonSet #-}
    setFromList :: [Element IntSet] -> IntSet
setFromList = [Int] -> IntSet
IntSet.fromList
    {-# INLINE setFromList #-}
    setToList :: IntSet -> [Element IntSet]
setToList = IntSet -> [Int]
IntSet.toList
    {-# INLINE setToList #-}
    filterSet :: (Element IntSet -> Bool) -> IntSet -> IntSet
filterSet = (Int -> Bool) -> IntSet -> IntSet
IntSet.filter
    {-# INLINE filterSet #-}


-- | Zip operations on 'MonoFunctor's.
class MonoFunctor mono => MonoZip mono where
    -- | Combine each element of two 'MonoZip's using a supplied function.
    ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono

    -- | Take two 'MonoZip's and return a list of the pairs of their elements.
    ozip :: mono -> mono -> [(Element mono, Element mono)]

    -- | Take a list of pairs of elements and return a 'MonoZip' of the first
    -- components and a 'MonoZip' of the second components.
    ounzip :: [(Element mono, Element mono)] -> (mono, mono)


instance MonoZip ByteString.ByteString where
    ozip :: ByteString
-> ByteString -> [(Element ByteString, Element ByteString)]
ozip     = ByteString -> ByteString -> [(Word8, Word8)]
ByteString.zip
    ounzip :: [(Element ByteString, Element ByteString)]
-> (ByteString, ByteString)
ounzip   = [(Word8, Word8)] -> (ByteString, ByteString)
ByteString.unzip
    ozipWith :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
xs = [Word8] -> ByteString
ByteString.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
ByteString.zipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
xs
    {-# INLINE ozip #-}
    {-# INLINE ounzip #-}
    {-# INLINE ozipWith #-}
instance MonoZip LByteString.ByteString where
    ozip :: ByteString
-> ByteString -> [(Element ByteString, Element ByteString)]
ozip     = ByteString -> ByteString -> [(Word8, Word8)]
LByteString.zip
    ounzip :: [(Element ByteString, Element ByteString)]
-> (ByteString, ByteString)
ounzip   = [(Word8, Word8)] -> (ByteString, ByteString)
LByteString.unzip
    ozipWith :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
xs = [Word8] -> ByteString
LByteString.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
LByteString.zipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
xs
    {-# INLINE ozip #-}
    {-# INLINE ounzip #-}
    {-# INLINE ozipWith #-}
instance MonoZip Text.Text where
    ozip :: Text -> Text -> [(Element Text, Element Text)]
ozip     = Text -> Text -> [(Char, Char)]
Text.zip
    ounzip :: [(Element Text, Element Text)] -> (Text, Text)
ounzip   = ([Char] -> Text
Text.pack forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Char] -> Text
Text.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
List.unzip
    ozipWith :: (Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWith = (Char -> Char -> Char) -> Text -> Text -> Text
Text.zipWith
    {-# INLINE ozip #-}
    {-# INLINE ounzip #-}
    {-# INLINE ozipWith #-}
instance MonoZip LText.Text where
    ozip :: Text -> Text -> [(Element Text, Element Text)]
ozip     = Text -> Text -> [(Char, Char)]
LText.zip
    ounzip :: [(Element Text, Element Text)] -> (Text, Text)
ounzip   = ([Char] -> Text
LText.pack forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Char] -> Text
LText.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
List.unzip
    ozipWith :: (Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWith = (Char -> Char -> Char) -> Text -> Text -> Text
LText.zipWith
    {-# INLINE ozip #-}
    {-# INLINE ounzip #-}
    {-# INLINE ozipWith #-}

-- | Type class for maps whose keys can be converted into sets.
class SetContainer set => HasKeysSet set where
    -- | Type of the key set.
    type KeySet set

    -- | Convert a map into a set of its keys.
    keysSet :: set -> KeySet set

instance Ord k => HasKeysSet (Map.Map k v) where
    type KeySet (Map.Map k v) = Set.Set k
    keysSet :: Map k v -> KeySet (Map k v)
keysSet = forall k a. Map k a -> Set k
Map.keysSet
instance HasKeysSet (IntMap.IntMap v) where
    type KeySet (IntMap.IntMap v) = IntSet.IntSet
    keysSet :: IntMap v -> KeySet (IntMap v)
keysSet = forall a. IntMap a -> IntSet
IntMap.keysSet
instance (Hashable k, Eq k) => HasKeysSet (HashMap.HashMap k v) where
    type KeySet (HashMap.HashMap k v) = HashSet.HashSet k
    keysSet :: HashMap k v -> KeySet (HashMap k v)
keysSet = forall set. IsSet set => [Element set] -> set
setFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [k]
HashMap.keys