generic-trie 0.1 → 0.2

raw patch · 2 files changed

+440/−103 lines, 2 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• generic-trie.cabal +5/−4
• src/Data/GenericTrie.hs +435/−99

@@ -1,12 +1,12 @@ name:                generic-trie-version:             0.1+version:             0.2 synopsis:            A map, where the keys may be complex structured data.-description:         This type implements maps where the keys are themeselves-                     complexs strucutured data.  For example, the keys may be+description:         This type implements maps where the keys are themselves+                     complex structured data.  For example, the keys may be                      the abstract syntax trees for a programming language.                      The map is implemented as a trie, so common parts of the                      keys will be shared in the representation.  The library-                     provides a generic implementation of the data strucutre,+                     provides a generic implementation of the data structure,                      so values of types that have support for 'Generic' may                      be automatically used as keys in the map. license:             BSD3@@ -22,6 +22,7 @@ library   exposed-modules:     Data.GenericTrie   build-depends:       base             >= 4.5     && < 4.9,+                       transformers     >= 0.2     && < 0.5,                        containers       >= 0.4.2.1 && < 0.6   GHC-options:         -O2 -Wall 

@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-} -- allows the TypeRep default  {- | @@ -35,17 +36,44 @@   , member   , notMember   , fromList+  , toList+  , mapMaybe+  , union+  , unionWith+  , unionWithKey+  , intersection+  , intersectionWith+  , intersectionWithKey+  , difference+  , differenceWith+  , differenceWithKey   , TrieKey(..)+  -- * Manual ord key instance selector+  , OrdKey(..)   -- * Generic derivation implementation+  , genericTrieNull+  , genericTrieMap+  , genericTrieTraverse+  , genericTrieShowsPrec+  , genericInsert+  , genericLookup+  , genericDelete+  , genericMapMaybeWithKey+  , genericSingleton+  , genericEmpty+  , genericFoldWithKey+  , genericTraverseWithKey   , TrieRepDefault   , GTrieKey(..)   , GTrie(..)   ) where  -import Control.Applicative (Applicative, liftA2, pure)-import Data.Char (ord)+import Control.Applicative (Applicative, liftA2)+import Data.Char (chr, ord)+import Data.Coerce (coerce) import Data.Foldable (Foldable)+import Data.Functor.Compose (Compose(..)) import Data.IntMap (IntMap) import Data.List (foldl') import Data.Map (Map)@@ -64,7 +92,7 @@ class TrieKey k where    -- | Type of the representation of tries for this key.-  type TrieRep k a+  type TrieRep k :: * -> *    -- | Construct an empty trie   empty :: Trie k a@@ -87,100 +115,103 @@   -- | Apply a function to all values stored in a trie   trieMap :: (a -> b) -> Trie k a -> Trie k b -  -- | Fold all the values store in a trie-  trieFold :: (a -> b -> b) -> Trie k a -> b -> b-   -- | Traverse the values stored in a trie   trieTraverse :: Applicative f => (a -> f b) -> Trie k a -> f (Trie k b)    -- | Show the representation of a trie   trieShowsPrec :: Show a => Int -> Trie k a -> ShowS +  -- | Apply a function to the values of a 'Trie' and keep the elements+  -- of the trie that result in a 'Just' value.+  mapMaybeWithKey :: (k -> a -> Maybe b) -> Trie k a -> Trie k b +  -- | Fold a trie with a function of both key and value.+  foldWithKey :: (k -> a -> r -> r) -> r -> Trie k a -> r++  -- | Traverse a trie with a function of both key and value.+  traverseWithKey :: Applicative f => (k -> a -> f b) -> Trie k a -> f (Trie k b)++  mergeWithKey :: (k -> a -> b -> Maybe c) ->+                  (Trie k a -> Trie k c) ->+                  (Trie k b -> Trie k c) ->+                  Trie k a -> Trie k b -> Trie k c++   -- Defaults using 'Generic' -  type instance TrieRep k a = TrieRepDefault k a+  type instance TrieRep k = TrieRepDefault k -  default empty ::-    ( TrieRep k a ~ TrieRepDefault k a-    ) =>-    Trie k a-  empty = MkTrie Nothing+  default empty :: ( TrieRep k ~ TrieRepDefault k) => Trie k a+  empty = genericEmpty    default singleton ::-    ( GTrieKey (Rep k), Generic k-    , TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) =>     k -> a -> Trie k a-  singleton k v = MkTrie $ Just $! gtrieSingleton (from k) v+  singleton = genericSingleton    default trieNull ::-    ( TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( TrieRep k ~ TrieRepDefault k) =>     Trie k a -> Bool-  trieNull (MkTrie mb) = isNothing mb+  trieNull = genericTrieNull    default lookup ::-    ( GTrieKey (Rep k), Generic k-    , TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) =>     k -> Trie k a -> Maybe a-  lookup k (MkTrie t) = gtrieLookup (from k) =<< t+  lookup = genericLookup    default insert ::-    ( GTrieKey (Rep k), Generic k-    , TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) =>     k -> a -> Trie k a -> Trie k a-  insert k v (MkTrie Nothing)  = MkTrie (Just $! gtrieSingleton (from k) v)-  insert k v (MkTrie (Just t)) = MkTrie (Just $! gtrieInsert (from k) v t)+  insert = genericInsert    default delete ::-    ( GTrieKey (Rep k), Generic k-    , TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) =>     k -> Trie k a -> Trie k a-  delete _ t@(MkTrie Nothing) = t-  delete k (MkTrie (Just t))  = MkTrie (gtrieDelete (from k) t)+  delete = genericDelete    default trieMap ::-    ( GTrieKey (Rep k)-    , TrieRep k a ~ TrieRepDefault k a-    , TrieRep k b ~ TrieRepDefault k b-    ) =>+    ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k) =>     (a -> b) -> Trie k a -> Trie k b-  trieMap f (MkTrie x) = MkTrie (fmap (gtrieMap f) $! x)--  default trieFold ::-    ( GTrieKey (Rep k)-    , TrieRep k a ~ TrieRepDefault k a-    ) =>-    (a -> b -> b) -> Trie k a -> b -> b-  trieFold f (MkTrie (Just x)) z = gtrieFold f x z-  trieFold _ (MkTrie Nothing) z = z+  trieMap = genericTrieMap    default trieTraverse ::-    ( GTrieKey (Rep k)-    , TrieRep k a ~ TrieRepDefault k a-    , TrieRep k b ~ TrieRepDefault k b-    , Applicative f-    ) =>+    ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k , Applicative f) =>     (a -> f b) -> Trie k a -> f (Trie k b)-  trieTraverse f (MkTrie x) = fmap MkTrie (traverse (gtrieTraverse f) x)+  trieTraverse = genericTrieTraverse    default trieShowsPrec ::-    ( Show a, GTrieKeyShow (Rep k)-    , TrieRep k a ~ TrieRepDefault k a-    ) =>+    ( Show a, GTrieKeyShow (Rep k) , TrieRep k ~ TrieRepDefault k) =>     Int -> Trie k a -> ShowS-  trieShowsPrec p (MkTrie (Just x)) = showsPrec p x-  trieShowsPrec _ (MkTrie Nothing ) = showString "()"+  trieShowsPrec = genericTrieShowsPrec +  default mapMaybeWithKey ::+    ( GTrieKey (Rep k) , Generic k, TrieRep k ~ TrieRepDefault k) =>+    (k -> a -> Maybe b) -> Trie k a -> Trie k b+  mapMaybeWithKey = genericMapMaybeWithKey++  default foldWithKey ::+    ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k, Generic k) =>+    (k -> a -> r -> r) -> r -> Trie k a -> r+  foldWithKey = genericFoldWithKey++  default traverseWithKey ::+    ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k, Generic k, Applicative f) =>+    (k -> a -> f b) -> Trie k a -> f (Trie k b)+  traverseWithKey = genericTraverseWithKey++  default mergeWithKey ::+    ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k, Generic k ) =>+    (k -> a -> b -> Maybe c) ->+    (Trie k a -> Trie k c) ->+    (Trie k b -> Trie k c) ->+    Trie k a -> Trie k b -> Trie k c+  mergeWithKey = genericMergeWithKey+ -- | The default implementation of a 'TrieRep' is 'GTrie' wrapped in -- a 'Maybe'. This wrapping is due to the 'GTrie' being a non-empty -- trie allowing all the of the "emptiness" to be represented at the -- top level for any given generically implemented key.-type TrieRepDefault k a = Maybe (GTrie (Rep k) a)+type TrieRepDefault k = Compose Maybe (GTrie (Rep k))  -- | Effectively an associated datatype of tries indexable by keys of type @k@. -- By using a separate newtype wrapper around the associated type synonym we're@@ -195,7 +226,7 @@  -- | 'Int' tries are implemented with 'IntMap'. instance TrieKey Int where-  type TrieRep Int a            = IntMap a+  type TrieRep Int              = IntMap   lookup k (MkTrie x)           = IntMap.lookup k x   insert k v (MkTrie t)         = MkTrie (IntMap.insert k v t)   delete k (MkTrie t)           = MkTrie (IntMap.delete k t)@@ -203,21 +234,25 @@   singleton k v                 = MkTrie (IntMap.singleton k v)   trieNull (MkTrie x)           = IntMap.null x   trieMap f (MkTrie x)          = MkTrie (IntMap.map f x)-  trieFold f (MkTrie x) z       = IntMap.foldr f z x   trieTraverse f (MkTrie x)     = fmap MkTrie (traverse f x)   trieShowsPrec p (MkTrie x)    = showsPrec p x+  mapMaybeWithKey f (MkTrie x)  = MkTrie (IntMap.mapMaybeWithKey f x)+  foldWithKey f z (MkTrie x)    = IntMap.foldWithKey f z x+  traverseWithKey f (MkTrie x)  = fmap MkTrie (IntMap.traverseWithKey f x)+  mergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (IntMap.mergeWithKey f (coerce g) (coerce h) x y)   {-# INLINE empty #-}   {-# INLINE insert #-}   {-# INLINE lookup #-}   {-# INLINE delete #-}+  {-# INLINE foldWithKey #-}   {-# INLINE trieTraverse #-}   {-# INLINE trieNull #-}   {-# INLINE trieMap #-}-  {-# INLINE trieFold #-}+  {-# INLINE mergeWithKey #-}  -- | 'Integer' tries are implemented with 'Map'. instance TrieKey Integer where-  type TrieRep Integer a        = Map Integer a+  type TrieRep Integer          = Map Integer   lookup k (MkTrie t)           = Map.lookup k t   insert k v (MkTrie t)         = MkTrie (Map.insert k v t)   delete k (MkTrie t)           = MkTrie (Map.delete k t)@@ -225,21 +260,25 @@   singleton k v                 = MkTrie (Map.singleton k v)   trieNull (MkTrie x)           = Map.null x   trieMap f (MkTrie x)          = MkTrie (Map.map f x)-  trieFold f (MkTrie x) z       = Map.foldr f z x   trieTraverse f (MkTrie x)     = fmap MkTrie (traverse f x)   trieShowsPrec p (MkTrie x)    = showsPrec p x+  mapMaybeWithKey f (MkTrie x)  = MkTrie (Map.mapMaybeWithKey f x)+  foldWithKey f z (MkTrie x)    = Map.foldrWithKey f z x+  traverseWithKey f (MkTrie x)  = fmap MkTrie (Map.traverseWithKey f x)+  mergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (Map.mergeWithKey f (coerce g) (coerce h) x y)   {-# INLINE empty #-}   {-# INLINE insert #-}   {-# INLINE lookup #-}   {-# INLINE delete #-}   {-# INLINE trieNull #-}   {-# INLINE trieMap #-}-  {-# INLINE trieFold #-}+  {-# INLINE foldWithKey #-}+  {-# INLINE mergeWithKey #-}   {-# INLINE trieTraverse #-}  -- | 'Char tries are implemented with 'IntMap'. instance TrieKey Char where-  type TrieRep Char a           = IntMap a+  type TrieRep Char             = IntMap   lookup k (MkTrie t)           = IntMap.lookup (ord k) t   delete k (MkTrie t)           = MkTrie (IntMap.delete (ord k) t)   insert k v (MkTrie t)         = MkTrie (IntMap.insert (ord k) v t)@@ -247,9 +286,12 @@   singleton k v                 = MkTrie (IntMap.singleton (ord k) v)   trieNull (MkTrie x)           = IntMap.null x   trieMap f (MkTrie x)          = MkTrie (IntMap.map f x)-  trieFold f (MkTrie x) z       = IntMap.foldr f z x   trieTraverse f (MkTrie x)     = fmap MkTrie (traverse f x)   trieShowsPrec p (MkTrie x)    = showsPrec p x+  mapMaybeWithKey f (MkTrie x)  = MkTrie (IntMap.mapMaybeWithKey (f . chr) x)+  foldWithKey f z (MkTrie x)    = IntMap.foldrWithKey (f . chr) z x+  traverseWithKey f (MkTrie x)  = fmap MkTrie (IntMap.traverseWithKey (f . chr) x)+  mergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (IntMap.mergeWithKey (f . chr) (coerce g) (coerce h) x y)   {-# INLINE empty #-}   {-# INLINE insert #-}   {-# INLINE lookup #-}@@ -257,9 +299,10 @@   {-# INLINE trieNull #-}   {-# INLINE trieTraverse #-}   {-# INLINE trieMap #-}-  {-# INLINE trieFold #-}+  {-# INLINE foldWithKey #-}+  {-# INLINE mergeWithKey #-} -newtype OrdKey k = OrdKey k+newtype OrdKey k = OrdKey { getOrdKey :: k }   deriving (Read, Show, Eq, Ord)  -- | 'OrdKey' tries are implemented with 'Map', this is@@ -267,7 +310,7 @@ -- to force the use of a 'Map' than to use the generically -- derived structure. instance (Show k, Ord k) => TrieKey (OrdKey k) where-  type TrieRep (OrdKey k) a             = Map k a+  type TrieRep (OrdKey k)               = Map k   lookup (OrdKey k) (MkTrie x)          = Map.lookup k x   insert (OrdKey k) v (MkTrie x)        = MkTrie (Map.insert k v x)   delete (OrdKey k) (MkTrie x)          = MkTrie (Map.delete k x)@@ -275,17 +318,21 @@   singleton (OrdKey k) v                = MkTrie (Map.singleton k v)   trieNull (MkTrie x)                   = Map.null x   trieMap f (MkTrie x)                  = MkTrie (Map.map f x)-  trieFold f (MkTrie x) z               = Map.foldr f z x   trieTraverse f (MkTrie x)             = fmap MkTrie (traverse f x)   trieShowsPrec p (MkTrie x)            = showsPrec p x+  mapMaybeWithKey f (MkTrie x)          = MkTrie (Map.mapMaybeWithKey (f . OrdKey) x)+  foldWithKey f z (MkTrie x)            = Map.foldrWithKey (f . OrdKey) z x+  traverseWithKey f (MkTrie x)          = fmap MkTrie (Map.traverseWithKey (f . OrdKey) x)+  mergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (Map.mergeWithKey (f . OrdKey) (coerce g) (coerce h) x y)   {-# INLINE empty #-}   {-# INLINE insert #-}   {-# INLINE lookup #-}   {-# INLINE delete #-}+  {-# INLINE foldWithKey #-}   {-# INLINE trieNull #-}   {-# INLINE trieMap #-}-  {-# INLINE trieFold #-}   {-# INLINE trieTraverse #-}+  {-# INLINE mergeWithKey #-}   {-# INLINE trieShowsPrec #-}  ------------------------------------------------------------------------------@@ -301,19 +348,164 @@ instance TrieKey k                         => TrieKey [k]  ------------------------------------------------------------------------------+-- Generic 'TrieKey' method implementations+------------------------------------------------------------------------------++-- | Generic implementation of 'lookup'. This is the default implementation.+genericLookup ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    k -> Trie k a -> Maybe a+genericLookup k (MkTrie (Compose t)) = gtrieLookup (from k) =<< t+{-# INLINABLE genericLookup #-}++-- | Generic implementation of 'trieNull'. This is the default implementation.+genericTrieNull ::+    ( TrieRep k ~ TrieRepDefault k+    ) =>+    Trie k a -> Bool+genericTrieNull (MkTrie (Compose mb)) = isNothing mb+{-# INLINABLE genericTrieNull #-}++-- | Generic implementation of 'singleton'. This is the default implementation.+genericSingleton ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    k -> a -> Trie k a+genericSingleton k v = MkTrie $ Compose $ Just $! gtrieSingleton (from k) v+{-# INLINABLE genericSingleton #-}++-- | Generic implementation of 'empty'. This is the default implementation.+genericEmpty ::+    ( TrieRep k ~ TrieRepDefault k+    ) =>+    Trie k a+genericEmpty = MkTrie (Compose Nothing)+{-# INLINABLE genericEmpty #-}++-- | Generic implementation of 'insert'. This is the default implementation.+genericInsert ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    k -> a -> Trie k a -> Trie k a+genericInsert k v (MkTrie (Compose m)) =+  case m of+    Nothing -> MkTrie (Compose (Just $! gtrieSingleton (from k) v))+    Just t  -> MkTrie (Compose (Just $! gtrieInsert (from k) v t))+{-# INLINABLE genericInsert #-}++-- | Generic implementation of 'delete'. This is the default implementation.+genericDelete ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    k -> Trie k a -> Trie k a+genericDelete k (MkTrie (Compose m)) = MkTrie (Compose (gtrieDelete (from k) =<< m))+{-# INLINABLE genericDelete #-}++-- | Generic implementation of 'trieMap'. This is the default implementation.+genericTrieMap ::+    ( GTrieKey (Rep k)+    , TrieRep k ~ TrieRepDefault k+    ) =>+    (a -> b) -> Trie k a -> Trie k b+genericTrieMap f (MkTrie (Compose x)) = MkTrie (Compose (fmap (gtrieMap f) $! x))+{-# INLINABLE genericTrieMap #-}+++-- | Generic implementation of 'trieTraverse'. This is the default implementation.+genericTrieTraverse ::+    ( GTrieKey (Rep k)+    , TrieRep k ~ TrieRepDefault k+    , Applicative f+    ) =>+    (a -> f b) -> Trie k a -> f (Trie k b)+genericTrieTraverse f (MkTrie (Compose x)) =+  fmap (MkTrie . Compose) (traverse (gtrieTraverse f) x)+{-# INLINABLE genericTrieTraverse #-}++-- | Generic implementation of 'trieShowsPrec'. This is the default implementation.+genericTrieShowsPrec ::+    ( Show a, GTrieKeyShow (Rep k)+    , TrieRep k ~ TrieRepDefault k+    ) =>+    Int -> Trie k a -> ShowS+genericTrieShowsPrec p (MkTrie (Compose m)) =+  case m of+    Just x  -> showsPrec p x+    Nothing -> showString "()"+{-# INLINABLE genericTrieShowsPrec #-}++-- | Generic implementation of 'mapMaybe'. This is the default implementation.+genericMapMaybeWithKey ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    (k -> a -> Maybe b) -> Trie k a -> Trie k b+genericMapMaybeWithKey f (MkTrie (Compose x)) = MkTrie (Compose (gmapMaybeWithKey (f . to) =<< x))+{-# INLINABLE genericMapMaybeWithKey #-}++-- | Generic implementation of 'foldWithKey'. This is the default implementation.+genericFoldWithKey ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    (k -> a -> r -> r) -> r -> Trie k a -> r+genericFoldWithKey f z (MkTrie (Compose m)) =+  case m of+    Nothing -> z+    Just x  -> gfoldWithKey (f . to) z x+{-# INLINABLE genericFoldWithKey #-}++-- | Generic implementation of 'traverseWithKey'. This is the default implementation.+genericTraverseWithKey ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    , Applicative f+    ) =>+    (k -> a -> f b) -> Trie k a -> f (Trie k b)+genericTraverseWithKey f (MkTrie (Compose m)) = fmap (MkTrie . Compose) (traverse (gtraverseWithKey (f . to)) m)+{-# INLINABLE genericTraverseWithKey #-}++-- | Generic implementation of 'mergeWithKey'. This is the default implementation.+genericMergeWithKey ::+    ( GTrieKey (Rep k), Generic k+    , TrieRep k ~ TrieRepDefault k+    ) =>+    (k -> a -> b -> Maybe c) -> (Trie k a -> Trie k c) -> (Trie k b -> Trie k c) ->+    Trie k a -> Trie k b -> Trie k c+genericMergeWithKey f g h (MkTrie (Compose x)) (MkTrie (Compose y)) =+  case (x,y) of+    (Nothing, Nothing) -> MkTrie (Compose Nothing)+    (Just{} , Nothing) -> g (MkTrie (Compose x))+    (Nothing, Just{} ) -> h (MkTrie (Compose y))+    (Just x', Just y') -> MkTrie (Compose (gmergeWithKey (f . to) (aux g) (aux h) x' y'))+      where+      aux k t = case k (MkTrie (Compose (Just t))) of+                  MkTrie (Compose r) -> r+{-# INLINABLE genericMergeWithKey #-}+++------------------------------------------------------------------------------ -- Generic implementation class ------------------------------------------------------------------------------  -- | Mapping of generic representation of keys to trie structures. data    family   GTrie (f :: * -> *) a-newtype instance GTrie (M1 i c f) a     = MTrie { unMTrie :: GTrie f a }+newtype instance GTrie (M1 i c f) a     = MTrie (GTrie f a) data    instance GTrie (f :+: g)  a     = STrieL !(GTrie f a) | STrieR !(GTrie g a)                                         | STrieB !(GTrie f a) !(GTrie g a) newtype instance GTrie (f :*: g)  a     = PTrie (GTrie f (GTrie g a)) newtype instance GTrie (K1 i k)   a     = KTrie (Trie k a) newtype instance GTrie U1         a     = UTrie a-data    instance GTrie V1         a     = VTrie+data    instance GTrie V1         a +instance GTrieKey f => Functor (GTrie f) where+  fmap = gtrieMap+ -- | TrieKey operations on Generic representations used to provide -- the default implementations of tries. class GTrieKey f where@@ -322,8 +514,14 @@   gtrieSingleton :: f p -> a -> GTrie f a   gtrieDelete    :: f p -> GTrie f a -> Maybe (GTrie f a)   gtrieMap       :: (a -> b) -> GTrie f a -> GTrie f b-  gtrieFold      :: (a -> b -> b) -> GTrie f a -> b -> b   gtrieTraverse  :: Applicative m => (a -> m b) -> GTrie f a -> m (GTrie f b)+  gmapMaybeWithKey :: (f p -> a -> Maybe b) -> GTrie f a -> Maybe (GTrie f b)+  gfoldWithKey   :: (f p -> a -> r -> r) -> r -> GTrie f a -> r+  gtraverseWithKey :: Applicative m => (f p -> a -> m b) -> GTrie f a -> m (GTrie f b)+  gmergeWithKey  :: (f p -> a -> b -> Maybe c) ->+                    (GTrie f a -> Maybe (GTrie f c)) ->+                    (GTrie f b -> Maybe (GTrie f c)) ->+                    GTrie f a -> GTrie f b -> Maybe (GTrie f c)  -- | The 'GTrieKeyShow' class provides generic implementations -- of 'showsPrec'. This class is separate due to its implementation@@ -342,15 +540,20 @@   gtrieSingleton (M1 k) v       = MTrie (gtrieSingleton k v)   gtrieDelete (M1 k) (MTrie x)  = fmap MTrie (gtrieDelete k x)   gtrieMap f (MTrie x)          = MTrie (gtrieMap f x)-  gtrieFold f (MTrie x)         = gtrieFold f x   gtrieTraverse f (MTrie x)     = fmap MTrie (gtrieTraverse f x)+  gmapMaybeWithKey f (MTrie x)  = fmap MTrie (gmapMaybeWithKey (f . M1) x)+  gfoldWithKey f z (MTrie x)    = gfoldWithKey (f . M1) z x+  gtraverseWithKey f (MTrie x)  = fmap MTrie (gtraverseWithKey (f . M1) x)+  gmergeWithKey f g h (MTrie x) (MTrie y) = fmap MTrie (gmergeWithKey (f . M1) (coerce g) (coerce h) x y)   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieSingleton #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieMap #-}-  {-# INLINE gtrieFold #-}+  {-# INLINE gmapMaybeWithKey #-}   {-# INLINE gtrieTraverse #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}  data MProxy c (f :: * -> *) a = MProxy @@ -369,24 +572,40 @@ -- Generic implementation for fields ------------------------------------------------------------------------------ +checkNull :: TrieKey k => Trie k a -> Maybe (Trie k a)+checkNull x+  | trieNull x = Nothing+  | otherwise  = Just x+ -- | Generic fields are represented by tries of the field type. instance TrieKey k => GTrieKey (K1 i k) where   gtrieLookup (K1 k) (KTrie x)          = lookup k x   gtrieInsert (K1 k) v (KTrie t)        = KTrie (insert k v t)   gtrieSingleton (K1 k) v               = KTrie (singleton k v)-  gtrieDelete (K1 k) (KTrie t)          = let m = delete k t-                                          in if trieNull m then Nothing-                                                           else Just (KTrie m)+  gtrieDelete (K1 k) (KTrie t)          = fmap KTrie (checkNull (delete k t))   gtrieMap f (KTrie x)                  = KTrie (trieMap f x)-  gtrieFold f (KTrie x )                = trieFold f x   gtrieTraverse f (KTrie x)             = fmap KTrie (traverse f x)+  gmapMaybeWithKey f (KTrie x)          = fmap KTrie (checkNull (mapMaybeWithKey (f . K1) x))+  gfoldWithKey f z (KTrie x)            = foldWithKey (f . K1) z x+  gtraverseWithKey f (KTrie x)          = fmap KTrie (traverseWithKey (f . K1) x)+  gmergeWithKey f g h (KTrie x) (KTrie y) = fmap KTrie (checkNull (mergeWithKey (f . K1) g' h' x y))+     where+     g' t = case g (KTrie t) of+              Just (KTrie t') -> t'+              Nothing         -> empty+     h' t = case h (KTrie t) of+              Just (KTrie t') -> t'+              Nothing         -> empty   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieSingleton #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieMap #-}-  {-# INLINE gtrieFold #-}   {-# INLINE gtrieTraverse #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}+  {-# INLINE gmergeWithKey #-}+  {-# INLINE gmapMaybeWithKey #-}  instance TrieKey k => GTrieKeyShow (K1 i k) where   gtrieShowsPrec p (KTrie x)            = showsPrec p x@@ -409,15 +628,39 @@                                                          Just tj -> Just (PTrie (gtrieInsert i tj t))   gtrieSingleton (i :*: j) v            = PTrie (gtrieSingleton i (gtrieSingleton j v))   gtrieMap f (PTrie x)                  = PTrie (gtrieMap (gtrieMap f) x)-  gtrieFold f (PTrie x)                 = gtrieFold (gtrieFold f) x   gtrieTraverse f (PTrie x)             = fmap PTrie (gtrieTraverse (gtrieTraverse f) x)+  gmapMaybeWithKey f (PTrie x)          = fmap PTrie (gmapMaybeWithKey (\i -> gmapMaybeWithKey (\j -> f (i:*:j))) x)+  gfoldWithKey f z (PTrie x)            = gfoldWithKey (\i m r -> gfoldWithKey (\j -> f (i:*:j)) r m) z x+  gtraverseWithKey f (PTrie x)          = fmap PTrie (gtraverseWithKey (\i ->+                                                      gtraverseWithKey (\j -> f (i :*: j))) x)+  gmergeWithKey f g h (PTrie x) (PTrie y) =+    fmap+      PTrie+      (gmergeWithKey+         (\i ->+           gmergeWithKey+             (\j -> f (i:*:j))+             (g' i)+             (h' i))+         (coerce g)+         (coerce h)+         x+         y)+    where+    g' i t = do PTrie t' <- g (PTrie (gtrieSingleton i t))+                gtrieLookup i t'+    h' i t = do PTrie t' <- h (PTrie (gtrieSingleton i t))+                gtrieLookup i t'   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieSingleton #-}   {-# INLINE gtrieMap #-}-  {-# INLINE gtrieFold #-}   {-# INLINE gtrieTraverse #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}+  {-# INLINE gmergeWithKey #-}+  {-# INLINE gmapMaybeWithKey #-}  instance (GTrieKeyShow f, GTrieKeyShow g) => GTrieKeyShow (f :*: g) where   gtrieShowsPrec p (PTrie x)            = showsPrec p x@@ -461,21 +704,69 @@   gtrieMap f (STrieL x)                 = STrieL (gtrieMap f x)   gtrieMap f (STrieR y)                 = STrieR (gtrieMap f y) -  gtrieFold f (STrieB x y)              = gtrieFold f x . gtrieFold f y-  gtrieFold f (STrieL x)                = gtrieFold f x-  gtrieFold f (STrieR y)                = gtrieFold f y-   gtrieTraverse f (STrieB x y)          = liftA2 STrieB (gtrieTraverse f x) (gtrieTraverse f y)   gtrieTraverse f (STrieL x)            = fmap STrieL (gtrieTraverse f x)   gtrieTraverse f (STrieR y)            = fmap STrieR (gtrieTraverse f y) +  gmapMaybeWithKey f (STrieL x)         = fmap STrieL (gmapMaybeWithKey (f . L1) x)+  gmapMaybeWithKey f (STrieR y)         = fmap STrieR (gmapMaybeWithKey (f . R1) y)+  gmapMaybeWithKey f (STrieB x y)       = case (gmapMaybeWithKey (f . L1) x, gmapMaybeWithKey (f . R1) y) of+                                            (Nothing, Nothing) -> Nothing+                                            (Just x', Nothing) -> Just (STrieL x')+                                            (Nothing, Just y') -> Just (STrieR y')+                                            (Just x', Just y') -> Just (STrieB x' y')++  gfoldWithKey f z (STrieL x)           = gfoldWithKey (f . L1) z x+  gfoldWithKey f z (STrieR y)           = gfoldWithKey (f . R1) z y+  gfoldWithKey f z (STrieB x y)         = gfoldWithKey (f . L1) (gfoldWithKey (f . R1) z y) x++  gtraverseWithKey f (STrieL x)         = fmap STrieL (gtraverseWithKey (f . L1) x)+  gtraverseWithKey f (STrieR y)         = fmap STrieR (gtraverseWithKey (f . R1) y)+  gtraverseWithKey f (STrieB x y)       = liftA2 STrieB (gtraverseWithKey (f . L1) x)+                                                        (gtraverseWithKey (f . R1) y)++  gmergeWithKey f g h x0 y0 =+    case (split x0, split y0) of+      ((xl,xr),(yl,yr)) -> build (mergel xl yl) (merger xr yr)+    where+    split (STrieL x)   = (Just x, Nothing)+    split (STrieR y)   = (Nothing, Just y)+    split (STrieB x y) = (Just x, Just y)++    build (Just x) (Just y) = Just (STrieB x y)+    build (Just x) Nothing  = Just (STrieL x)+    build Nothing  (Just y) = Just (STrieR y)+    build Nothing  Nothing  = Nothing++    mergel Nothing  Nothing  = Nothing+    mergel (Just x) Nothing  = gl x+    mergel Nothing  (Just y) = hl y+    mergel (Just x) (Just y) = gmergeWithKey (f . L1) gl hl x y++    merger Nothing  Nothing  = Nothing+    merger (Just x) Nothing  = gr x+    merger Nothing  (Just y) = hr y+    merger (Just x) (Just y) = gmergeWithKey (f . R1) gr hr x y++    gl t = do STrieL t' <- g (STrieL t)+              return t'+    gr t = do STrieR t' <- g (STrieR t)+              return t'+    hl t = do STrieL t' <- h (STrieL t)+              return t'+    hr t = do STrieR t' <- h (STrieR t)+              return t'+   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieSingleton #-}-  {-# INLINE gtrieFold #-}   {-# INLINE gtrieTraverse #-}   {-# INLINE gtrieMap #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}+  {-# INLINE gmergeWithKey #-}+  {-# INLINE gmapMaybeWithKey #-}  instance (GTrieKeyShow f, GTrieKeyShow g) => GTrieKeyShow (f :+: g) where   gtrieShowsPrec p (STrieB x y)         = showParen (p > 10)@@ -501,15 +792,21 @@   gtrieDelete _ _               = Nothing   gtrieSingleton _              = UTrie   gtrieMap f (UTrie x)          = UTrie (f x)-  gtrieFold f (UTrie x)         = f x   gtrieTraverse f (UTrie x)     = fmap UTrie (f x)+  gmapMaybeWithKey f (UTrie x)  = fmap UTrie (f U1 x)+  gfoldWithKey f z (UTrie x)    = f U1 x z+  gtraverseWithKey f (UTrie x)  = fmap UTrie (f U1 x)+  gmergeWithKey f _ _ (UTrie x) (UTrie y) = fmap UTrie (f U1 x y)   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieSingleton #-}-  {-# INLINE gtrieFold #-}   {-# INLINE gtrieTraverse #-}   {-# INLINE gtrieMap #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}+  {-# INLINE gmergeWithKey #-}+  {-# INLINE gmapMaybeWithKey #-}  instance GTrieKeyShow U1 where   gtrieShowsPrec p (UTrie x)    = showsPrec p x@@ -520,20 +817,26 @@  -- | Tries of types without constructors are represented by a unit. instance GTrieKey V1 where-  gtrieLookup k _               = k `seq` error "GTrieKey.V1: gtrieLookup"-  gtrieInsert k _ _             = k `seq` error "GTrieKey.V1: gtrieInsert"-  gtrieDelete k _               = k `seq` error "GTrieKey.V1: gtrieDelete"+  gtrieLookup k t               = k `seq` t `seq` error "GTrieKey.V1: gtrieLookup"+  gtrieInsert k _ t             = k `seq` t `seq` error "GTrieKey.V1: gtrieInsert"+  gtrieDelete k t               = k `seq` t `seq` error "GTrieKey.V1: gtrieDelete"   gtrieSingleton k _            = k `seq` error "GTrieKey.V1: gtrieSingleton"-  gtrieMap _ _                  = VTrie-  gtrieFold _ _                 = id-  gtrieTraverse _ _             = pure VTrie+  gtrieMap _ t                  = t `seq` error "GTrieKey.V1: gtrieMap"+  gtrieTraverse _ t             = t `seq` error "GTrieKey.V1: gtrieTraverse"+  gmapMaybeWithKey _ t          = t `seq` error "GTrieKey.V1: gmapMaybeWithKey"+  gfoldWithKey _ _ t            = t `seq` error "GTrieKey.V1: gmapFoldWithKey"+  gtraverseWithKey _ t          = t `seq` error "GTrieKey.V1: gtraverseWithKey"+  gmergeWithKey _ _ _ t u       = t `seq` u `seq` error "GTrieKey.V1: gmergeWithKey"   {-# INLINE gtrieLookup #-}   {-# INLINE gtrieInsert #-}   {-# INLINE gtrieDelete #-}   {-# INLINE gtrieSingleton #-}-  {-# INLINE gtrieFold #-}   {-# INLINE gtrieMap #-}   {-# INLINE gtrieTraverse #-}+  {-# INLINE gfoldWithKey #-}+  {-# INLINE gtraverseWithKey #-}+  {-# INLINE gmergeWithKey #-}+  {-# INLINE gmapMaybeWithKey #-}  instance GTrieKeyShow V1 where   gtrieShowsPrec _ _            = showString "()"@@ -545,7 +848,6 @@ -- | Construct a trie from a list of key/value pairs fromList :: TrieKey k => [(k,v)] -> Trie k v fromList = foldl' (\acc (k,v) -> insert k v acc) empty-{-# INLINE fromList #-}  -- | Alter the values of a trie. The function will take the value stored -- as the given key if one exists and should return a value to insert at@@ -564,6 +866,40 @@ notMember :: TrieKey k => k -> Trie k a -> Bool notMember k t = isNothing (lookup k t) +-- | Transform 'Trie' to an association list.+toList :: TrieKey k => Trie k a -> [(k,a)]+toList = foldWithKey (\k v xs -> (k,v) : xs) []++union :: TrieKey k => Trie k a -> Trie k a -> Trie k a+union = mergeWithKey (\_ a _ -> Just a) id id++unionWith :: TrieKey k => (a -> a -> a) -> Trie k a -> Trie k a -> Trie k a+unionWith f = mergeWithKey (\_ a b -> Just (f a b)) id id++unionWithKey :: TrieKey k => (k -> a -> a -> a) -> Trie k a -> Trie k a -> Trie k a+unionWithKey f = mergeWithKey (\k a b -> Just (f k a b)) id id++intersection :: TrieKey k => Trie k a -> Trie k b -> Trie k a+intersection = mergeWithKey (\_ a _ -> Just a) (const empty) (const empty)++intersectionWith :: TrieKey k => (a -> b -> c) -> Trie k a -> Trie k b -> Trie k c+intersectionWith f = mergeWithKey (\_ a b -> Just (f a b)) (const empty) (const empty)++intersectionWithKey :: TrieKey k => (k -> a -> b -> c) -> Trie k a -> Trie k b -> Trie k c+intersectionWithKey f = mergeWithKey (\k a b -> Just (f k a b)) (const empty) (const empty)++difference :: TrieKey k => Trie k a -> Trie k b -> Trie k a+difference = mergeWithKey (\_ _ _ -> Nothing) id (const empty)++differenceWith :: TrieKey k => (a -> b -> Maybe a) -> Trie k a -> Trie k b -> Trie k a+differenceWith f = mergeWithKey (\_ -> f) id (const empty)++differenceWithKey :: TrieKey k => (k -> a -> b -> Maybe a) -> Trie k a -> Trie k b -> Trie k a+differenceWithKey f = mergeWithKey f id (const empty)++mapMaybe :: TrieKey k => (a -> Maybe b) -> Trie k a -> Trie k b+mapMaybe f = mapMaybeWithKey (\_ -> f)+ ------------------------------------------------------------------------------ -- Various instances for Trie ------------------------------------------------------------------------------@@ -578,7 +914,7 @@   fmap = trieMap  instance TrieKey k => Foldable (Trie k) where-  foldr f z t = trieFold f t z+  foldr f = foldWithKey (\_ -> f)  instance TrieKey k => Traversable (Trie k) where   traverse = trieTraverse