{-# language CPP #-}
{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language RankNTypes #-}
{-# language StandaloneDeriving #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Data.Dependent.HashMap
( DHashMap
, empty
, singleton
, null
, size
, member
, lookup
, lookupDefault
, (!)
, insert
, insertWith
, delete
, adjust
, update
, alter
, alterF
, alterLookup
, union
, unionWith
, unionWithKey
, unions
, unionsWith
, unionsWithKey
, map
, mapWithKey
, traverse
, traverseWithKey
, difference
, differenceWith
, differenceWithKey
, intersection
, intersectionWith
, intersectionWithKey
, foldMap
, foldMapWithKey
, foldl
, foldlWithKey
, foldl'
, foldlWithKey'
, foldr
, foldrWithKey
, filter
, filterWithKey
, mapMaybe
, mapMaybeWithKey
, keys
, elems
, toList
, fromList
, fromListWith
, fromListWithKey
, DSum ((:=>))
, Some (Some)
)
where
import Prelude hiding (lookup, null, map, traverse, foldMap, foldl, foldr, filter)
import qualified Prelude
import Data.Constraint.Extras
import Data.Dependent.Sum
import qualified Data.Foldable as Foldable
import Data.GADT.Compare (GCompare, GEq, geq)
import Data.GADT.Show
import Data.Hashable
import qualified Data.HashMap.Lazy as HashMap
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
import Data.Some
import Data.Type.Equality
import GHC.Exts (IsList(Item))
import qualified GHC.Exts
import Text.Read
newtype DHashMap k v =
DHashMap (HashMap.HashMap (Some k) (DSum k v))
deriving instance (GEq k, Has' Eq k v) => Eq (DHashMap k v)
deriving instance (GCompare k, Has' Eq k v, Has' Ord k v) => Ord (DHashMap k v)
deriving instance (GEq k, Hashable (Some k)) => Semigroup (DHashMap k v)
deriving instance (GEq k, Hashable (Some k)) => Monoid (DHashMap k v)
instance (GEq k, Hashable (Some k)) => IsList (DHashMap k v) where
type Item (DHashMap k v) = DSum k v
fromList =
Data.Dependent.HashMap.fromList
toList =
Data.Dependent.HashMap.toList
instance (GEq k, GRead k, Has' Read k v, Hashable (Some k)) => Read (DHashMap k v) where
readPrec =
parens $ prec 10 $ do
Ident "fromList" <- lexP
xs <- readPrec
return (fromList xs)
readListPrec = readListPrecDefault
instance (GShow k, Has' Show k v) => Show (DHashMap k v) where
showsPrec p m =
showParen (p > 10) $
showString "fromList " .
showsPrec 11 (Data.Dependent.HashMap.toList m)
empty :: DHashMap k v
empty =
DHashMap HashMap.empty
singleton
:: Hashable (Some k)
=> k a
-> v a
-> DHashMap k v
singleton k v =
DHashMap $ HashMap.singleton (Some k) (k :=> v)
null :: DHashMap k v -> Bool
null (DHashMap h) =
HashMap.null h
size :: DHashMap k v -> Int
size (DHashMap h) =
HashMap.size h
member
:: (GEq k, Hashable (Some k))
=> k a
-> DHashMap k v
-> Bool
member k (DHashMap h) =
HashMap.member (Some k) h
lookup
:: (GEq k, Hashable (Some k))
=> k a
-> DHashMap k v
-> Maybe (v a)
lookup k (DHashMap h) =
case HashMap.lookup (Some k) h of
Just (k' :=> v)
| Just Refl <- geq k k' ->
Just v
_ ->
Nothing
lookupDefault
:: (GEq k, Hashable (Some k))
=> v a
-> k a
-> DHashMap k v
-> v a
lookupDefault default_ k (DHashMap h) =
case HashMap.lookupDefault (k :=> default_) (Some k) h of
k' :=> v
| Just Refl <- geq k k' ->
v
| otherwise ->
error "Data.Dependent.HashMap.lookupDefault: key mismatch"
(!)
:: (GEq k, Hashable (Some k))
=> DHashMap k v
-> k a
-> v a
DHashMap h ! k =
case h HashMap.! Some k of
k' :=> v
| Just Refl <- geq k k' ->
v
| otherwise ->
error "Data.Dependent.HashMap.(!): key mismatch"
insert
:: (GEq k, Hashable (Some k))
=> k a
-> v a
-> DHashMap k v
-> DHashMap k v
insert k v (DHashMap h) =
DHashMap $ HashMap.insert (Some k) (k :=> v) h
insertWith
:: (GEq k, Hashable (Some k))
=> (v a -> v a -> v a)
-> k a
-> v a
-> DHashMap k v
-> DHashMap k v
insertWith f k v (DHashMap h) =
DHashMap $
HashMap.insertWith
(\(k1 :=> v1) (k2 :=> v2) ->
case (geq k k1, geq k k2) of
(Just Refl, Just Refl) ->
k :=> f v1 v2
_ ->
error "Data.Dependent.HashMap.insertWith: key mismatch"
)
(Some k)
(k :=> v)
h
delete
:: (GEq k, Hashable (Some k))
=> k a
-> DHashMap k v
-> DHashMap k v
delete k (DHashMap h) =
DHashMap $ HashMap.delete (Some k) h
adjust
:: (GEq k, Hashable (Some k))
=> (v a -> v a)
-> k a
-> DHashMap k v
-> DHashMap k v
adjust f k (DHashMap h) =
DHashMap $
HashMap.adjust
(\(k' :=> v) ->
case geq k k' of
Just Refl ->
k :=> f v
_ ->
error "Data.Dependent.HashMap.adjust: key mismatch"
)
(Some k)
h
update
:: (GEq k, Hashable (Some k))
=> (v a -> Maybe (v a))
-> k a
-> DHashMap k v
-> DHashMap k v
update f k (DHashMap h) =
DHashMap $
HashMap.update
(\(k' :=> v) ->
case geq k k' of
Just Refl ->
(k :=>) <$> f v
_ ->
error "Data.Dependent.HashMap.update: key mismatch"
)
(Some k)
h
alter
:: (GEq k, Hashable (Some k))
=> (Maybe (v a) -> Maybe (v a))
-> k a
-> DHashMap k v
-> DHashMap k v
alter f k (DHashMap h) =
DHashMap $
HashMap.alter
(\kv ->
(k :=>) <$>
case kv of
Just (k' :=> v)
| Just Refl <- geq k k' ->
f (Just v)
_ ->
f Nothing
)
(Some k)
h
alterF
:: (Functor f, GEq k, Hashable (Some k))
=> (Maybe (v a) -> f (Maybe (v a)))
-> k a
-> DHashMap k v
-> f (DHashMap k v)
alterF f k (DHashMap h) =
DHashMap <$>
HashMap.alterF
(\mkv ->
fmap (k :=>) <$>
case mkv of
Just (k' :=> v)
| Just Refl <- geq k k' ->
f (Just v)
_ ->
f Nothing
)
(Some k)
h
alterLookup
:: (GEq k, Hashable (Some k))
=> (Maybe (v a) -> Maybe (v a))
-> k a
-> DHashMap k v
-> (Maybe (v a), DHashMap k v)
alterLookup f k =
alterF (\mv' -> (mv', f mv')) k
union
:: (GEq k, Hashable (Some k))
=> DHashMap k v
-> DHashMap k v
-> DHashMap k v
union = (<>)
unionWith
:: (GEq k, Hashable (Some k))
=> (forall a. v a -> v a -> v a)
-> DHashMap k v
-> DHashMap k v
-> DHashMap k v
unionWith f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.unionWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f v1 v2
_ ->
error "Data.Dependent.HashMap.unionWith: key mismatch"
)
h1
h2
unionWithKey
:: (GEq k, Hashable (Some k))
=> (forall a. k a -> v a -> v a -> v a)
-> DHashMap k v
-> DHashMap k v
-> DHashMap k v
unionWithKey f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.unionWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f k1 v1 v2
_ ->
error "Data.Dependent.HashMap.unionWithKey: key mismatch"
)
h1
h2
unions
:: (GEq k, Hashable (Some k), Foldable f)
=> f (DHashMap k v)
-> DHashMap k v
unions =
Foldable.foldl' union empty
unionsWith
:: (GEq k, Hashable (Some k), Foldable f)
=> (forall a. v a -> v a -> v a)
-> f (DHashMap k v)
-> DHashMap k v
unionsWith f =
Foldable.foldl' (unionWith f) empty
unionsWithKey
:: (GEq k, Hashable (Some k), Foldable f)
=> (forall a. k a -> v a -> v a -> v a)
-> f (DHashMap k v)
-> DHashMap k v
unionsWithKey f =
Foldable.foldl' (unionWithKey f) empty
map :: (forall a. v a -> v' a) -> DHashMap k v -> DHashMap k v'
map f (DHashMap h) =
DHashMap $ HashMap.map (\(k :=> v) -> (k :=> f v)) h
mapWithKey :: (forall a. k a -> v a -> v' a) -> DHashMap k v -> DHashMap k v'
mapWithKey f (DHashMap h) =
DHashMap $ HashMap.map (\(k :=> v) -> (k :=> f k v)) h
traverse
:: Applicative f
=> (forall a. v a -> f (v' a))
-> DHashMap k v
-> f (DHashMap k v')
traverse f (DHashMap h) =
DHashMap <$>
Prelude.traverse (\(k :=> v) -> (k :=>) <$> f v) h
traverseWithKey
:: Applicative f
=> (forall a. k a -> v a -> f (v' a))
-> DHashMap k v
-> f (DHashMap k v')
traverseWithKey f (DHashMap h) =
DHashMap <$>
Prelude.traverse (\(k :=> v) -> (k :=>) <$> f k v) h
difference
:: (GEq k, Hashable (Some k))
=> DHashMap k v
-> DHashMap k v'
-> DHashMap k v
difference (DHashMap h1) (DHashMap h2) =
DHashMap $ HashMap.difference h1 h2
differenceWith
:: (GEq k, Hashable (Some k))
=> (forall a. v a -> v' a -> Maybe (v a))
-> DHashMap k v
-> DHashMap k v'
-> DHashMap k v
differenceWith f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.differenceWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
(k1 :=>) <$> f v1 v2
Nothing ->
error "Data.Dependent.HashMap.differenceWith: key mismatch"
)
h1
h2
differenceWithKey
:: (GEq k, Hashable (Some k))
=> (forall a. k a -> v a -> v' a -> Maybe (v a))
-> DHashMap k v
-> DHashMap k v'
-> DHashMap k v
differenceWithKey f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.differenceWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
(k1 :=>) <$> f k1 v1 v2
Nothing ->
error "Data.Dependent.HashMap.differenceWithKey: key mismatch"
)
h1
h2
intersection :: (GEq k, Hashable (Some k)) => DHashMap k v -> DHashMap k v' -> DHashMap k v
intersection (DHashMap h1) (DHashMap h2) =
DHashMap $ HashMap.intersection h1 h2
intersectionWith
:: (GEq k, Hashable (Some k))
=> (forall a. v1 a -> v2 a -> v3 a)
-> DHashMap k v1
-> DHashMap k v2
-> DHashMap k v3
intersectionWith f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.intersectionWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f v1 v2
Nothing ->
error "Data.Dependent.HashMap.intersectionWith: key mismatch"
)
h1
h2
intersectionWithKey
:: (GEq k, Hashable (Some k))
=> (forall a. k a -> v1 a -> v2 a -> v3 a)
-> DHashMap k v1
-> DHashMap k v2
-> DHashMap k v3
intersectionWithKey f (DHashMap h1) (DHashMap h2) =
DHashMap $
HashMap.intersectionWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f k1 v1 v2
Nothing ->
error "Data.Dependent.HashMap.intersectionWithKey: key mismatch"
)
h1
h2
foldMap :: Monoid m => (forall a. v a -> m) -> DHashMap k v -> m
foldMap f (DHashMap h) =
Prelude.foldMap (\(_ :=> v) -> f v) h
foldMapWithKey :: Monoid m => (forall a. k a -> v a -> m) -> DHashMap k v -> m
foldMapWithKey f (DHashMap h) =
Prelude.foldMap (\(k :=> v) -> f k v) h
foldl :: (forall a. b -> v a -> b) -> b -> DHashMap k v -> b
foldl f base (DHashMap h) =
Prelude.foldl (\b (_ :=> v) -> f b v) base h
foldlWithKey :: (forall a. b -> k a -> v a -> b) -> b -> DHashMap k v -> b
foldlWithKey f base (DHashMap h) =
Prelude.foldl (\b (k :=> v) -> f b k v) base h
foldl' :: (forall a. b -> v a -> b) -> b -> DHashMap k v -> b
foldl' f base (DHashMap h) =
HashMap.foldl' (\b (_ :=> v) -> f b v) base h
foldlWithKey' :: (forall a. b -> k a -> v a -> b) -> b -> DHashMap k v -> b
foldlWithKey' f base (DHashMap h) =
HashMap.foldl' (\b (k :=> v) -> f b k v) base h
foldr :: (forall a. v a -> b -> b) -> b -> DHashMap k v -> b
foldr f base (DHashMap h) =
HashMap.foldr (\(_ :=> v) -> f v) base h
foldrWithKey :: (forall a. k a -> v a -> b -> b) -> b -> DHashMap k v -> b
foldrWithKey f base (DHashMap h) =
HashMap.foldr (\(k :=> v) -> f k v) base h
filter :: (forall a. v a -> Bool) -> DHashMap k v -> DHashMap k v
filter p (DHashMap h) =
DHashMap $ HashMap.filter (\(_ :=> v) -> p v) h
filterWithKey :: (forall a. k a -> v a -> Bool) -> DHashMap k v -> DHashMap k v
filterWithKey p (DHashMap h) =
DHashMap $ HashMap.filter (\(k :=> v) -> p k v) h
mapMaybe :: (forall a. v1 a -> Maybe (v2 a)) -> DHashMap k v1 -> DHashMap k v2
mapMaybe f (DHashMap h) =
DHashMap $ HashMap.mapMaybe (\(k :=> v) -> (k :=>) <$> f v) h
mapMaybeWithKey
:: (forall a. k a -> v1 a -> Maybe (v2 a))
-> DHashMap k v1
-> DHashMap k v2
mapMaybeWithKey f (DHashMap h) =
DHashMap $ HashMap.mapMaybe (\(k :=> v) -> (k :=>) <$> f k v) h
keys :: DHashMap k v -> [Some k]
keys (DHashMap h) =
HashMap.keys h
elems :: DHashMap k v -> [Some v]
elems (DHashMap h) =
[ Some v
| _ :=> v <- HashMap.elems h
]
toList :: DHashMap k v -> [DSum k v]
toList (DHashMap h) =
HashMap.elems h
fromList :: (GEq k, Hashable (Some k)) => [DSum k f] -> DHashMap k f
fromList xs =
DHashMap $
HashMap.fromList
[ (Some k, kv)
| kv@(k :=> _) <- xs
]
fromListWith
:: (GEq k, Hashable (Some k))
=> (forall a. v a -> v a -> v a)
-> [DSum k v]
-> DHashMap k v
fromListWith f xs =
DHashMap $
HashMap.fromListWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f v1 v2
Nothing ->
error "Data.Dependent.HashMap.fromListWith: key mismatch"
)
[ (Some k, kv)
| kv@(k :=> _) <- xs
]
fromListWithKey
:: (GEq k, Hashable (Some k))
=> (forall a. k a -> v a -> v a -> v a)
-> [DSum k v]
-> DHashMap k v
fromListWithKey f xs =
DHashMap $
HashMap.fromListWith
(\(k1 :=> v1) (k2 :=> v2) ->
case geq k1 k2 of
Just Refl ->
k1 :=> f k1 v1 v2
Nothing ->
error "Data.Dependent.HashMap.fromListWithKey: key mismatch"
)
[ (Some k, kv)
| kv@(k :=> _) <- xs
]