radixtree-0.4.0.0: test/Spec.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
import           Data.Attoparsec.Text
import           Data.Coerce
import           Data.List              (sortOn)
import qualified Data.RadixTree         as R
import qualified Data.Text              as T
import           Test.SmallCheck
import           Test.SmallCheck.Series
import           Test.Tasty
import           Test.Tasty.SmallCheck

sortOnLengthDesc :: [T.Text] -> [T.Text]
sortOnLengthDesc = sortOn (negate . T.length)

naiiveSameAsRadix :: Monad m => Bool -> Property m
naiiveSameAsRadix doCompress =
  forAll $ \(alternativesS :: NonEmpty (NonEmpty Char)) ->
    let
      alternatives = sortOnLengthDesc (map T.pack (coerce alternativesS))
      rparse
        | 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)
      in parseOnly (choice (map string alternatives)) text ==
         parseOnly rparse text

main :: IO ()
main = defaultMain $ testGroup "radixtree"
  [ testProperty "naiive parsing has the same result as radix tree parsing" (naiiveSameAsRadix False)
  , testProperty "naiive parsing has the same result as radix tree parsing when compressed"
    (naiiveSameAsRadix True)
  ]