Improve Distribution.Lex.tokenizeQuotedWords

[Bodigrim]

The new version is more concise, 25% faster and allocates 50% less.

(The reason of my interest to this function is that I'm investigating whether any usages of DList throughout Cabal code are up to the purpose and not slowing things down)

Tested and benchmarked using the following program:

{- cabal:
build-depends: base, dlist, tasty, tasty-quickcheck, tasty-bench
-}

{-# LANGUAGE LambdaCase #-}

import Data.Char (isSpace)
import Data.DList (DList(..), toList, singleton)
import Data.List (replicate)
import Data.List.NonEmpty (NonEmpty(..))
import Test.Tasty.Bench (defaultMain, bench, nf)
import Test.Tasty.QuickCheck

tokenizeQuotedWords :: String -> [String]
tokenizeQuotedWords = filter (not . null) . go False mempty
  where
    go
      :: Bool
      -- \^ in quoted region
      -> DList Char
      -- \^ accumulator
      -> String
      -- \^ string to be parsed
      -> [String]
    -- \^ parse result
    go _ accum []
      | [] <- accum' = []
      | otherwise = [accum']
      where
        accum' = toList accum
    go False accum (c : cs)
      | isSpace c = toList accum : go False mempty cs
      | c == '"' = go True accum cs
    go True accum (c : cs)
      | c == '"' = go False accum cs
    go quoted accum (c : cs) =
      go quoted (accum <> singleton c) cs

tokenizeQuotedWords2 :: String -> [String]
tokenizeQuotedWords2 xs = repack $ foldr alg (const ([] :| [])) xs False
  where
    repack :: NonEmpty String -> [String]
    repack (zs :| acc) = if null zs then acc else zs : acc

    alg :: Char -> (Bool -> NonEmpty String) -> Bool -> NonEmpty String
    alg '"' rest mode = rest (not mode)
    alg c rest False
      | isSpace c = [] :| repack (rest False)
    alg c rest mode = case rest mode of
        w :| ws -> (c : w) :| ws

data Foo = Space | Quote | CharA | CharB
  deriving (Eq, Ord, Show, Bounded, Enum)

instance Arbitrary Foo where
  arbitrary = arbitraryBoundedEnum

fooToChar :: Foo -> Char
fooToChar = \case
  Space -> ' '
  Quote -> '"'
  CharA -> 'a'
  CharB -> 'b'

main :: IO ()
main = defaultMain
  [ testProperty "same results" $
      \xs -> let ys = map fooToChar xs in tokenizeQuotedWords ys === tokenizeQuotedWords2 ys
  , bench "old" $ nf tokenizeQuotedWords benchString
  , bench "new" $ nf tokenizeQuotedWords2 benchString
  ]

benchString :: String
benchString = concat $ replicate 10 "foo \"bar baz\" quux"

Template B: This PR does not modify behaviour or interface

Include the following checklist in your PR:

• Patches conform to the coding conventions.
• Is this a PR that fixes CI? If so, it will need to be backported to older cabal release branches (ask maintainers for directions).

[Bodigrim]

Thanks, @andreabedini.

One more review would be much appreciated :)

[philderbeast]

I ran your test script. Thanks for including that.

$ cabal run LexCmp.hs -- --quickcheck-tests 1000
All
  same results: OK
    +++ OK, passed 1000 tests.
  old:          OK
    1.07 μs ±  77 ns
  new:          OK
    824  ns ±  46 ns