-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Lex
-- Copyright   :  Ben Gamari 2015-2019
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains a simple lexer supporting quoted strings

module Distribution.Lex (
        tokenizeQuotedWords
 ) where

import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.DList

tokenizeQuotedWords :: String -> [String]
tokenizeQuotedWords :: String -> [String]
tokenizeQuotedWords = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DList Char -> String -> [String]
go Bool
False forall a. Monoid a => a
mempty
  where
    go :: Bool        -- ^ in quoted region
       -> DList Char  -- ^ accumulator
       -> String      -- ^ string to be parsed
       -> [String]    -- ^ parse result
    go :: Bool -> DList Char -> String -> [String]
go Bool
_ DList Char
accum []
      | [] <- String
accum' = []
      | Bool
otherwise    = [String
accum']
      where accum' :: String
accum' = forall a. DList a -> [a]
runDList DList Char
accum

    go Bool
False  DList Char
accum (Char
c:String
cs)
      | Char -> Bool
isSpace Char
c = forall a. DList a -> [a]
runDList DList Char
accum forall a. a -> [a] -> [a]
: Bool -> DList Char -> String -> [String]
go Bool
False forall a. Monoid a => a
mempty String
cs
      | Char
c forall a. Eq a => a -> a -> Bool
== Char
'"'  = Bool -> DList Char -> String -> [String]
go Bool
True DList Char
accum String
cs

    go Bool
True   DList Char
accum (Char
c:String
cs)
      | Char
c forall a. Eq a => a -> a -> Bool
== Char
'"'  = Bool -> DList Char -> String -> [String]
go Bool
False DList Char
accum String
cs

    go Bool
quoted DList Char
accum (Char
c:String
cs)
                  = Bool -> DList Char -> String -> [String]
go Bool
quoted (DList Char
accum forall a. Monoid a => a -> a -> a
`mappend` forall a. a -> DList a
singleton Char
c) String
cs