{-|

  This module exports the underlying Attoparsec row parser. This is helpful if
  you want to do some ad-hoc CSV string parsing.

-}

module Data.CSV.Conduit.Parser.Text
    ( parseCSV
    , parseRow
    , row
    , csv
    ) where

-------------------------------------------------------------------------------
import           Control.Applicative
import           Control.Monad          (mzero)
import           Data.Attoparsec.Text   as P hiding (take)
import qualified Data.Attoparsec.Text   as T
import           Data.Text              (Text)
import qualified Data.Text              as T
-------------------------------------------------------------------------------
import           Data.CSV.Conduit.Types
-------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Try to parse given string as CSV
parseCSV :: CSVSettings -> Text -> Either String [Row Text]
parseCSV :: CSVSettings -> Text -> Either String [Row Text]
parseCSV CSVSettings
s = Parser [Row Text] -> Text -> Either String [Row Text]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser [Row Text] -> Text -> Either String [Row Text])
-> Parser [Row Text] -> Text -> Either String [Row Text]
forall a b. (a -> b) -> a -> b
$ CSVSettings -> Parser [Row Text]
csv CSVSettings
s


------------------------------------------------------------------------------
-- | Try to parse given string as 'Row Text'
parseRow :: CSVSettings -> Text -> Either String (Maybe (Row Text))
parseRow :: CSVSettings -> Text -> Either String (Maybe (Row Text))
parseRow CSVSettings
s = Parser (Maybe (Row Text))
-> Text -> Either String (Maybe (Row Text))
forall a. Parser a -> Text -> Either String a
parseOnly (Parser (Maybe (Row Text))
 -> Text -> Either String (Maybe (Row Text)))
-> Parser (Maybe (Row Text))
-> Text
-> Either String (Maybe (Row Text))
forall a b. (a -> b) -> a -> b
$ CSVSettings -> Parser (Maybe (Row Text))
row CSVSettings
s


------------------------------------------------------------------------------
-- | Parse CSV
csv :: CSVSettings -> Parser [Row Text]
csv :: CSVSettings -> Parser [Row Text]
csv CSVSettings
s = do
  Maybe (Row Text)
r <- CSVSettings -> Parser (Maybe (Row Text))
row CSVSettings
s
  Bool
end <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd
  if Bool
end
    then case Maybe (Row Text)
r of
      Just Row Text
x -> [Row Text] -> Parser [Row Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Row Text
x]
      Maybe (Row Text)
Nothing -> [Row Text] -> Parser [Row Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      [Row Text]
rest <- CSVSettings -> Parser [Row Text]
csv CSVSettings
s
      [Row Text] -> Parser [Row Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Row Text] -> Parser [Row Text])
-> [Row Text] -> Parser [Row Text]
forall a b. (a -> b) -> a -> b
$ case Maybe (Row Text)
r of
        Just Row Text
x -> Row Text
x Row Text -> [Row Text] -> [Row Text]
forall a. a -> [a] -> [a]
: [Row Text]
rest
        Maybe (Row Text)
Nothing -> [Row Text]
rest


------------------------------------------------------------------------------
-- | Parse a CSV row
row :: CSVSettings -> Parser (Maybe (Row Text))
row :: CSVSettings -> Parser (Maybe (Row Text))
row CSVSettings
csvs = CSVSettings -> Parser (Maybe (Row Text))
csvrow CSVSettings
csvs Parser (Maybe (Row Text))
-> Parser (Maybe (Row Text)) -> Parser (Maybe (Row Text))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe (Row Text))
badrow


badrow :: Parser (Maybe (Row Text))
badrow :: Parser (Maybe (Row Text))
badrow = (Char -> Bool) -> Parser Text
P.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
T.isEndOfLine) Parser Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
         (Parser Text ()
T.endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
forall t. Chunk t => Parser t ()
T.endOfInput) Parser Text ()
-> Parser (Maybe (Row Text)) -> Parser (Maybe (Row Text))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (Row Text) -> Parser (Maybe (Row Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Row Text)
forall a. Maybe a
Nothing

csvrow :: CSVSettings -> Parser (Maybe (Row Text))
csvrow :: CSVSettings -> Parser (Maybe (Row Text))
csvrow CSVSettings
c =
  let rowbody :: Parser Text (Row Text)
rowbody = (Parser Text
quotedField' Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CSVSettings -> Parser Text
field CSVSettings
c) Parser Text -> Parser Text Char -> Parser Text (Row Text)
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Text Char
T.char (CSVSettings -> Char
csvSep CSVSettings
c)
      properrow :: Parser Text (Row Text)
properrow = Parser Text (Row Text)
rowbody Parser Text (Row Text) -> Parser Text () -> Parser Text (Row Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
T.endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput)
      quotedField' :: Parser Text
quotedField' = case CSVSettings -> Maybe Char
csvQuoteChar CSVSettings
c of
          Maybe Char
Nothing -> Parser Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          Just Char
q' -> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
try (Char -> Parser Text
quotedField Char
q')
  in do
    Row Text
res <- Parser Text (Row Text)
properrow
    Maybe (Row Text) -> Parser (Maybe (Row Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Row Text) -> Parser (Maybe (Row Text)))
-> Maybe (Row Text) -> Parser (Maybe (Row Text))
forall a b. (a -> b) -> a -> b
$ Row Text -> Maybe (Row Text)
forall a. a -> Maybe a
Just Row Text
res

field :: CSVSettings -> Parser Text
field :: CSVSettings -> Parser Text
field CSVSettings
s = (Char -> Bool) -> Parser Text
P.takeWhile (CSVSettings -> Char -> Bool
isFieldChar CSVSettings
s)

isFieldChar :: CSVSettings -> Char -> Bool
isFieldChar :: CSVSettings -> Char -> Bool
isFieldChar CSVSettings
s = String -> Char -> Bool
notInClass String
xs'
  where xs :: String
xs = CSVSettings -> Char
csvSep CSVSettings
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
"\n\r"
        xs' :: String
xs' = case CSVSettings -> Maybe Char
csvQuoteChar CSVSettings
s of
          Maybe Char
Nothing -> String
xs
          Just Char
x -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

quotedField :: Char -> Parser Text
quotedField :: Char -> Parser Text
quotedField Char
c = do
  let quoted :: Parser Text Char
quoted = Text -> Parser Text
string Text
dbl Parser Text -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      dbl :: Text
dbl = String -> Text
T.pack [Char
c,Char
c]
  Char
_ <- Char -> Parser Text Char
T.char Char
c
  String
f <- Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Text Char
T.notChar Char
c Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Char
quoted)
  Char
_ <- Char -> Parser Text Char
T.char Char
c
  Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f