trie-simple-0.4.1.1: Simple Map-based Trie

Safe HaskellSafe
LanguageHaskell2010

Data.Trie.Map

Contents

Synopsis

Type

data TMap c a Source #

Mapping from [c] to a implemented as a trie. This type serves almost same purpose with Map [c] a, but can be looked up more efficiently.

Instances
Functor (TMap c) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

fmap :: (a -> b) -> TMap c a -> TMap c b #

(<$) :: a -> TMap c b -> TMap c a #

Foldable (TMap c) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

fold :: Monoid m => TMap c m -> m #

foldMap :: Monoid m => (a -> m) -> TMap c a -> m #

foldr :: (a -> b -> b) -> b -> TMap c a -> b #

foldr' :: (a -> b -> b) -> b -> TMap c a -> b #

foldl :: (b -> a -> b) -> b -> TMap c a -> b #

foldl' :: (b -> a -> b) -> b -> TMap c a -> b #

foldr1 :: (a -> a -> a) -> TMap c a -> a #

foldl1 :: (a -> a -> a) -> TMap c a -> a #

toList :: TMap c a -> [a] #

null :: TMap c a -> Bool #

length :: TMap c a -> Int #

elem :: Eq a => a -> TMap c a -> Bool #

maximum :: Ord a => TMap c a -> a #

minimum :: Ord a => TMap c a -> a #

sum :: Num a => TMap c a -> a #

product :: Num a => TMap c a -> a #

Traversable (TMap c) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

traverse :: Applicative f => (a -> f b) -> TMap c a -> f (TMap c b) #

sequenceA :: Applicative f => TMap c (f a) -> f (TMap c a) #

mapM :: Monad m => (a -> m b) -> TMap c a -> m (TMap c b) #

sequence :: Monad m => TMap c (m a) -> m (TMap c a) #

(Eq a, Eq c) => Eq (TMap c a) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

(==) :: TMap c a -> TMap c a -> Bool #

(/=) :: TMap c a -> TMap c a -> Bool #

(Ord a, Ord c) => Ord (TMap c a) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

compare :: TMap c a -> TMap c a -> Ordering #

(<) :: TMap c a -> TMap c a -> Bool #

(<=) :: TMap c a -> TMap c a -> Bool #

(>) :: TMap c a -> TMap c a -> Bool #

(>=) :: TMap c a -> TMap c a -> Bool #

max :: TMap c a -> TMap c a -> TMap c a #

min :: TMap c a -> TMap c a -> TMap c a #

(Show c, Show a) => Show (TMap c a) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

showsPrec :: Int -> TMap c a -> ShowS #

show :: TMap c a -> String #

showList :: [TMap c a] -> ShowS #

(Ord c, Semigroup a) => Semigroup (TMap c a) Source #

unionWith-based

Instance details

Defined in Data.Trie.Map.Hidden

Methods

(<>) :: TMap c a -> TMap c a -> TMap c a #

sconcat :: NonEmpty (TMap c a) -> TMap c a #

stimes :: Integral b => b -> TMap c a -> TMap c a #

(Ord c, Semigroup a) => Monoid (TMap c a) Source #

unionWith-based

Instance details

Defined in Data.Trie.Map.Hidden

Methods

mempty :: TMap c a #

mappend :: TMap c a -> TMap c a -> TMap c a #

mconcat :: [TMap c a] -> TMap c a #

(NFData c, NFData a) => NFData (TMap c a) Source # 
Instance details

Defined in Data.Trie.Map.Hidden

Methods

rnf :: TMap c a -> () #

Queries

match :: Ord c => [c] -> TMap c a -> (Maybe a, TMap c a) Source #

Perform matching against a TMap.

match xs tmap returns two values. First value is the result of lookup. Second value is another TMap, which holds mapping between all pair of ys and b, such that tmap maps (xs ++ ys) to b.

lookup :: Ord c => [c] -> TMap c a -> Maybe a Source #

lookup xs tmap returns Just a if tmap contains mapping from xs to a, and returns Nothing if not.

member :: Ord c => [c] -> TMap c a -> Bool Source #

notMember :: Ord c => [c] -> TMap c a -> Bool Source #

null :: TMap c a -> Bool Source #

Tests if given map is empty.

count :: TMap c a -> Int Source #

Returns number of entries.

Note that this operation takes O(number of nodes), unlike O(1) of size.

keys :: TMap c a -> [[c]] Source #

Returns list of key strings, in ascending order.

elems :: TMap c a -> [a] Source #

Returns list of values, in ascending order by its key.

Construction

empty :: TMap c a Source #

Empty TMap.

just :: a -> TMap c a Source #

TMap which contains only one entry from the empty string to a.

singleton :: [c] -> a -> TMap c a Source #

singleton xs a is a TMap which contains only one entry from xs to a.

Single item modification

insertWith :: Ord c => (a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a Source #

insertWith op xs a tmap inserts an key (xs) and value (a) pair to the tmap. If tmap already has an entry with key equals to xs, its value b is replaced with op a b.

insertWith op cs a = revise (maybe a (op a)) cs

insert :: Ord c => [c] -> a -> TMap c a -> TMap c a Source #

Inserts an entry of key and value pair.

Already existing value will be overwritten, i.e. > insert = insertWith (const a)

deleteWith :: Ord c => (b -> a -> Maybe a) -> [c] -> b -> TMap c a -> TMap c a Source #

Deletes an entry with given key, conditionally.

deleteWith f xs b looks up an entry with key xs, and if such entry is found, evaluate f b a with its value a. If it returned Nothing, the entry is deleted. Otherwise, if it returned Just a', the value of the entry is replaced with a'.

deleteWith f cs b = update (f b) cs

delete :: Ord c => [c] -> TMap c a -> TMap c a Source #

Deletes an entry with given key.

delete = update (const Nothing)

adjust :: Ord c => (a -> a) -> [c] -> TMap c a -> TMap c a Source #

Apply a function to the entry with given key.

revise :: Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a Source #

Apply a function f to the entry with given key. If there is no such entry, insert an entry with value f Nothing.

update :: Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a Source #

Apply a function f to the entry with given key. If f returns Nothing, that entry is deleted.

alter :: Ord c => (Maybe a -> Maybe a) -> [c] -> TMap c a -> TMap c a Source #

Apply a function f to the entry with given key. This function alter is the most generic version of adjust, revise, update.

  • You can insert new entry by returning Just a from f Nothing.
  • You can delete existing entry by returning Nothing from f (Just a).

This function always evaluates f Nothing in addition to determine operation applied to given key. If you never use alter on a missing key, consider using update instead.

Combine

union :: Ord c => TMap c a -> TMap c a -> TMap c a Source #

unionWith :: Ord c => (a -> a -> a) -> TMap c a -> TMap c a -> TMap c a Source #

intersection :: Ord c => TMap c a -> TMap c b -> TMap c a Source #

intersectionWith :: Ord c => (a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r Source #

difference :: Ord c => TMap c a -> TMap c b -> TMap c a Source #

differenceWith :: Ord c => (a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a Source #

appendWith :: (Ord c, Semigroup z) => (x -> y -> z) -> TMap c x -> TMap c y -> TMap c z Source #

Make new TMap from two TMaps. Constructed TMap has keys which are concatenation of any combination from two input maps.

Corresponding values for these keys are combined with given function of type (x -> y -> z). If two different concatenations yield a same key, corresponding values for these keys are combined with a Semigroup operation <>.

There is no guarantees on which order duplicate values are combined with <>. So it must be commutative semigroup to get a stable result.

Example
let x = fromList [("a", 1), ("aa", 2)]     :: TMap Char (Sum Int)
    y = fromList [("aa", 10), ("aaa", 20)] :: TMap Char (Sum Int)

appendWith (*) x y =
  fromList [ ("aaa", 1 * 10)
           , ("aaaa", 1 * 20 + 2 * 10)
           , ("aaaaa", 2 * 20) ]

Conversion

toList :: TMap c a -> [([c], a)] Source #

fromList :: Ord c => [([c], a)] -> TMap c a Source #

toAscList :: TMap c a -> [([c], a)] Source #

fromAscList :: Eq c => [([c], a)] -> TMap c a Source #

toMap :: TMap c a -> Map [c] a Source #

fromMap :: Eq c => Map [c] a -> TMap c a Source #

keysTSet :: TMap c a -> TSet c Source #

fromTSet :: ([c] -> a) -> TSet c -> TMap c a Source #

Parsing

toParser Source #

Arguments

:: Alternative f 
=> (c -> f c')

char

-> f eot

eot

-> TMap c a 
-> f ([c'], a) 

toParser_ Source #

Arguments

:: Alternative f 
=> (c -> f c')

char

-> f eot

eot

-> TMap c a 
-> f a 

toParser__ Source #

Arguments

:: Alternative f 
=> (c -> f c')

char

-> f eot

eot

-> TMap c a 
-> f () 

Traversing with keys

traverseWithKey :: Applicative f => ([c] -> a -> f b) -> TMap c a -> f (TMap c b) Source #

Same semantics to following defintion, but have more efficient implementation.

traverseWithKey f = fmap fromAscList .
                    traverse (\(cs,a) -> (,) cs <$> f cs a) .
                    toAscList

mapWithKey :: ([c] -> a -> b) -> TMap c a -> TMap c b Source #

Same semantics to following defintion, but have more efficient implementation.

traverseWithKey f = fromAscList .
                    map (\(cs,a) -> (cs,  f cs a)) .
                    toAscList

foldMapWithKey :: Monoid r => ([c] -> a -> r) -> TMap c a -> r Source #

Same semantics to following defintion, but have more efficient implementation.

foldMapWithKey f = foldMap (uncurry f) . toAscList

foldrWithKey :: ([c] -> a -> r -> r) -> r -> TMap c a -> r Source #

Same semantics to following defintion, but have more efficient implementation.

foldrWithKey f z = foldr (uncurry f) z . toAscList