Commit 54307df7 authored by Mike Ledger's avatar Mike Ledger

Merge branch 'master' of gitlab.com:transportengineering/radixtree

parents 83aac756 2a778d79
Pipeline #43678177 failed with stage
in 40 seconds
use_nix -A env
import ../nix/haskellPackage.nix {
name = "radixtree";
path = ./.;
}
/nix/store/ffg7rspgw6yzd1nv7g87fk6b633al01l-radixtree-0.5.0.0
\ No newline at end of file
......@@ -14,11 +14,14 @@ module Data.RadixTree
, RadixNode (..)
, CompressedRadixTree
-- * Construction
, fromFoldable_
, fromFoldable
, fromFoldable0
, compressBy
-- * Parsing with radix trees
, RadixParsing (..)
, parse_
, lookup_
, search
) where
import Control.Applicative
......@@ -27,7 +30,6 @@ import Data.Data (Data, Typeable)
import Data.Foldable (asum, foldr', toList)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Monoid
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Store ()
......@@ -113,7 +115,7 @@ compress = go . makeCompressable
data RadixNode a = RadixNode {-# UNPACK #-} !Text !(RadixTree a)
deriving (Eq, Show, Typeable, Data)
-- | A radixtree. Construct with 'fromFoldable', and use with 'parse'.
-- | A radixtree. Construct with 'fromFoldable_, and use with 'parse'.
data RadixTree a
= -- | Can terminate a parser successfully, returning the 'Text' value given.
RadixAccept
......@@ -219,6 +221,12 @@ compressBy full@(TI.Text arr _ _) rt =
recompressT (RadixSkip v) = CompressedRadixSkip <$> V.mapM recompressN v
recompressT (RadixAccept t v a) = CompressedRadixAccept <$> magic t <*> V.mapM recompressN v <*> pure a
-- | *Slow*. Same as 'fromFoldable', but you do not need to supply pairs of text
-- and values; they will default to '()'.
fromFoldable_ :: Foldable f => f Text -> RadixTree ()
fromFoldable_ =
fromTrie . foldr' (\t -> insert t t ()) (Trie (Skip M.empty))
-- | *Slow*
fromFoldable :: Foldable f => f (Text, a) -> RadixTree a
fromFoldable =
......@@ -254,6 +262,14 @@ search r = go
(anyChar >> go) <|>
return []
{-# INLINE parse_ #-}
parse_ :: (RadixParsing r, CharParsing m) => r a -> m Text
parse_ = Data.RadixTree.parse const
{-# INLINE lookup_ #-}
lookup_ :: RadixParsing r => r a -> Text -> Maybe Text
lookup_ r t = fst <$> Data.RadixTree.lookup r t
instance RadixParsing RadixTree where
{-# INLINE parse #-}
-- | Parse from a 'RadixTree'
......
resolver: lts-11.0
packages: ['.']
......@@ -25,9 +25,9 @@ naiiveSameAsRadix doCompress =
forAll $ \(mkAlternatives -> alternatives) ->
let
rparse
| doCompress = R.parse const $! R.fromFoldable0 alternatives
| otherwise = case R.compressBy (T.concat alternatives) (R.fromFoldable0 alternatives) of
Just crt -> R.parse const $! crt
| doCompress = R.parse_ $! R.fromFoldable_ alternatives
| otherwise = case R.compressBy (T.concat alternatives) (R.fromFoldable_ alternatives) of
Just crt -> R.parse_ $! crt
Nothing -> error "could not compress radixtree!"
in forAll $ \(textS :: NonEmpty Char) ->
let text = T.pack (coerce textS)
......@@ -38,12 +38,12 @@ lookupSameishAsParse :: Property IO
lookupSameishAsParse =
forAll $ \alternatives ->
let
!rt = R.fromFoldable0 (mkAlternatives alternatives)
!p = R.parse const rt <* endOfInput
!rt = R.fromFoldable_ (mkAlternatives alternatives)
!p = R.parse_ rt <* endOfInput
in forAll $ \(textS :: NonEmpty Char) ->
let text = T.pack (coerce textS)
in case (parseOnly p text, R.lookup rt text) of
(Right x1, Just x2) -> x1 == fst x2
in case (parseOnly p text, R.lookup_ rt text) of
(Right x1, Just x2) -> x1 == x2
(Left _ , Nothing) -> True
_ -> False
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment