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
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
notMember = Map.notMember
union = Map.union
unions = Map.unions . otoList
difference = Map.difference
intersection = Map.intersection
keys = Map.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
notMember k = not . HashMap.member k
union = HashMap.union
unions = HashMap.unions . otoList
difference = HashMap.difference
intersection = HashMap.intersection
keys = HashMap.keys
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance SetContainer (IntMap.IntMap value) where
type ContainerKey (IntMap.IntMap value) = Int
member = IntMap.member
notMember = IntMap.notMember
union = IntMap.union
unions = IntMap.unions . otoList
difference = IntMap.difference
intersection = IntMap.intersection
keys = IntMap.keys
instance Ord element => SetContainer (Set.Set element) where
type ContainerKey (Set.Set element) = element
member = Set.member
notMember = Set.notMember
union = Set.union
unions = Set.unions . otoList
difference = Set.difference
intersection = Set.intersection
keys = Set.toList
instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where
type ContainerKey (HashSet.HashSet element) = element
member = HashSet.member
notMember e = not . HashSet.member e
union = HashSet.union
difference = HashSet.difference
intersection = HashSet.intersection
keys = HashSet.toList
instance SetContainer IntSet.IntSet where
type ContainerKey IntSet.IntSet = Int
member = IntSet.member
notMember = IntSet.notMember
union = IntSet.union
difference = IntSet.difference
intersection = IntSet.intersection
keys = IntSet.toList
instance Eq key => SetContainer [(key, value)] where
type ContainerKey [(key, value)] = key
member k = List.any ((== k) . fst)
notMember k = not . member k
union = List.unionBy ((==) `on` fst)
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)
keys = map fst
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
intersectionMap = Map.intersection
intersectionWithMap = Map.intersectionWith
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where
differenceMap = HashMap.difference
intersectionMap = HashMap.intersection
intersectionWithMap = HashMap.intersectionWith
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance PolyMap IntMap.IntMap where
differenceMap = IntMap.difference
intersectionMap = IntMap.intersection
intersectionWithMap = IntMap.intersectionWith
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
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)]
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)]
#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
insertMap = Map.insert
deleteMap = Map.delete
singletonMap = Map.singleton
mapFromList = Map.fromList
mapToList = Map.toList
findWithDefault = Map.findWithDefault
insertWith = Map.insertWith
insertWithKey = Map.insertWithKey
insertLookupWithKey = Map.insertLookupWithKey
adjustMap = Map.adjust
adjustWithKey = Map.adjustWithKey
updateMap = Map.update
updateWithKey = Map.updateWithKey
updateLookupWithKey = Map.updateLookupWithKey
alterMap = Map.alter
unionWith = Map.unionWith
unionWithKey = Map.unionWithKey
unionsWith = Map.unionsWith
mapWithKey = Map.mapWithKey
omapKeysWith = Map.mapKeysWith
#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
insertMap = HashMap.insert
deleteMap = HashMap.delete
singletonMap = HashMap.singleton
mapFromList = HashMap.fromList
mapToList = HashMap.toList
insertWith = HashMap.insertWith
adjustMap = HashMap.adjust
unionWith = HashMap.unionWith
#if MIN_VERSION_containers(0, 5, 0)
#endif
instance IsMap (IntMap.IntMap value) where
type MapValue (IntMap.IntMap value) = value
lookup = IntMap.lookup
insertMap = IntMap.insert
deleteMap = IntMap.delete
singletonMap = IntMap.singleton
mapFromList = IntMap.fromList
mapToList = IntMap.toList
findWithDefault = IntMap.findWithDefault
insertWith = IntMap.insertWith
insertWithKey = IntMap.insertWithKey
insertLookupWithKey = IntMap.insertLookupWithKey
adjustMap = IntMap.adjust
adjustWithKey = IntMap.adjustWithKey
updateMap = IntMap.update
updateWithKey = IntMap.updateWithKey
alterMap = IntMap.alter
unionWith = IntMap.unionWith
unionWithKey = IntMap.unionWithKey
unionsWith = IntMap.unionsWith
mapWithKey = IntMap.mapWithKey
#if MIN_VERSION_containers(0, 5, 0)
omapKeysWith = IntMap.mapKeysWith
#endif
instance Eq key => IsMap [(key, value)] where
type MapValue [(key, value)] = value
lookup = List.lookup
insertMap k v = ((k, v):) . deleteMap k
deleteMap k = List.filter ((/= k) . fst)
singletonMap k v = [(k, v)]
mapFromList = id
mapToList = id
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
deleteSet = Set.delete
singletonSet = Set.singleton
setFromList = Set.fromList
setToList = Set.toList
instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where
insertSet = HashSet.insert
deleteSet = HashSet.delete
singletonSet = HashSet.singleton
setFromList = HashSet.fromList
setToList = HashSet.toList
instance IsSet IntSet.IntSet where
insertSet = IntSet.insert
deleteSet = IntSet.delete
singletonSet = IntSet.singleton
setFromList = IntSet.fromList
setToList = IntSet.toList
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
instance MonoZip LByteString.ByteString where
ozip = LByteString.zip
ounzip = LByteString.unzip
ozipWith f xs = LByteString.pack . LByteString.zipWith f xs
instance MonoZip Text.Text where
ozip = Text.zip
ounzip = (Text.pack *** Text.pack) . List.unzip
ozipWith = Text.zipWith
instance MonoZip LText.Text where
ozip = LText.zip
ounzip = (LText.pack *** LText.pack) . List.unzip
ozipWith = LText.zipWith
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