{-# LANGUAGE FlexibleContexts #-}

module CSV(
    Settings(..),

    specialChars,
    defaultSettings,
    unParseRecord,
    parseRecord
    ) where




--  This source is licensed under Creative Commons CC0 v1.0.

--  To read the full text, see license.txt in the main directory of this repository
--  or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt

--  For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/




import Text.ParserCombinators.Parsec ( (<|>), (<?>) )
import qualified Text.ParserCombinators.Parsec as Parsec
import qualified Data.Char as Char
import qualified Data.List as List




data Settings = Settings
    { separator :: Char
    , quote     :: Char
    , escape    :: Char }




defaultSettings = Settings
    { separator = ','
    , quote     = '\"'
    , escape    = '\\' }




specialChars :: Settings -> String
specialChars s = (separator s):(quote s):(escape s):[]




unParseRecord :: Settings -> [String] -> String
unParseRecord settings record =
    let escFunc c = if (c == escape settings || c == quote settings) then (escape settings):c:[] else c:[]
        escapeField s =
            if ((escape settings) `elem` s || (quote settings) `elem` s || (separator settings) `elem` s)
                then ((quote settings) : (concatMap escFunc s)) ++ ((quote settings):[])
                else s
    in List.intercalate [separator settings] (map escapeField record)




parseRecord :: Settings -> String -> Either Parsec.ParseError [String]
parseRecord settings input =
    Parsec.parse (record settings) "error" input


record s = do
    f <- (field s) `Parsec.sepBy` (Parsec.char (separator s))
    Parsec.optional eol
    Parsec.eof
    return f


field s =
    Parsec.many (Parsec.try (quoted s) <|> Parsec.many1 (fieldChar s)) >>=
    return . foldl1 (++)


quoted s =
    Parsec.between
        (Parsec.char (quote s))
        (Parsec.char (quote s))
        (Parsec.many (quotedChar s))


fieldChar s = allExcept s (specialChars s)


quotedChar s = allExcept s [quote s]


allExcept s c =
    Parsec.try (escapeChar s) <|>
    Parsec.satisfy (\x -> (not (Char.isControl x)) && (x `notElem` c))


escapeChar s = do
    Parsec.char (escape s)
    Parsec.oneOf (specialChars s)


eol  =  Parsec.try (Parsec.string "\r\n")
    <|> Parsec.try (Parsec.string "\r")
    <|> Parsec.try (Parsec.string "\n")
    <?> "end of line"