diff --git a/src/Data/Trie/Text.hs b/src/Data/Trie/Text.hs index 3183f18..08c0221 100644 --- a/src/Data/Trie/Text.hs +++ b/src/Data/Trie/Text.hs @@ -51,6 +51,9 @@ module Data.Trie.Text -- * Single-value modification , alterBy, insert, adjust, delete + , deleteSubmap + , deleteSubmap' + , deleteSubmap'' -- * Combining tries , mergeBy, unionL, unionR @@ -169,6 +172,12 @@ delete :: Text -> Trie a -> Trie a {-# INLINE delete #-} delete q = alterBy (\_ _ _ -> Nothing) q (impossible "delete") +deleteSubmap'' key trie = + foldr + (\k t -> delete k t) + trie + (map L.toStrict . keys $ submap key trie) + {--------------------------------------------------------------- -- Trie-combining functions ---------------------------------------------------------------} diff --git a/src/Data/Trie/Text/Internal.hs b/src/Data/Trie/Text/Internal.hs index 6af1845..283fb92 100644 --- a/src/Data/Trie/Text/Internal.hs +++ b/src/Data/Trie/Text/Internal.hs @@ -56,6 +56,10 @@ module Data.Trie.Text.Internal , contextualFilterMap , contextualMapBy + -- * Something else + , deleteSubmap + , deleteSubmap' + -- * Priority-queue functions , minAssoc, maxAssoc , updateMinViewBy, updateMaxViewBy @@ -1012,6 +1016,34 @@ mergeMaybe _ mv0@(Just _) Nothing = mv0 mergeMaybe f (Just v0) (Just v1) = f v0 v1 +-- | Delete the submap under the given key. +deleteSubmap :: Text -> Trie a -> Trie a +{-# INLINE deleteSubmap #-} +deleteSubmap _ Empty = Empty +deleteSubmap q t@(Branch p m l r) + | nomatch qh p m = t + | zero qh m = branch p m (deleteSubmap q l) r + | otherwise = branch p m l (deleteSubmap q r) + where + qh = errorLogHead "deleteSubmap" q +deleteSubmap q (Arc k mv t) = + let (_,_,q') = breakMaximalPrefix k q in + case T.null q' of + True -> -- Partially, or completely match the Prefix + Empty + False -> -- Have different Prefix yet, do nothing + arc k mv (deleteSubmap q' t) + +-- Inefficient implementation which is equivalent of `deleteSubmap` +deleteSubmap' :: Text -> Trie a -> Trie a +{-# INLINE deleteSubmap' #-} +deleteSubmap' key trie = + foldr + (\k t -> alterBy (\_ _ _ -> Nothing) k (error "delete") t) + trie + (map L.toStrict . toListBy const $ submap key trie) + + {----------------------------------------------------------- -- Priority-queue functions -----------------------------------------------------------} diff --git a/stack.yaml b/stack.yaml index d447438..f3a980d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,7 @@ flags: {} +resolver: lts-16.16 packages: - . extra-deps: -- bytestring-trie-0.2.5.0 -resolver: lts-13.15 +- bytestring-trie-0.2.5.0@sha256:9efa9c6f556314d28486be2470ff789419c5238ed2e354870623a3cbbd28fbe2,3349 +- microbench-0.1@sha256:f5c60aa2f40f9114aa0fb1fb2fe2f6cd8506d7ce3d1f0f46295d34651e523a2c,983 \ No newline at end of file diff --git a/text-trie.cabal b/text-trie.cabal index 65c1f92..23c5100 100644 --- a/text-trie.cabal +++ b/text-trie.cabal @@ -73,9 +73,9 @@ Library -- The lower bounds are more restrictive than necessary. -- But then, we don't maintain any CI tests for older -- versions, so these are the lowest bounds we've verified. - Build-Depends: base >= 4.5 && < 4.13 - , text >= 1.2.3 && < 1.2.4 - , binary >= 0.5.1 && < 0.8.7 + Build-Depends: base >= 4.5 + , text >= 1.2.3 + , binary >= 0.5.1 ------------------------------------------------------------ Test-Suite test-text-trie @@ -90,16 +90,16 @@ Test-Suite test-text-trie , FromListBench.Text.Encode , TrieFile.Text build-depends: text-trie - , base >= 4.5 && < 4.13 - , bytestring >= 0.9.2 && < 0.11 - , text >= 1.2.3 && < 1.2.4 - , binary >= 0.5.1 && < 0.8.7 + , base >= 4.5 + , bytestring >= 0.9.2 + , text >= 1.2.3 + , binary >= 0.5.1 , QuickCheck , HUnit , smallcheck , microbench - , bytestring-trie >= 0.2.5 && < 0.2.6 - , silently >= 1.2.5 && < 1.2.6 + , bytestring-trie >= 0.2.5 + , silently >= 1.2.5 ------------------------------------------------------------ ------------------------------------------------------- fin.