generic-trie-0.3.0.2/0000755000000000000000000000000012720741046012420 5ustar0000000000000000generic-trie-0.3.0.2/CHANGELOG.md0000644000000000000000000000004612720741046014231 0ustar00000000000000000.3.0.2 ------- * GHC 8 compatibility generic-trie-0.3.0.2/generic-trie.cabal0000644000000000000000000000302112720741046015755 0ustar0000000000000000name: generic-trie version: 0.3.0.2 synopsis: A map, where the keys may be complex structured data. 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 structure, so values of types that have support for 'Generic' may be automatically used as keys in the map. license: BSD3 license-file: LICENSE author: Eric Mertens maintainer: emertens@gmail.com category: Data build-type: Simple cabal-version: >=1.10 homepage: http://github.com/glguy/tries bug-reports: http://github.com/glguy/tries/issues extra-source-files: CHANGELOG.md library exposed-modules: Data.GenericTrie, Data.GenericTrie.Internal build-depends: base >= 4.5 && < 4.10, transformers >= 0.2 && < 0.6, containers >= 0.4.2.1 && < 0.6 GHC-options: -O2 -Wall hs-source-dirs: src default-language: Haskell2010 source-repository head type: git location: git://github.com/glguy/tries.git generic-trie-0.3.0.2/LICENSE0000644000000000000000000000276212720741046013434 0ustar0000000000000000Copyright (c) 2014, Eric Mertens All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Eric Mertens nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. generic-trie-0.3.0.2/Setup.hs0000644000000000000000000000005612720741046014055 0ustar0000000000000000import Distribution.Simple main = defaultMain generic-trie-0.3.0.2/src/0000755000000000000000000000000012720741046013207 5ustar0000000000000000generic-trie-0.3.0.2/src/Data/0000755000000000000000000000000012720741046014060 5ustar0000000000000000generic-trie-0.3.0.2/src/Data/GenericTrie.hs0000644000000000000000000002110312720741046016611 0ustar0000000000000000{-# LANGUAGE Safe #-} {- | This module implements an interface for working with maps. For primitive types, like 'Int', the library automatically selects an efficient implementation (e.g., an "IntMap"). For complex structured types, the library uses an implementation based on tries: this is useful when using large and similar keys where comparing for order may become expensive, and storing the distinct keys would be inefficient. The 'OrdKey' type allows for maps with complex keys, where the keys are compared based on order, rather than using the trie implementation. All methods of 'TrieKey' can be derived automatically using a 'GHC.Generics.Generic' instance. @ data Demo = DemoC1 'Int' | DemoC2 'Int' 'Char' deriving 'GHC.Generics.Generic' instance 'TrieKey' Demo @ -} module Data.GenericTrie ( -- * Trie interface Trie , TrieKey -- ** Construction , empty , singleton , fromList , fromListWith , fromListWith' -- ** Updates , alter , insert , insertWith , insertWith' , delete , at -- ** Queries , member , notMember , null , lookup -- ** Folding , foldWithKey , fold , toList -- ** Traversing , traverseWithKey , mapMaybe , mapMaybeWithKey , filter , filterWithKey -- ** Combining maps , union , unionWith , unionWithKey , intersection , intersectionWith , intersectionWithKey , difference , differenceWith , differenceWithKey -- * Keys using 'Ord' , OrdKey(..) ) where import Control.Applicative (Applicative) import Data.List (foldl') import Data.Maybe (isNothing, isJust) import Prelude hiding (lookup, null, filter) import Data.GenericTrie.Internal ------------------------------------------------------------------------------ -- Various helpers ------------------------------------------------------------------------------ -- | 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 -- | Construct a trie from a list of key-value pairs. -- The given function is used to combine values at the -- same key. fromListWith :: TrieKey k => (v -> v -> v) -> [(k,v)] -> Trie k v fromListWith f = foldl' (\acc (k,v) -> insertWith f k v acc) empty -- | Version of 'fromListWith' which is strict in the result of -- the combining function. fromListWith' :: TrieKey k => (v -> v -> v) -> [(k,v)] -> Trie k v fromListWith' f = foldl' (\acc (k,v) -> insertWith' f k v acc) empty -- | Construct an empty trie empty :: TrieKey k => Trie k a empty = trieEmpty {-# INLINE empty #-} -- | Test for an empty trie null :: TrieKey k => Trie k a -> Bool null = trieNull {-# INLINE null #-} -- | Lookup an element from a trie lookup :: TrieKey k => k -> Trie k a -> Maybe a lookup = trieLookup {-# INLINE lookup #-} -- | Lens for the value at a given key at :: (Functor f, TrieKey k) => k -> (Maybe a -> f (Maybe a)) -> Trie k a -> f (Trie k a) at k f m = fmap aux (f mv) where mv = lookup k m aux r = case r of Nothing -> maybe m (const (delete k m)) mv Just v' -> insert k v' m -- | Insert an element into a trie insert :: TrieKey k => k -> a -> Trie k a -> Trie k a insert = trieInsert {-# INLINE insert #-} -- | Delete an element from a trie delete :: TrieKey k => k -> Trie k a -> Trie k a delete = trieDelete {-# INLINE delete #-} -- | Construct a trie holding a single value singleton :: TrieKey k => k -> a -> Trie k a singleton = trieSingleton {-# INLINE singleton #-} -- | Apply a function to the values of a trie and keep the elements -- of the trie that result in a 'Just' value. mapMaybeWithKey :: TrieKey k => (k -> a -> Maybe b) -> Trie k a -> Trie k b mapMaybeWithKey = trieMapMaybeWithKey {-# INLINE mapMaybeWithKey #-} -- | Filter the values of a trie with the given predicate. filter :: TrieKey k => (a -> Bool) -> Trie k a -> Trie k a filter p = filterWithKey (const p) -- | Version of 'filter' where the predicate also gets the key. filterWithKey :: TrieKey k => (k -> a -> Bool) -> Trie k a -> Trie k a filterWithKey p = mapMaybeWithKey aux where aux k x | p k x = Just x | otherwise = Nothing -- | Fold a trie with a function of the value fold :: TrieKey k => (a -> r -> r) -> r -> Trie k a -> r fold = trieFoldWithKey . const {-# INLINE fold #-} -- | Fold a trie with a function of both key and value foldWithKey :: TrieKey k => (k -> a -> r -> r) -> r -> Trie k a -> r foldWithKey = trieFoldWithKey {-# INLINE foldWithKey #-} -- | Traverse a trie with a function of both key and value traverseWithKey :: (TrieKey k, Applicative f) => (k -> a -> f b) -> Trie k a -> f (Trie k b) traverseWithKey = trieTraverseWithKey {-# INLINE traverseWithKey #-} mergeWithKey :: TrieKey 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 = trieMergeWithKey {-# INLINE mergeWithKey #-} -- | Alter the value at the given key location. -- The parameter function takes the value stored -- at the given key, if one exists, and should return a value to insert at -- that location, or 'Nothing' to delete from that location. alter :: TrieKey k => k -> (Maybe a -> Maybe a) -> Trie k a -> Trie k a alter k f t = case f (lookup k t) of Just v' -> insert k v' t Nothing -> delete k t -- | Insert a value at the given key. The combining function is used -- when a value is already stored at that key. The new value is the -- first argument to the combining function. insertWith :: TrieKey k => (v -> v -> v) -> k -> v -> Trie k v -> Trie k v insertWith f k v = alter k $ \mb -> case mb of Just v0 -> Just (f v v0) Nothing -> Just v -- | Version of 'insertWith' that is strict in the result of combining -- two elements. insertWith' :: TrieKey k => (v -> v -> v) -> k -> v -> Trie k v -> Trie k v insertWith' f k v = alter k $ \mb -> case mb of Just v0 -> Just $! f v v0 Nothing -> Just v -- | Returns 'True' when the 'Trie' has a value stored at the given key. member :: TrieKey k => k -> Trie k a -> Bool member k t = isJust (lookup k t) -- | Returns 'False' when the 'Trie' has a value stored at the given key. notMember :: TrieKey k => k -> Trie k a -> Bool notMember k t = isNothing (lookup k t) -- | Transform a trie to an association list. toList :: TrieKey k => Trie k a -> [(k,a)] toList = foldWithKey (\k v xs -> (k,v) : xs) [] -- | Left-biased union of two tries union :: TrieKey k => Trie k a -> Trie k a -> Trie k a union = mergeWithKey (\_ a _ -> Just a) id id -- | Union of two tries with function used to merge overlapping elements 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 -- | Union of two tries with function used to merge overlapping elements along with key 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 -- | Left-biased intersection of two tries intersection :: TrieKey k => Trie k a -> Trie k b -> Trie k a intersection = mergeWithKey (\_ a _ -> Just a) (const empty) (const empty) -- | Intersection of two tries parameterized by a combining function of the -- values at overlapping keys 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) -- | Intersection of two tries parameterized by a combining function of the -- key and the values at overlapping keys 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) -- | Remove the keys of the right trie from the left trie difference :: TrieKey k => Trie k a -> Trie k b -> Trie k a difference = mergeWithKey (\_ _ _ -> Nothing) id (const empty) -- | Parameterized 'difference' using a custom merge function. -- Return 'Just' to change the value stored in left trie, or -- 'Nothing' to remove from the left trie. differenceWith :: TrieKey k => (a -> b -> Maybe a) -> Trie k a -> Trie k b -> Trie k a differenceWith f = mergeWithKey (\_ -> f) id (const empty) -- | 'differenceWith' where function also has access to the key differenceWithKey :: TrieKey k => (k -> a -> b -> Maybe a) -> Trie k a -> Trie k b -> Trie k a differenceWithKey f = mergeWithKey f id (const empty) -- | Map a function over a trie filtering out elements where function returns 'Nothing' mapMaybe :: TrieKey k => (a -> Maybe b) -> Trie k a -> Trie k b mapMaybe f = mapMaybeWithKey (\_ -> f) generic-trie-0.3.0.2/src/Data/GenericTrie/0000755000000000000000000000000012720741046016260 5ustar0000000000000000generic-trie-0.3.0.2/src/Data/GenericTrie/Internal.hs0000644000000000000000000010437012720741046020375 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} -- coerce {-# LANGUAGE CPP #-} -- MProxy on ghc >= 8 #if MIN_VERSION_base(4,9,0) {-# LANGUAGE DataKinds #-} -- Meta #endif -- | Unstable implementation details module Data.GenericTrie.Internal ( TrieKey(..) , Trie(..) , 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) import Data.Char (chr, ord) import Data.Coerce (coerce) import Data.Foldable (Foldable) import Data.Functor.Compose (Compose(..)) import Data.IntMap (IntMap) import Data.Map (Map) import Data.Maybe (isNothing) import Data.Traversable (Traversable,traverse) import GHC.Generics import qualified Data.Foldable as Foldable import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Prelude -- | Types that may be used as the key of a 'Trie'. -- -- For @data@ delcarations, the instance can be automatically derived from -- a 'Generic' instance. class TrieKey k where -- | Type of the representation of tries for this key. type TrieRep k :: * -> * -- | Construct an empty trie trieEmpty :: Trie k a -- | Test for an empty trie trieNull :: Trie k a -> Bool -- | Lookup element from trie trieLookup :: k -> Trie k a -> Maybe a -- | Insert element into trie trieInsert :: k -> a -> Trie k a -> Trie k a -- | Delete element from trie trieDelete :: k -> Trie k a -> Trie k a -- | Construct a trie holding a single value trieSingleton :: k -> a -> Trie k a -- | Apply a function to all values stored in a trie trieMap :: (a -> b) -> Trie k a -> Trie k 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. trieMapMaybeWithKey :: (k -> a -> Maybe b) -> Trie k a -> Trie k b -- | Fold a trie with a function of both key and value. trieFoldWithKey :: (k -> a -> r -> r) -> r -> Trie k a -> r -- | Traverse a trie with a function of both key and value. trieTraverseWithKey :: Applicative f => (k -> a -> f b) -> Trie k a -> f (Trie k b) trieMergeWithKey :: (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 = TrieRepDefault k default trieEmpty :: ( TrieRep k ~ TrieRepDefault k) => Trie k a trieEmpty = genericEmpty default trieSingleton :: ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) => k -> a -> Trie k a trieSingleton = genericSingleton default trieNull :: ( TrieRep k ~ TrieRepDefault k) => Trie k a -> Bool trieNull = genericTrieNull default trieLookup :: ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) => k -> Trie k a -> Maybe a trieLookup = genericLookup default trieInsert :: ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) => k -> a -> Trie k a -> Trie k a trieInsert = genericInsert default trieDelete :: ( GTrieKey (Rep k), Generic k , TrieRep k ~ TrieRepDefault k) => k -> Trie k a -> Trie k a trieDelete = genericDelete default trieMap :: ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k) => (a -> b) -> Trie k a -> Trie k b trieMap = genericTrieMap default trieTraverse :: ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k , Applicative f) => (a -> f b) -> Trie k a -> f (Trie k b) trieTraverse = genericTrieTraverse default trieShowsPrec :: ( Show a, GTrieKeyShow (Rep k) , TrieRep k ~ TrieRepDefault k) => Int -> Trie k a -> ShowS trieShowsPrec = genericTrieShowsPrec default trieMapMaybeWithKey :: ( GTrieKey (Rep k) , Generic k, TrieRep k ~ TrieRepDefault k) => (k -> a -> Maybe b) -> Trie k a -> Trie k b trieMapMaybeWithKey = genericMapMaybeWithKey default trieFoldWithKey :: ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k, Generic k) => (k -> a -> r -> r) -> r -> Trie k a -> r trieFoldWithKey = genericFoldWithKey default trieTraverseWithKey :: ( GTrieKey (Rep k) , TrieRep k ~ TrieRepDefault k, Generic k, Applicative f) => (k -> a -> f b) -> Trie k a -> f (Trie k b) trieTraverseWithKey = genericTraverseWithKey default trieMergeWithKey :: ( 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 trieMergeWithKey = 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 = Compose Maybe (GTrie (Rep k)) -- | A map from keys of type @k@, to values of type @a@. newtype Trie k a = MkTrie (TrieRep k a) ------------------------------------------------------------------------------ -- Manually derived instances for base types ------------------------------------------------------------------------------ -- | 'Int' tries are implemented with 'IntMap'. instance TrieKey Int where type TrieRep Int = IntMap trieLookup k (MkTrie x) = IntMap.lookup k x trieInsert k v (MkTrie t) = MkTrie (IntMap.insert k v t) trieDelete k (MkTrie t) = MkTrie (IntMap.delete k t) trieEmpty = MkTrie IntMap.empty trieSingleton k v = MkTrie (IntMap.singleton k v) trieNull (MkTrie x) = IntMap.null x trieMap f (MkTrie x) = MkTrie (IntMap.map f x) trieTraverse f (MkTrie x) = fmap MkTrie (traverse f x) trieShowsPrec p (MkTrie x) = showsPrec p x trieMapMaybeWithKey f (MkTrie x) = MkTrie (IntMap.mapMaybeWithKey f x) trieFoldWithKey f z (MkTrie x) = IntMap.foldWithKey f z x trieTraverseWithKey f (MkTrie x) = fmap MkTrie (IntMap.traverseWithKey f x) trieMergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (IntMap.mergeWithKey f (coerce g) (coerce h) x y) {-# INLINABLE trieEmpty #-} {-# INLINABLE trieInsert #-} {-# INLINABLE trieLookup #-} {-# INLINABLE trieDelete #-} {-# INLINABLE trieSingleton #-} {-# INLINABLE trieFoldWithKey #-} {-# INLINABLE trieShowsPrec #-} {-# INLINABLE trieTraverse #-} {-# INLINABLE trieTraverseWithKey #-} {-# INLINABLE trieNull #-} {-# INLINABLE trieMap #-} {-# INLINABLE trieMergeWithKey #-} {-# INLINABLE trieMapMaybeWithKey #-} -- | 'Integer' tries are implemented with 'Map'. instance TrieKey Integer where type TrieRep Integer = Map Integer trieLookup k (MkTrie t) = Map.lookup k t trieInsert k v (MkTrie t) = MkTrie (Map.insert k v t) trieDelete k (MkTrie t) = MkTrie (Map.delete k t) trieEmpty = MkTrie Map.empty trieSingleton k v = MkTrie (Map.singleton k v) trieNull (MkTrie x) = Map.null x trieMap f (MkTrie x) = MkTrie (Map.map f x) trieTraverse f (MkTrie x) = fmap MkTrie (traverse f x) trieShowsPrec p (MkTrie x) = showsPrec p x trieMapMaybeWithKey f (MkTrie x) = MkTrie (Map.mapMaybeWithKey f x) trieFoldWithKey f z (MkTrie x) = Map.foldrWithKey f z x trieTraverseWithKey f (MkTrie x) = fmap MkTrie (Map.traverseWithKey f x) trieMergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (Map.mergeWithKey f (coerce g) (coerce h) x y) {-# INLINABLE trieEmpty #-} {-# INLINABLE trieInsert #-} {-# INLINABLE trieLookup #-} {-# INLINABLE trieDelete #-} {-# INLINABLE trieSingleton #-} {-# INLINABLE trieFoldWithKey #-} {-# INLINABLE trieShowsPrec #-} {-# INLINABLE trieTraverse #-} {-# INLINABLE trieTraverseWithKey #-} {-# INLINABLE trieNull #-} {-# INLINABLE trieMap #-} {-# INLINABLE trieMergeWithKey #-} {-# INLINABLE trieMapMaybeWithKey #-} -- | 'Char' tries are implemented with 'IntMap'. instance TrieKey Char where type TrieRep Char = IntMap trieLookup k (MkTrie t) = IntMap.lookup (ord k) t trieDelete k (MkTrie t) = MkTrie (IntMap.delete (ord k) t) trieInsert k v (MkTrie t) = MkTrie (IntMap.insert (ord k) v t) trieEmpty = MkTrie IntMap.empty trieSingleton k v = MkTrie (IntMap.singleton (ord k) v) trieNull (MkTrie x) = IntMap.null x trieMap f (MkTrie x) = MkTrie (IntMap.map f x) trieTraverse f (MkTrie x) = fmap MkTrie (traverse f x) trieShowsPrec p (MkTrie x) = showsPrec p x trieMapMaybeWithKey f (MkTrie x) = MkTrie (IntMap.mapMaybeWithKey (f . chr) x) trieFoldWithKey f z (MkTrie x) = IntMap.foldrWithKey (f . chr) z x trieTraverseWithKey f (MkTrie x) = fmap MkTrie (IntMap.traverseWithKey (f . chr) x) trieMergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (IntMap.mergeWithKey (f . chr) (coerce g) (coerce h) x y) {-# INLINABLE trieEmpty #-} {-# INLINABLE trieInsert #-} {-# INLINABLE trieLookup #-} {-# INLINABLE trieDelete #-} {-# INLINABLE trieSingleton #-} {-# INLINABLE trieFoldWithKey #-} {-# INLINABLE trieShowsPrec #-} {-# INLINABLE trieTraverse #-} {-# INLINABLE trieTraverseWithKey #-} {-# INLINABLE trieNull #-} {-# INLINABLE trieMap #-} {-# INLINABLE trieMergeWithKey #-} {-# INLINABLE trieMapMaybeWithKey #-} -- | Tries indexed by 'OrdKey' will be represented as an ordinary 'Map' -- and the keys will be compared based on the 'Ord' instance for @k@. newtype OrdKey k = OrdKey { getOrdKey :: k } deriving (Read, Show, Eq, Ord) -- | 'OrdKey' tries are implemented with 'Map', this is -- intended for cases where it is better for some reason -- 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) = Map k trieLookup (OrdKey k) (MkTrie x) = Map.lookup k x trieInsert (OrdKey k) v (MkTrie x) = MkTrie (Map.insert k v x) trieDelete (OrdKey k) (MkTrie x) = MkTrie (Map.delete k x) trieEmpty = MkTrie Map.empty trieSingleton (OrdKey k) v = MkTrie (Map.singleton k v) trieNull (MkTrie x) = Map.null x trieMap f (MkTrie x) = MkTrie (Map.map f x) trieTraverse f (MkTrie x) = fmap MkTrie (traverse f x) trieShowsPrec p (MkTrie x) = showsPrec p x trieMapMaybeWithKey f (MkTrie x) = MkTrie (Map.mapMaybeWithKey (f . OrdKey) x) trieFoldWithKey f z (MkTrie x) = Map.foldrWithKey (f . OrdKey) z x trieTraverseWithKey f (MkTrie x) = fmap MkTrie (Map.traverseWithKey (f . OrdKey) x) trieMergeWithKey f g h (MkTrie x) (MkTrie y) = MkTrie (Map.mergeWithKey (f . OrdKey) (coerce g) (coerce h) x y) {-# INLINABLE trieEmpty #-} {-# INLINABLE trieInsert #-} {-# INLINABLE trieLookup #-} {-# INLINABLE trieDelete #-} {-# INLINABLE trieSingleton #-} {-# INLINABLE trieFoldWithKey #-} {-# INLINABLE trieShowsPrec #-} {-# INLINABLE trieTraverse #-} {-# INLINABLE trieTraverseWithKey #-} {-# INLINABLE trieNull #-} {-# INLINABLE trieMap #-} {-# INLINABLE trieMergeWithKey #-} {-# INLINABLE trieMapMaybeWithKey #-} ------------------------------------------------------------------------------ -- Automatically derived instances for common types ------------------------------------------------------------------------------ instance TrieKey () instance TrieKey Bool instance TrieKey k => TrieKey (Maybe k) instance (TrieKey a, TrieKey b) => TrieKey (Either a b) instance (TrieKey a, TrieKey b) => TrieKey (a,b) instance (TrieKey a, TrieKey b, TrieKey c) => TrieKey (a,b,c) instance (TrieKey a, TrieKey b, TrieKey c, TrieKey d) => TrieKey (a,b,c,d) instance (TrieKey a, TrieKey b, TrieKey c, TrieKey d, TrieKey e) => TrieKey (a,b,c,d,e) 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)) = MkTrie $ Compose $ case m of Nothing -> Just $! gtrieSingleton (from k) v Just t -> 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 (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 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 gtrieLookup :: f p -> GTrie f a -> Maybe a gtrieInsert :: f p -> a -> GTrie f a -> GTrie f a 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 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 -- varying for diferent kinds of metadata. class GTrieKeyShow f where gtrieShowsPrec :: Show a => Int -> GTrie f a -> ShowS ------------------------------------------------------------------------------ -- Generic implementation for metadata ------------------------------------------------------------------------------ -- | Generic metadata is skipped in trie representation and operations. instance GTrieKey f => GTrieKey (M1 i c f) where gtrieLookup (M1 k) (MTrie x) = gtrieLookup k x gtrieInsert (M1 k) v (MTrie t)= MTrie (gtrieInsert k v t) 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) 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 gmapMaybeWithKey #-} {-# INLINE gtrieTraverse #-} {-# INLINE gfoldWithKey #-} {-# INLINE gtraverseWithKey #-} #if MIN_VERSION_base(4,9,0) data MProxy (c :: Meta) (f :: * -> *) a = MProxy #else data MProxy (c :: *) (f :: * -> *) a = MProxy #endif instance GTrieKeyShow f => GTrieKeyShow (M1 D d f) where gtrieShowsPrec p (MTrie x) = showsPrec p x instance (Constructor c, GTrieKeyShow f) => GTrieKeyShow (M1 C c f) where gtrieShowsPrec p (MTrie x) = showParen (p > 10) $ showString "Con " . shows (conName (MProxy :: MProxy c f ())) . showString " " . showsPrec 11 x instance GTrieKeyShow f => GTrieKeyShow (M1 S s f) where gtrieShowsPrec p (MTrie x) = showsPrec p x ------------------------------------------------------------------------------ -- 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) = trieLookup k x gtrieInsert (K1 k) v (KTrie t) = KTrie (trieInsert k v t) gtrieSingleton (K1 k) v = KTrie (trieSingleton k v) gtrieDelete (K1 k) (KTrie t) = fmap KTrie (checkNull (trieDelete k t)) gtrieMap f (KTrie x) = KTrie (trieMap f x) gtrieTraverse f (KTrie x) = fmap KTrie (trieTraverse f x) gmapMaybeWithKey f (KTrie x) = fmap KTrie (checkNull (trieMapMaybeWithKey (f . K1) x)) gfoldWithKey f z (KTrie x) = trieFoldWithKey (f . K1) z x gtraverseWithKey f (KTrie x) = fmap KTrie (trieTraverseWithKey (f . K1) x) gmergeWithKey f g h (KTrie x) (KTrie y) = fmap KTrie (checkNull (trieMergeWithKey (f . K1) g' h' x y)) where g' t = case g (KTrie t) of Just (KTrie t') -> t' Nothing -> trieEmpty h' t = case h (KTrie t) of Just (KTrie t') -> t' Nothing -> trieEmpty {-# INLINE gtrieLookup #-} {-# INLINE gtrieInsert #-} {-# INLINE gtrieSingleton #-} {-# INLINE gtrieDelete #-} {-# INLINE gtrieMap #-} {-# 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 ------------------------------------------------------------------------------ -- Generic implementation for products ------------------------------------------------------------------------------ -- | Generic products are represented by tries of tries. instance (GTrieKey f, GTrieKey g) => GTrieKey (f :*: g) where gtrieLookup (i :*: j) (PTrie x) = gtrieLookup j =<< gtrieLookup i x gtrieInsert (i :*: j) v (PTrie t) = case gtrieLookup i t of Nothing -> PTrie (gtrieInsert i (gtrieSingleton j v) t) Just ti -> PTrie (gtrieInsert i (gtrieInsert j v ti) t) gtrieDelete (i :*: j) (PTrie t) = case gtrieLookup i t of Nothing -> Just (PTrie t) Just ti -> case gtrieDelete j ti of Nothing -> fmap PTrie $! gtrieDelete i t 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) 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 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 ------------------------------------------------------------------------------ -- Generic implementation for sums ------------------------------------------------------------------------------ -- | Generic sums are represented by up to a pair of sub-tries. instance (GTrieKey f, GTrieKey g) => GTrieKey (f :+: g) where gtrieLookup (L1 k) (STrieL x) = gtrieLookup k x gtrieLookup (L1 k) (STrieB x _) = gtrieLookup k x gtrieLookup (R1 k) (STrieR y) = gtrieLookup k y gtrieLookup (R1 k) (STrieB _ y) = gtrieLookup k y gtrieLookup _ _ = Nothing gtrieInsert (L1 k) v (STrieL x) = STrieL (gtrieInsert k v x) gtrieInsert (L1 k) v (STrieR y) = STrieB (gtrieSingleton k v) y gtrieInsert (L1 k) v (STrieB x y) = STrieB (gtrieInsert k v x) y gtrieInsert (R1 k) v (STrieL x) = STrieB x (gtrieSingleton k v) gtrieInsert (R1 k) v (STrieR y) = STrieR (gtrieInsert k v y) gtrieInsert (R1 k) v (STrieB x y) = STrieB x (gtrieInsert k v y) gtrieSingleton (L1 k) v = STrieL (gtrieSingleton k v) gtrieSingleton (R1 k) v = STrieR (gtrieSingleton k v) gtrieDelete (L1 k) (STrieL x) = fmap STrieL (gtrieDelete k x) gtrieDelete (L1 _) (STrieR y) = Just (STrieR y) gtrieDelete (L1 k) (STrieB x y) = case gtrieDelete k x of Nothing -> Just (STrieR y) Just x' -> Just (STrieB x' y) gtrieDelete (R1 _) (STrieL x) = Just (STrieL x) gtrieDelete (R1 k) (STrieR y) = fmap STrieR (gtrieDelete k y) gtrieDelete (R1 k) (STrieB x y) = case gtrieDelete k y of Nothing -> Just (STrieL x) Just y' -> Just (STrieB x y') gtrieMap f (STrieB x y) = STrieB (gtrieMap f x) (gtrieMap f y) gtrieMap f (STrieL x) = STrieL (gtrieMap f x) gtrieMap f (STrieR y) = STrieR (gtrieMap 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 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) $ showString "STrieB " . showsPrec 11 x . showString " " . showsPrec 11 y gtrieShowsPrec p (STrieL x) = showParen (p > 10) $ showString "STrieL " . showsPrec 11 x gtrieShowsPrec p (STrieR y) = showParen (p > 10) $ showString "STrieR " . showsPrec 11 y ------------------------------------------------------------------------------ -- Generic implementation for units ------------------------------------------------------------------------------ -- | Tries of constructors without fields are represented by a single value. instance GTrieKey U1 where gtrieLookup _ (UTrie x) = Just x gtrieInsert _ v _ = UTrie v gtrieDelete _ _ = Nothing gtrieSingleton _ = UTrie gtrieMap f (UTrie x) = UTrie (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 gtrieTraverse #-} {-# INLINE gtrieMap #-} {-# INLINE gfoldWithKey #-} {-# INLINE gtraverseWithKey #-} {-# INLINE gmergeWithKey #-} {-# INLINE gmapMaybeWithKey #-} instance GTrieKeyShow U1 where gtrieShowsPrec p (UTrie x) = showsPrec p x ------------------------------------------------------------------------------ -- Generic implementation for empty types ------------------------------------------------------------------------------ -- | Tries of types without constructors are represented by a unit. instance GTrieKey V1 where 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 _ 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 gtrieMap #-} {-# INLINE gtrieTraverse #-} {-# INLINE gfoldWithKey #-} {-# INLINE gtraverseWithKey #-} {-# INLINE gmergeWithKey #-} {-# INLINE gmapMaybeWithKey #-} instance GTrieKeyShow V1 where gtrieShowsPrec _ _ = showString "()" ------------------------------------------------------------------------------ -- Various instances for Trie ------------------------------------------------------------------------------ instance (Show a, TrieKey k) => Show (Trie k a) where showsPrec = trieShowsPrec instance (Show a, GTrieKeyShow f) => Show (GTrie f a) where showsPrec = gtrieShowsPrec instance TrieKey k => Functor (Trie k) where fmap = trieMap instance TrieKey k => Foldable (Trie k) where foldr f = trieFoldWithKey (\_ -> f) instance TrieKey k => Traversable (Trie k) where traverse = trieTraverse