{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
module Data.Containers where
import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)
#if MIN_VERSION_containers(0, 5, 0)
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
#else
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
#endif
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.Semigroup (Semigroup)
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)
class (Data.Monoid.Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where
type ContainerKey set
member :: ContainerKey set -> set -> Bool
notMember :: ContainerKey set -> set -> Bool
union :: set -> set -> set
unions :: (MonoFoldable mono, Element mono ~ set) => mono -> set
unions = ofoldl' union Data.Monoid.mempty
{-# INLINE unions #-}
difference :: set -> set -> set
intersection :: set -> set -> set
keys :: set -> [ContainerKey set]
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance Ord k => SetContainer (Map.Map k v) where
type ContainerKey (Map.Map k v) = k
member = Map.member
{-# INLINE member #-}
notMember = Map.notMember
{-# INLINE notMember #-}
union = Map.union
{-# INLINE union #-}
unions = Map.unions . otoList
{-# INLINE unions #-}
difference = Map.difference
{-# INLINE difference #-}
intersection = Map.intersection
{-# INLINE intersection #-}
keys = Map.keys
{-# INLINE keys #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where
type ContainerKey (HashMap.HashMap key value) = key
member = HashMap.member
{-# INLINE member #-}
notMember k = not . HashMap.member k
{-# INLINE notMember #-}
union = HashMap.union
{-# INLINE union #-}
unions = HashMap.unions . otoList
{-# INLINE unions #-}
difference = HashMap.difference
{-# INLINE difference #-}
intersection = HashMap.intersection
{-# INLINE intersection #-}
keys = HashMap.keys
{-# INLINE keys #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance SetContainer (IntMap.IntMap value) where
type ContainerKey (IntMap.IntMap value) = Int
member = IntMap.member
{-# INLINE member #-}
notMember = IntMap.notMember
{-# INLINE notMember #-}
union = IntMap.union
{-# INLINE union #-}
unions = IntMap.unions . otoList
{-# INLINE unions #-}
difference = IntMap.difference
{-# INLINE difference #-}
intersection = IntMap.intersection
{-# INLINE intersection #-}
keys = IntMap.keys
{-# INLINE keys #-}
instance Ord element => SetContainer (Set.Set element) where
type ContainerKey (Set.Set element) = element
member = Set.member
{-# INLINE member #-}
notMember = Set.notMember
{-# INLINE notMember #-}
union = Set.union
{-# INLINE union #-}
unions = Set.unions . otoList
{-# INLINE unions #-}
difference = Set.difference
{-# INLINE difference #-}
intersection = Set.intersection
{-# INLINE intersection #-}
keys = Set.toList
{-# INLINE keys #-}
instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where
type ContainerKey (HashSet.HashSet element) = element
member = HashSet.member
{-# INLINE member #-}
notMember e = not . HashSet.member e
{-# INLINE notMember #-}
union = HashSet.union
{-# INLINE union #-}
difference = HashSet.difference
{-# INLINE difference #-}
intersection = HashSet.intersection
{-# INLINE intersection #-}
keys = HashSet.toList
{-# INLINE keys #-}
instance SetContainer IntSet.IntSet where
type ContainerKey IntSet.IntSet = Int
member = IntSet.member
{-# INLINE member #-}
notMember = IntSet.notMember
{-# INLINE notMember #-}
union = IntSet.union
{-# INLINE union #-}
difference = IntSet.difference
{-# INLINE difference #-}
intersection = IntSet.intersection
{-# INLINE intersection #-}
keys = IntSet.toList
{-# INLINE keys #-}
instance Eq key => SetContainer [(key, value)] where
type ContainerKey [(key, value)] = key
member k = List.any ((== k) . fst)
{-# INLINE member #-}
notMember k = not . member k
{-# INLINE notMember #-}
union = List.unionBy ((==) `on` fst)
{-# INLINE union #-}
x `difference` y =
loop x
where
loop [] = []
loop ((k, v):rest) =
case lookup k y of
Nothing -> (k, v) : loop rest
Just _ -> loop rest
intersection = List.intersectBy ((==) `on` fst)
{-# INLINE intersection #-}
keys = map fst
{-# INLINE keys #-}
class PolyMap map where
differenceMap :: map value1 -> map value2 -> map value1
intersectionMap :: map value1 -> map value2 -> map value1
intersectionWithMap :: (value1 -> value2 -> value3)
-> map value1 -> map value2 -> map value3
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance Ord key => PolyMap (Map.Map key) where
differenceMap = Map.difference
{-# INLINE differenceMap #-}
intersectionMap = Map.intersection
{-# INLINE intersectionMap #-}
intersectionWithMap = Map.intersectionWith
{-# INLINE intersectionWithMap #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where
differenceMap = HashMap.difference
{-# INLINE differenceMap #-}
intersectionMap = HashMap.intersection
{-# INLINE intersectionMap #-}
intersectionWithMap = HashMap.intersectionWith
{-# INLINE intersectionWithMap #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance PolyMap IntMap.IntMap where
differenceMap = IntMap.difference
{-# INLINE differenceMap #-}
intersectionMap = IntMap.intersection
{-# INLINE intersectionMap #-}
intersectionWithMap = IntMap.intersectionWith
{-# INLINE intersectionWithMap #-}
class BiPolyMap map where
type BPMKeyConstraint map key :: Constraint
mapKeysWith :: (BPMKeyConstraint map k1, BPMKeyConstraint map k2)
=> (v -> v -> v)
-> (k1 -> k2)
-> map k1 v
-> map k2 v
instance BiPolyMap Map.Map where
type BPMKeyConstraint Map.Map key = Ord key
mapKeysWith = Map.mapKeysWith
{-# INLINE mapKeysWith #-}
instance BiPolyMap HashMap.HashMap where
type BPMKeyConstraint HashMap.HashMap key = (Hashable key, Eq key)
mapKeysWith g f =
mapFromList . unionsWith g . map go . mapToList
where
go (k, v) = [(f k, v)]
{-# INLINE mapKeysWith #-}
class (MonoTraversable map, SetContainer map) => IsMap map where
type MapValue map
lookup :: ContainerKey map -> map -> Maybe (MapValue map)
insertMap :: ContainerKey map -> MapValue map -> map -> map
deleteMap :: ContainerKey map -> map -> map
singletonMap :: ContainerKey map -> MapValue map -> map
mapFromList :: [(ContainerKey map, MapValue map)] -> map
mapToList :: map -> [(ContainerKey map, MapValue map)]
findWithDefault :: MapValue map -> ContainerKey map -> map -> MapValue map
findWithDefault def key = fromMaybe def . lookup key
insertWith :: (MapValue map -> MapValue map -> MapValue map)
-> ContainerKey map
-> MapValue map
-> map
-> map
insertWith f k v m =
v' `seq` insertMap k v' m
where
v' =
case lookup k m of
Nothing -> v
Just vold -> f v vold
insertWithKey
:: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
-> ContainerKey map
-> MapValue map
-> map
-> map
insertWithKey f k v m =
v' `seq` insertMap k v' m
where
v' =
case lookup k m of
Nothing -> v
Just vold -> f k v vold
insertLookupWithKey
:: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
-> ContainerKey map
-> MapValue map
-> map
-> (Maybe (MapValue map), map)
insertLookupWithKey f k v m =
v' `seq` (mold, insertMap k v' m)
where
(mold, v') =
case lookup k m of
Nothing -> (Nothing, v)
Just vold -> (Just vold, f k v vold)
adjustMap
:: (MapValue map -> MapValue map)
-> ContainerKey map
-> map
-> map
adjustMap f k m =
case lookup k m of
Nothing -> m
Just v ->
let v' = f v
in v' `seq` insertMap k v' m
adjustWithKey
:: (ContainerKey map -> MapValue map -> MapValue map)
-> ContainerKey map
-> map
-> map
adjustWithKey f k m =
case lookup k m of
Nothing -> m
Just v ->
let v' = f k v
in v' `seq` insertMap k v' m
updateMap
:: (MapValue map -> Maybe (MapValue map))
-> ContainerKey map
-> map
-> map
updateMap f k m =
case lookup k m of
Nothing -> m
Just v ->
case f v of
Nothing -> deleteMap k m
Just v' -> v' `seq` insertMap k v' m
updateWithKey
:: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
-> ContainerKey map
-> map
-> map
updateWithKey f k m =
case lookup k m of
Nothing -> m
Just v ->
case f k v of
Nothing -> deleteMap k m
Just v' -> v' `seq` insertMap k v' m
updateLookupWithKey
:: (ContainerKey map -> MapValue map -> Maybe (MapValue map))
-> ContainerKey map
-> map
-> (Maybe (MapValue map), map)
updateLookupWithKey f k m =
case lookup k m of
Nothing -> (Nothing, m)
Just v ->
case f k v of
Nothing -> (Just v, deleteMap k m)
Just v' -> v' `seq` (Just v', insertMap k v' m)
alterMap
:: (Maybe (MapValue map) -> Maybe (MapValue map))
-> ContainerKey map
-> map
-> map
alterMap f k m =
case f mold of
Nothing ->
case mold of
Nothing -> m
Just _ -> deleteMap k m
Just v -> insertMap k v m
where
mold = lookup k m
unionWith
:: (MapValue map -> MapValue map -> MapValue map)
-> map
-> map
-> map
unionWith f x y =
mapFromList $ loop $ mapToList x ++ mapToList y
where
loop [] = []
loop ((k, v):rest) =
case List.lookup k rest of
Nothing -> (k, v) : loop rest
Just v' -> (k, f v v') : loop (deleteMap k rest)
unionWithKey
:: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map)
-> map
-> map
-> map
unionWithKey f x y =
mapFromList $ loop $ mapToList x ++ mapToList y
where
loop [] = []
loop ((k, v):rest) =
case List.lookup k rest of
Nothing -> (k, v) : loop rest
Just v' -> (k, f k v v') : loop (deleteMap k rest)
unionsWith
:: (MapValue map -> MapValue map -> MapValue map)
-> [map]
-> map
unionsWith _ [] = mempty
unionsWith _ [x] = x
unionsWith f (x:y:z) = unionsWith f (unionWith f x y:z)
mapWithKey
:: (ContainerKey map -> MapValue map -> MapValue map)
-> map
-> map
mapWithKey f =
mapFromList . map go . mapToList
where
go (k, v) = (k, f k v)
omapKeysWith
:: (MapValue map -> MapValue map -> MapValue map)
-> (ContainerKey map -> ContainerKey map)
-> map
-> map
omapKeysWith g f =
mapFromList . unionsWith g . map go . mapToList
where
go (k, v) = [(f k, v)]
filterMap :: IsMap map => (MapValue map -> Bool) -> map -> map
filterMap p = mapFromList . filter (p . snd) . mapToList
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance Ord key => IsMap (Map.Map key value) where
type MapValue (Map.Map key value) = value
lookup = Map.lookup
{-# INLINE lookup #-}
insertMap = Map.insert
{-# INLINE insertMap #-}
deleteMap = Map.delete
{-# INLINE deleteMap #-}
singletonMap = Map.singleton
{-# INLINE singletonMap #-}
mapFromList = Map.fromList
{-# INLINE mapFromList #-}
mapToList = Map.toList
{-# INLINE mapToList #-}
findWithDefault = Map.findWithDefault
{-# INLINE findWithDefault #-}
insertWith = Map.insertWith
{-# INLINE insertWith #-}
insertWithKey = Map.insertWithKey
{-# INLINE insertWithKey #-}
insertLookupWithKey = Map.insertLookupWithKey
{-# INLINE insertLookupWithKey #-}
adjustMap = Map.adjust
{-# INLINE adjustMap #-}
adjustWithKey = Map.adjustWithKey
{-# INLINE adjustWithKey #-}
updateMap = Map.update
{-# INLINE updateMap #-}
updateWithKey = Map.updateWithKey
{-# INLINE updateWithKey #-}
updateLookupWithKey = Map.updateLookupWithKey
{-# INLINE updateLookupWithKey #-}
alterMap = Map.alter
{-# INLINE alterMap #-}
unionWith = Map.unionWith
{-# INLINE unionWith #-}
unionWithKey = Map.unionWithKey
{-# INLINE unionWithKey #-}
unionsWith = Map.unionsWith
{-# INLINE unionsWith #-}
mapWithKey = Map.mapWithKey
{-# INLINE mapWithKey #-}
omapKeysWith = Map.mapKeysWith
{-# INLINE omapKeysWith #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where
type MapValue (HashMap.HashMap key value) = value
lookup = HashMap.lookup
{-# INLINE lookup #-}
insertMap = HashMap.insert
{-# INLINE insertMap #-}
deleteMap = HashMap.delete
{-# INLINE deleteMap #-}
singletonMap = HashMap.singleton
{-# INLINE singletonMap #-}
mapFromList = HashMap.fromList
{-# INLINE mapFromList #-}
mapToList = HashMap.toList
{-# INLINE mapToList #-}
insertWith = HashMap.insertWith
{-# INLINE insertWith #-}
adjustMap = HashMap.adjust
{-# INLINE adjustMap #-}
unionWith = HashMap.unionWith
{-# INLINE unionWith #-}
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance IsMap (IntMap.IntMap value) where
type MapValue (IntMap.IntMap value) = value
lookup = IntMap.lookup
{-# INLINE lookup #-}
insertMap = IntMap.insert
{-# INLINE insertMap #-}
deleteMap = IntMap.delete
{-# INLINE deleteMap #-}
singletonMap = IntMap.singleton
{-# INLINE singletonMap #-}
mapFromList = IntMap.fromList
{-# INLINE mapFromList #-}
mapToList = IntMap.toList
{-# INLINE mapToList #-}
findWithDefault = IntMap.findWithDefault
{-# INLINE findWithDefault #-}
insertWith = IntMap.insertWith
{-# INLINE insertWith #-}
insertWithKey = IntMap.insertWithKey
{-# INLINE insertWithKey #-}
insertLookupWithKey = IntMap.insertLookupWithKey
{-# INLINE insertLookupWithKey #-}
adjustMap = IntMap.adjust
{-# INLINE adjustMap #-}
adjustWithKey = IntMap.adjustWithKey
{-# INLINE adjustWithKey #-}
updateMap = IntMap.update
{-# INLINE updateMap #-}
updateWithKey = IntMap.updateWithKey
{-# INLINE updateWithKey #-}
alterMap = IntMap.alter
{-# INLINE alterMap #-}
unionWith = IntMap.unionWith
{-# INLINE unionWith #-}
unionWithKey = IntMap.unionWithKey
{-# INLINE unionWithKey #-}
unionsWith = IntMap.unionsWith
{-# INLINE unionsWith #-}
mapWithKey = IntMap.mapWithKey
{-# INLINE mapWithKey #-}
#if MIN_VERSION_containers(0, 5, 0)
omapKeysWith = IntMap.mapKeysWith
{-# INLINE omapKeysWith #-}
#endif
instance Eq key => IsMap [(key, value)] where
type MapValue [(key, value)] = value
lookup = List.lookup
{-# INLINE lookup #-}
insertMap k v = ((k, v):) . deleteMap k
{-# INLINE insertMap #-}
deleteMap k = List.filter ((/= k) . fst)
{-# INLINE deleteMap #-}
singletonMap k v = [(k, v)]
{-# INLINE singletonMap #-}
mapFromList = id
{-# INLINE mapFromList #-}
mapToList = id
{-# INLINE mapToList #-}
class (SetContainer set, Element set ~ ContainerKey set) => IsSet set where
insertSet :: Element set -> set -> set
deleteSet :: Element set -> set -> set
singletonSet :: Element set -> set
setFromList :: [Element set] -> set
setToList :: set -> [Element set]
instance Ord element => IsSet (Set.Set element) where
insertSet = Set.insert
{-# INLINE insertSet #-}
deleteSet = Set.delete
{-# INLINE deleteSet #-}
singletonSet = Set.singleton
{-# INLINE singletonSet #-}
setFromList = Set.fromList
{-# INLINE setFromList #-}
setToList = Set.toList
{-# INLINE setToList #-}
instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where
insertSet = HashSet.insert
{-# INLINE insertSet #-}
deleteSet = HashSet.delete
{-# INLINE deleteSet #-}
singletonSet = HashSet.singleton
{-# INLINE singletonSet #-}
setFromList = HashSet.fromList
{-# INLINE setFromList #-}
setToList = HashSet.toList
{-# INLINE setToList #-}
instance IsSet IntSet.IntSet where
insertSet = IntSet.insert
{-# INLINE insertSet #-}
deleteSet = IntSet.delete
{-# INLINE deleteSet #-}
singletonSet = IntSet.singleton
{-# INLINE singletonSet #-}
setFromList = IntSet.fromList
{-# INLINE setFromList #-}
setToList = IntSet.toList
{-# INLINE setToList #-}
class MonoFunctor mono => MonoZip mono where
ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono
ozip :: mono -> mono -> [(Element mono, Element mono)]
ounzip :: [(Element mono, Element mono)] -> (mono, mono)
instance MonoZip ByteString.ByteString where
ozip = ByteString.zip
ounzip = ByteString.unzip
ozipWith f xs = ByteString.pack . ByteString.zipWith f xs
{-# INLINE ozip #-}
{-# INLINE ounzip #-}
{-# INLINE ozipWith #-}
instance MonoZip LByteString.ByteString where
ozip = LByteString.zip
ounzip = LByteString.unzip
ozipWith f xs = LByteString.pack . LByteString.zipWith f xs
{-# INLINE ozip #-}
{-# INLINE ounzip #-}
{-# INLINE ozipWith #-}
instance MonoZip Text.Text where
ozip = Text.zip
ounzip = (Text.pack *** Text.pack) . List.unzip
ozipWith = Text.zipWith
{-# INLINE ozip #-}
{-# INLINE ounzip #-}
{-# INLINE ozipWith #-}
instance MonoZip LText.Text where
ozip = LText.zip
ounzip = (LText.pack *** LText.pack) . List.unzip
ozipWith = LText.zipWith
{-# INLINE ozip #-}
{-# INLINE ounzip #-}
{-# INLINE ozipWith #-}
class SetContainer set => HasKeysSet set where
type KeySet set
keysSet :: set -> KeySet set
instance Ord k => HasKeysSet (Map.Map k v) where
type KeySet (Map.Map k v) = Set.Set k
keysSet = Map.keysSet
instance HasKeysSet (IntMap.IntMap v) where
type KeySet (IntMap.IntMap v) = IntSet.IntSet
keysSet = IntMap.keysSet
instance (Hashable k, Eq k) => HasKeysSet (HashMap.HashMap k v) where
type KeySet (HashMap.HashMap k v) = HashSet.HashSet k
keysSet = setFromList . HashMap.keys