{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Data.TrieMap(
MaybeMap,
ListMap,
LiteralMap,
TrieMap(..), insertTM, deleteTM, foldMapTM, isEmptyTM,
(>.>), (|>), (|>>), XT,
foldMaybe, filterMaybe,
GenMap,
lkG, xtG, mapG, fdG,
xtList, lkList
) where
import GHC.Prelude
import GHC.Types.Literal
import GHC.Types.Unique.DFM
import GHC.Types.Unique( Uniquable )
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import GHC.Utils.Outputable
import Control.Monad( (>=>) )
import Data.Kind( Type )
import qualified Data.Semigroup as S
type XT a = Maybe a -> Maybe a
class TrieMap m where
type Key m :: Type
emptyTM :: m a
lookupTM :: forall b. Key m -> m b -> Maybe b
alterTM :: forall b. Key m -> XT b -> m b -> m b
mapTM :: (a->b) -> m a -> m b
filterTM :: (a -> Bool) -> m a -> m a
foldTM :: (a -> b -> b) -> m a -> b -> b
insertTM :: TrieMap m => Key m -> a -> m a -> m a
insertTM :: forall (m :: * -> *) a. TrieMap m => Key m -> a -> m a -> m a
insertTM Key m
k a
v m a
m = Key m -> XT a -> m a -> m a
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key m
k (\Maybe a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
v) m a
m
deleteTM :: TrieMap m => Key m -> m a -> m a
deleteTM :: forall (m :: * -> *) a. TrieMap m => Key m -> m a -> m a
deleteTM Key m
k m a
m = Key m -> XT a -> m a -> m a
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key m
k (\Maybe a
_ -> Maybe a
forall a. Maybe a
Nothing) m a
m
foldMapTM :: (TrieMap m, Monoid r) => (a -> r) -> m a -> r
foldMapTM :: forall (m :: * -> *) r a.
(TrieMap m, Monoid r) =>
(a -> r) -> m a -> r
foldMapTM a -> r
f m a
m = (a -> r -> r) -> m a -> r -> r
forall a b. (a -> b -> b) -> m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (\ a
x r
r -> a -> r
f a
x r -> r -> r
forall a. Semigroup a => a -> a -> a
S.<> r
r) m a
m r
forall a. Monoid a => a
mempty
isEmptyTM :: TrieMap m => m a -> Bool
isEmptyTM :: forall (m :: * -> *) a. TrieMap m => m a -> Bool
isEmptyTM m a
m = (a -> Bool -> Bool) -> m a -> Bool -> Bool
forall a b. (a -> b -> b) -> m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (\ a
_ Bool
_ -> Bool
False) m a
m Bool
True
(>.>) :: (a -> b) -> (b -> c) -> a -> c
infixr 1 >.>
(a -> b
f >.> :: forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> b -> c
g) a
x = b -> c
g (a -> b
f a
x)
infixr 1 |>, |>>
(|>) :: a -> (a->b) -> b
a
x |> :: forall a b. a -> (a -> b) -> b
|> a -> b
f = a -> b
f a
x
(|>>) :: TrieMap m2
=> (XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a)
-> m1 (m2 a) -> m1 (m2 a)
|>> :: forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
(|>>) XT (m2 a) -> m1 (m2 a) -> m1 (m2 a)
f m2 a -> m2 a
g = XT (m2 a) -> m1 (m2 a) -> m1 (m2 a)
f (m2 a -> Maybe (m2 a)
forall a. a -> Maybe a
Just (m2 a -> Maybe (m2 a)) -> (Maybe (m2 a) -> m2 a) -> XT (m2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m2 a -> m2 a
g (m2 a -> m2 a) -> (Maybe (m2 a) -> m2 a) -> Maybe (m2 a) -> m2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (m2 a) -> m2 a
forall (m :: * -> *) a. TrieMap m => Maybe (m a) -> m a
deMaybe)
deMaybe :: TrieMap m => Maybe (m a) -> m a
deMaybe :: forall (m :: * -> *) a. TrieMap m => Maybe (m a) -> m a
deMaybe Maybe (m a)
Nothing = m a
forall a. m a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
deMaybe (Just m a
m) = m a
m
instance TrieMap IntMap.IntMap where
type Key IntMap.IntMap = Int
emptyTM :: forall a. IntMap a
emptyTM = IntMap a
forall a. IntMap a
IntMap.empty
lookupTM :: forall b. Key IntMap -> IntMap b -> Maybe b
lookupTM Key IntMap
k IntMap b
m = Key -> IntMap b -> Maybe b
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
Key IntMap
k IntMap b
m
alterTM :: forall b. Key IntMap -> XT b -> IntMap b -> IntMap b
alterTM = Key -> XT b -> IntMap b -> IntMap b
Key IntMap -> XT b -> IntMap b -> IntMap b
forall a. Key -> XT a -> IntMap a -> IntMap a
xtInt
foldTM :: forall a b. (a -> b -> b) -> IntMap a -> b -> b
foldTM a -> b -> b
k IntMap a
m b
z = (a -> b -> b) -> b -> IntMap a -> b
forall a b. (a -> b -> b) -> b -> IntMap a -> b
IntMap.foldr a -> b -> b
k b
z IntMap a
m
mapTM :: forall a b. (a -> b) -> IntMap a -> IntMap b
mapTM a -> b
f IntMap a
m = (a -> b) -> IntMap a -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map a -> b
f IntMap a
m
filterTM :: forall a. (a -> Bool) -> IntMap a -> IntMap a
filterTM a -> Bool
f IntMap a
m = (a -> Bool) -> IntMap a -> IntMap a
forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter a -> Bool
f IntMap a
m
xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a
xtInt :: forall a. Key -> XT a -> IntMap a -> IntMap a
xtInt Key
k XT a
f IntMap a
m = XT a -> Key -> IntMap a -> IntMap a
forall a. (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
IntMap.alter XT a
f Key
k IntMap a
m
instance Ord k => TrieMap (Map.Map k) where
type Key (Map.Map k) = k
emptyTM :: forall a. Map k a
emptyTM = Map k a
forall k a. Map k a
Map.empty
lookupTM :: forall b. Key (Map k) -> Map k b -> Maybe b
lookupTM = k -> Map k b -> Maybe b
Key (Map k) -> Map k b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
alterTM :: forall b. Key (Map k) -> XT b -> Map k b -> Map k b
alterTM Key (Map k)
k XT b
f Map k b
m = XT b -> k -> Map k b -> Map k b
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter XT b
f k
Key (Map k)
k Map k b
m
foldTM :: forall a b. (a -> b -> b) -> Map k a -> b -> b
foldTM a -> b -> b
k Map k a
m b
z = (a -> b -> b) -> b -> Map k a -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr a -> b -> b
k b
z Map k a
m
mapTM :: forall a b. (a -> b) -> Map k a -> Map k b
mapTM a -> b
f Map k a
m = (a -> b) -> Map k a -> Map k b
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map a -> b
f Map k a
m
filterTM :: forall a. (a -> Bool) -> Map k a -> Map k a
filterTM a -> Bool
f Map k a
m = (a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter a -> Bool
f Map k a
m
instance forall key. Uniquable key => TrieMap (UniqDFM key) where
type Key (UniqDFM key) = key
emptyTM :: forall a. UniqDFM key a
emptyTM = UniqDFM key a
forall key elt. UniqDFM key elt
emptyUDFM
lookupTM :: forall b. Key (UniqDFM key) -> UniqDFM key b -> Maybe b
lookupTM Key (UniqDFM key)
k UniqDFM key b
m = UniqDFM key b -> key -> Maybe b
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
lookupUDFM UniqDFM key b
m key
Key (UniqDFM key)
k
alterTM :: forall b.
Key (UniqDFM key) -> XT b -> UniqDFM key b -> UniqDFM key b
alterTM Key (UniqDFM key)
k XT b
f UniqDFM key b
m = XT b -> UniqDFM key b -> key -> UniqDFM key b
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt)
-> UniqDFM key elt -> key -> UniqDFM key elt
alterUDFM XT b
f UniqDFM key b
m key
Key (UniqDFM key)
k
foldTM :: forall a b. (a -> b -> b) -> UniqDFM key a -> b -> b
foldTM a -> b -> b
k UniqDFM key a
m b
z = (a -> b -> b) -> b -> UniqDFM key a -> b
forall elt a key. (elt -> a -> a) -> a -> UniqDFM key elt -> a
foldUDFM a -> b -> b
k b
z UniqDFM key a
m
mapTM :: forall a b. (a -> b) -> UniqDFM key a -> UniqDFM key b
mapTM a -> b
f UniqDFM key a
m = (a -> b) -> UniqDFM key a -> UniqDFM key b
forall elt1 elt2 key.
(elt1 -> elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
mapUDFM a -> b
f UniqDFM key a
m
filterTM :: forall a. (a -> Bool) -> UniqDFM key a -> UniqDFM key a
filterTM a -> Bool
f UniqDFM key a
m = (a -> Bool) -> UniqDFM key a -> UniqDFM key a
forall elt key. (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM a -> Bool
f UniqDFM key a
m
data MaybeMap m a = MM { forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing :: Maybe a, forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just :: m a }
instance TrieMap m => TrieMap (MaybeMap m) where
type Key (MaybeMap m) = Maybe (Key m)
emptyTM :: forall a. MaybeMap m a
emptyTM = MM { mm_nothing :: Maybe a
mm_nothing = Maybe a
forall a. Maybe a
Nothing, mm_just :: m a
mm_just = m a
forall a. m a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
lookupTM :: forall b. Key (MaybeMap m) -> MaybeMap m b -> Maybe b
lookupTM = (forall b. Key m -> m b -> Maybe b)
-> Maybe (Key m) -> MaybeMap m b -> Maybe b
forall k (m :: * -> *) a.
(forall b. k -> m b -> Maybe b)
-> Maybe k -> MaybeMap m a -> Maybe a
lkMaybe Key m -> m b -> Maybe b
forall b. Key m -> m b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM
alterTM :: forall b. Key (MaybeMap m) -> XT b -> MaybeMap m b -> MaybeMap m b
alterTM = (forall b. Key m -> XT b -> m b -> m b)
-> Maybe (Key m)
-> (Maybe b -> Maybe b)
-> MaybeMap m b
-> MaybeMap m b
forall k (m :: * -> *) a.
(forall b. k -> XT b -> m b -> m b)
-> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a
xtMaybe Key m -> XT b -> m b -> m b
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM
foldTM :: forall a b. (a -> b -> b) -> MaybeMap m a -> b -> b
foldTM = (a -> b -> b) -> MaybeMap m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> MaybeMap m a -> b -> b
fdMaybe
mapTM :: forall a b. (a -> b) -> MaybeMap m a -> MaybeMap m b
mapTM = (a -> b) -> MaybeMap m a -> MaybeMap m b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> MaybeMap m a -> MaybeMap m b
mapMb
filterTM :: forall a. (a -> Bool) -> MaybeMap m a -> MaybeMap m a
filterTM = (a -> Bool) -> MaybeMap m a -> MaybeMap m a
forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> MaybeMap m a -> MaybeMap m a
ftMaybe
instance TrieMap m => Foldable (MaybeMap m) where
foldMap :: forall m a. Monoid m => (a -> m) -> MaybeMap m a -> m
foldMap = (a -> m) -> MaybeMap m a -> m
forall (m :: * -> *) r a.
(TrieMap m, Monoid r) =>
(a -> r) -> m a -> r
foldMapTM
mapMb :: TrieMap m => (a->b) -> MaybeMap m a -> MaybeMap m b
mapMb :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> MaybeMap m a -> MaybeMap m b
mapMb a -> b
f (MM { mm_nothing :: forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing = Maybe a
mn, mm_just :: forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just = m a
mj })
= MM { mm_nothing :: Maybe b
mm_nothing = (a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
mn, mm_just :: m b
mm_just = (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f m a
mj }
lkMaybe :: (forall b. k -> m b -> Maybe b)
-> Maybe k -> MaybeMap m a -> Maybe a
lkMaybe :: forall k (m :: * -> *) a.
(forall b. k -> m b -> Maybe b)
-> Maybe k -> MaybeMap m a -> Maybe a
lkMaybe forall b. k -> m b -> Maybe b
_ Maybe k
Nothing = MaybeMap m a -> Maybe a
forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing
lkMaybe forall b. k -> m b -> Maybe b
lk (Just k
x) = MaybeMap m a -> m a
forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just (MaybeMap m a -> m a)
-> (m a -> Maybe a) -> MaybeMap m a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> k -> m a -> Maybe a
forall b. k -> m b -> Maybe b
lk k
x
xtMaybe :: (forall b. k -> XT b -> m b -> m b)
-> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a
xtMaybe :: forall k (m :: * -> *) a.
(forall b. k -> XT b -> m b -> m b)
-> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a
xtMaybe forall b. k -> XT b -> m b -> m b
_ Maybe k
Nothing XT a
f MaybeMap m a
m = MaybeMap m a
m { mm_nothing :: Maybe a
mm_nothing = XT a
f (MaybeMap m a -> Maybe a
forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing MaybeMap m a
m) }
xtMaybe forall b. k -> XT b -> m b -> m b
tr (Just k
x) XT a
f MaybeMap m a
m = MaybeMap m a
m { mm_just :: m a
mm_just = MaybeMap m a -> m a
forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just MaybeMap m a
m m a -> (m a -> m a) -> m a
forall a b. a -> (a -> b) -> b
|> k -> XT a -> m a -> m a
forall b. k -> XT b -> m b -> m b
tr k
x XT a
f }
fdMaybe :: TrieMap m => (a -> b -> b) -> MaybeMap m a -> b -> b
fdMaybe :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> MaybeMap m a -> b -> b
fdMaybe a -> b -> b
k MaybeMap m a
m = (a -> b -> b) -> Maybe a -> b -> b
forall a b. (a -> b -> b) -> Maybe a -> b -> b
foldMaybe a -> b -> b
k (MaybeMap m a -> Maybe a
forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing MaybeMap m a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> m a -> b -> b
forall a b. (a -> b -> b) -> m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (MaybeMap m a -> m a
forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just MaybeMap m a
m)
ftMaybe :: TrieMap m => (a -> Bool) -> MaybeMap m a -> MaybeMap m a
ftMaybe :: forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> MaybeMap m a -> MaybeMap m a
ftMaybe a -> Bool
f (MM { mm_nothing :: forall (m :: * -> *) a. MaybeMap m a -> Maybe a
mm_nothing = Maybe a
mn, mm_just :: forall (m :: * -> *) a. MaybeMap m a -> m a
mm_just = m a
mj })
= MM { mm_nothing :: Maybe a
mm_nothing = (a -> Bool) -> Maybe a -> Maybe a
forall a. (a -> Bool) -> Maybe a -> Maybe a
filterMaybe a -> Bool
f Maybe a
mn, mm_just :: m a
mm_just = (a -> Bool) -> m a -> m a
forall a. (a -> Bool) -> m a -> m a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f m a
mj }
foldMaybe :: (a -> b -> b) -> Maybe a -> b -> b
foldMaybe :: forall a b. (a -> b -> b) -> Maybe a -> b -> b
foldMaybe a -> b -> b
_ Maybe a
Nothing b
b = b
b
foldMaybe a -> b -> b
k (Just a
a) b
b = a -> b -> b
k a
a b
b
filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a
filterMaybe :: forall a. (a -> Bool) -> Maybe a -> Maybe a
filterMaybe a -> Bool
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
filterMaybe a -> Bool
f input :: Maybe a
input@(Just a
x) | a -> Bool
f a
x = Maybe a
input
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
data ListMap m a
= LM { forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil :: Maybe a
, forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons :: m (ListMap m a) }
instance TrieMap m => TrieMap (ListMap m) where
type Key (ListMap m) = [Key m]
emptyTM :: forall a. ListMap m a
emptyTM = LM { lm_nil :: Maybe a
lm_nil = Maybe a
forall a. Maybe a
Nothing, lm_cons :: m (ListMap m a)
lm_cons = m (ListMap m a)
forall a. m a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
lookupTM :: forall b. Key (ListMap m) -> ListMap m b -> Maybe b
lookupTM = (forall b. Key m -> m b -> Maybe b)
-> [Key m] -> ListMap m b -> Maybe b
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList Key m -> m b -> Maybe b
forall b. Key m -> m b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM
alterTM :: forall b. Key (ListMap m) -> XT b -> ListMap m b -> ListMap m b
alterTM = (forall b. Key m -> XT b -> m b -> m b)
-> [Key m] -> (Maybe b -> Maybe b) -> ListMap m b -> ListMap m b
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList Key m -> XT b -> m b -> m b
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM
foldTM :: forall a b. (a -> b -> b) -> ListMap m a -> b -> b
foldTM = (a -> b -> b) -> ListMap m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> ListMap m a -> b -> b
fdList
mapTM :: forall a b. (a -> b) -> ListMap m a -> ListMap m b
mapTM = (a -> b) -> ListMap m a -> ListMap m b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> ListMap m a -> ListMap m b
mapList
filterTM :: forall a. (a -> Bool) -> ListMap m a -> ListMap m a
filterTM = (a -> Bool) -> ListMap m a -> ListMap m a
forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> ListMap m a -> ListMap m a
ftList
instance TrieMap m => Foldable (ListMap m) where
foldMap :: forall m a. Monoid m => (a -> m) -> ListMap m a -> m
foldMap = (a -> m) -> ListMap m a -> m
forall (m :: * -> *) r a.
(TrieMap m, Monoid r) =>
(a -> r) -> m a -> r
foldMapTM
instance (TrieMap m, Outputable a) => Outputable (ListMap m a) where
ppr :: ListMap m a -> SDoc
ppr ListMap m a
m = String -> SDoc
text String
"List elts" SDoc -> SDoc -> SDoc
<+> [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> [a] -> [a]) -> ListMap m a -> [a] -> [a]
forall a b. (a -> b -> b) -> ListMap m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (:) ListMap m a
m [])
mapList :: TrieMap m => (a->b) -> ListMap m a -> ListMap m b
mapList :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> ListMap m a -> ListMap m b
mapList a -> b
f (LM { lm_nil :: forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil = Maybe a
mnil, lm_cons :: forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons = m (ListMap m a)
mcons })
= LM { lm_nil :: Maybe b
lm_nil = (a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
mnil, lm_cons :: m (ListMap m b)
lm_cons = (ListMap m a -> ListMap m b) -> m (ListMap m a) -> m (ListMap m b)
forall a b. (a -> b) -> m a -> m b
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> b) -> ListMap m a -> ListMap m b
forall a b. (a -> b) -> ListMap m a -> ListMap m b
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) m (ListMap m a)
mcons }
lkList :: TrieMap m => (forall b. k -> m b -> Maybe b)
-> [k] -> ListMap m a -> Maybe a
lkList :: forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList forall b. k -> m b -> Maybe b
_ [] = ListMap m a -> Maybe a
forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil
lkList forall b. k -> m b -> Maybe b
lk (k
x:[k]
xs) = ListMap m a -> m (ListMap m a)
forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons (ListMap m a -> m (ListMap m a))
-> (m (ListMap m a) -> Maybe a) -> ListMap m a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> k -> m (ListMap m a) -> Maybe (ListMap m a)
forall b. k -> m b -> Maybe b
lk k
x (m (ListMap m a) -> Maybe (ListMap m a))
-> (ListMap m a -> Maybe a) -> m (ListMap m a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList k -> m b -> Maybe b
forall b. k -> m b -> Maybe b
lk [k]
xs
xtList :: TrieMap m => (forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList :: forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList forall b. k -> XT b -> m b -> m b
_ [] XT a
f ListMap m a
m = ListMap m a
m { lm_nil :: Maybe a
lm_nil = XT a
f (ListMap m a -> Maybe a
forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil ListMap m a
m) }
xtList forall b. k -> XT b -> m b -> m b
tr (k
x:[k]
xs) XT a
f ListMap m a
m = ListMap m a
m { lm_cons :: m (ListMap m a)
lm_cons = ListMap m a -> m (ListMap m a)
forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons ListMap m a
m m (ListMap m a)
-> (m (ListMap m a) -> m (ListMap m a)) -> m (ListMap m a)
forall a b. a -> (a -> b) -> b
|> k -> XT (ListMap m a) -> m (ListMap m a) -> m (ListMap m a)
forall b. k -> XT b -> m b -> m b
tr k
x (XT (ListMap m a) -> m (ListMap m a) -> m (ListMap m a))
-> (ListMap m a -> ListMap m a)
-> m (ListMap m a)
-> m (ListMap m a)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> (forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList k -> XT b -> m b -> m b
forall b. k -> XT b -> m b -> m b
tr [k]
xs XT a
f }
fdList :: forall m a b. TrieMap m
=> (a -> b -> b) -> ListMap m a -> b -> b
fdList :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> ListMap m a -> b -> b
fdList a -> b -> b
k ListMap m a
m = (a -> b -> b) -> Maybe a -> b -> b
forall a b. (a -> b -> b) -> Maybe a -> b -> b
foldMaybe a -> b -> b
k (ListMap m a -> Maybe a
forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil ListMap m a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListMap m a -> b -> b) -> m (ListMap m a) -> b -> b
forall a b. (a -> b -> b) -> m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> ListMap m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> ListMap m a -> b -> b
fdList a -> b -> b
k) (ListMap m a -> m (ListMap m a)
forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons ListMap m a
m)
ftList :: TrieMap m => (a -> Bool) -> ListMap m a -> ListMap m a
ftList :: forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> ListMap m a -> ListMap m a
ftList a -> Bool
f (LM { lm_nil :: forall (m :: * -> *) a. ListMap m a -> Maybe a
lm_nil = Maybe a
mnil, lm_cons :: forall (m :: * -> *) a. ListMap m a -> m (ListMap m a)
lm_cons = m (ListMap m a)
mcons })
= LM { lm_nil :: Maybe a
lm_nil = (a -> Bool) -> Maybe a -> Maybe a
forall a. (a -> Bool) -> Maybe a -> Maybe a
filterMaybe a -> Bool
f Maybe a
mnil, lm_cons :: m (ListMap m a)
lm_cons = (ListMap m a -> ListMap m a) -> m (ListMap m a) -> m (ListMap m a)
forall a b. (a -> b) -> m a -> m b
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> Bool) -> ListMap m a -> ListMap m a
forall a. (a -> Bool) -> ListMap m a -> ListMap m a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) m (ListMap m a)
mcons }
type LiteralMap a = Map.Map Literal a
data GenMap m a
= EmptyMap
| SingletonMap (Key m) a
| MultiMap (m a)
instance (Outputable a, Outputable (m a)) => Outputable (GenMap m a) where
ppr :: GenMap m a -> SDoc
ppr GenMap m a
EmptyMap = String -> SDoc
text String
"Empty map"
ppr (SingletonMap Key m
_ a
v) = String -> SDoc
text String
"Singleton map" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
v
ppr (MultiMap m a
m) = m a -> SDoc
forall a. Outputable a => a -> SDoc
ppr m a
m
instance (Eq (Key m), TrieMap m) => TrieMap (GenMap m) where
type Key (GenMap m) = Key m
emptyTM :: forall a. GenMap m a
emptyTM = GenMap m a
forall (m :: * -> *) a. GenMap m a
EmptyMap
lookupTM :: forall b. Key (GenMap m) -> GenMap m b -> Maybe b
lookupTM = Key m -> GenMap m b -> Maybe b
Key (GenMap m) -> GenMap m b -> Maybe b
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG
alterTM :: forall b. Key (GenMap m) -> XT b -> GenMap m b -> GenMap m b
alterTM = Key m -> XT b -> GenMap m b -> GenMap m b
Key (GenMap m) -> XT b -> GenMap m b -> GenMap m b
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG
foldTM :: forall a b. (a -> b -> b) -> GenMap m a -> b -> b
foldTM = (a -> b -> b) -> GenMap m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> GenMap m a -> b -> b
fdG
mapTM :: forall a b. (a -> b) -> GenMap m a -> GenMap m b
mapTM = (a -> b) -> GenMap m a -> GenMap m b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> GenMap m a -> GenMap m b
mapG
filterTM :: forall a. (a -> Bool) -> GenMap m a -> GenMap m a
filterTM = (a -> Bool) -> GenMap m a -> GenMap m a
forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> GenMap m a -> GenMap m a
ftG
instance (Eq (Key m), TrieMap m) => Foldable (GenMap m) where
foldMap :: forall m a. Monoid m => (a -> m) -> GenMap m a -> m
foldMap = (a -> m) -> GenMap m a -> m
forall (m :: * -> *) r a.
(TrieMap m, Monoid r) =>
(a -> r) -> m a -> r
foldMapTM
{-# INLINEABLE lkG #-}
lkG :: (Eq (Key m), TrieMap m) => Key m -> GenMap m a -> Maybe a
lkG :: forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG Key m
_ GenMap m a
EmptyMap = Maybe a
forall a. Maybe a
Nothing
lkG Key m
k (SingletonMap Key m
k' a
v') | Key m
k Key m -> Key m -> Bool
forall a. Eq a => a -> a -> Bool
== Key m
k' = a -> Maybe a
forall a. a -> Maybe a
Just a
v'
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
lkG Key m
k (MultiMap m a
m) = Key m -> m a -> Maybe a
forall b. Key m -> m b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Key m
k m a
m
{-# INLINEABLE xtG #-}
xtG :: (Eq (Key m), TrieMap m) => Key m -> XT a -> GenMap m a -> GenMap m a
xtG :: forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG Key m
k XT a
f GenMap m a
EmptyMap
= case XT a
f Maybe a
forall a. Maybe a
Nothing of
Just a
v -> Key m -> a -> GenMap m a
forall (m :: * -> *) a. Key m -> a -> GenMap m a
SingletonMap Key m
k a
v
Maybe a
Nothing -> GenMap m a
forall (m :: * -> *) a. GenMap m a
EmptyMap
xtG Key m
k XT a
f m :: GenMap m a
m@(SingletonMap Key m
k' a
v')
| Key m
k' Key m -> Key m -> Bool
forall a. Eq a => a -> a -> Bool
== Key m
k
= case XT a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
v') of
Just a
v'' -> Key m -> a -> GenMap m a
forall (m :: * -> *) a. Key m -> a -> GenMap m a
SingletonMap Key m
k' a
v''
Maybe a
Nothing -> GenMap m a
forall (m :: * -> *) a. GenMap m a
EmptyMap
| Bool
otherwise
= case XT a
f Maybe a
forall a. Maybe a
Nothing of
Maybe a
Nothing -> GenMap m a
m
Just a
v -> m a
forall a. m a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM m a -> (m a -> GenMap m a) -> GenMap m a
forall a b. a -> (a -> b) -> b
|> Key m -> XT a -> m a -> m a
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key m
k' (Maybe a -> XT a
forall a b. a -> b -> a
const (a -> Maybe a
forall a. a -> Maybe a
Just a
v'))
(m a -> m a) -> (m a -> GenMap m a) -> m a -> GenMap m a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key m -> XT a -> m a -> m a
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key m
k (Maybe a -> XT a
forall a b. a -> b -> a
const (a -> Maybe a
forall a. a -> Maybe a
Just a
v))
(m a -> m a) -> (m a -> GenMap m a) -> m a -> GenMap m a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> m a -> GenMap m a
forall (m :: * -> *) a. m a -> GenMap m a
MultiMap
xtG Key m
k XT a
f (MultiMap m a
m) = m a -> GenMap m a
forall (m :: * -> *) a. m a -> GenMap m a
MultiMap (Key m -> XT a -> m a -> m a
forall b. Key m -> XT b -> m b -> m b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key m
k XT a
f m a
m)
{-# INLINEABLE mapG #-}
mapG :: TrieMap m => (a -> b) -> GenMap m a -> GenMap m b
mapG :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b) -> GenMap m a -> GenMap m b
mapG a -> b
_ GenMap m a
EmptyMap = GenMap m b
forall (m :: * -> *) a. GenMap m a
EmptyMap
mapG a -> b
f (SingletonMap Key m
k a
v) = Key m -> b -> GenMap m b
forall (m :: * -> *) a. Key m -> a -> GenMap m a
SingletonMap Key m
k (a -> b
f a
v)
mapG a -> b
f (MultiMap m a
m) = m b -> GenMap m b
forall (m :: * -> *) a. m a -> GenMap m a
MultiMap ((a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f m a
m)
{-# INLINEABLE fdG #-}
fdG :: TrieMap m => (a -> b -> b) -> GenMap m a -> b -> b
fdG :: forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> GenMap m a -> b -> b
fdG a -> b -> b
_ GenMap m a
EmptyMap = \b
z -> b
z
fdG a -> b -> b
k (SingletonMap Key m
_ a
v) = \b
z -> a -> b -> b
k a
v b
z
fdG a -> b -> b
k (MultiMap m a
m) = (a -> b -> b) -> m a -> b -> b
forall a b. (a -> b -> b) -> m a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k m a
m
{-# INLINEABLE ftG #-}
ftG :: TrieMap m => (a -> Bool) -> GenMap m a -> GenMap m a
ftG :: forall (m :: * -> *) a.
TrieMap m =>
(a -> Bool) -> GenMap m a -> GenMap m a
ftG a -> Bool
_ GenMap m a
EmptyMap = GenMap m a
forall (m :: * -> *) a. GenMap m a
EmptyMap
ftG a -> Bool
f input :: GenMap m a
input@(SingletonMap Key m
_ a
v)
| a -> Bool
f a
v = GenMap m a
input
| Bool
otherwise = GenMap m a
forall (m :: * -> *) a. GenMap m a
EmptyMap
ftG a -> Bool
f (MultiMap m a
m) = m a -> GenMap m a
forall (m :: * -> *) a. m a -> GenMap m a
MultiMap ((a -> Bool) -> m a -> m a
forall a. (a -> Bool) -> m a -> m a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f m a
m)