-- | CSV for the circuits ecosystem: RFC 4180 on "Circuit.Parser" combinators.
--
-- Where "Circuit.Parser.Json" skips whitespace, csv skips nothing — spaces
-- are data, line endings are structure. The dialect:
--
-- - line endings lenient: @\\r\\n@ | @\\n@ | @\\r@.
-- - quoting strict: @"@ opens a quoted field only at field start; inside a
--   quoted field @""@ is an escaped quote; after the closing quote only @,@,
--   EOL, or EOF may follow. A bare @"@ inside a plain field is rejected.
-- - a trailing comma is a field: @a,b,@ is three fields. An empty line is
--   one record of one empty field. The final record may omit its line
--   ending. Empty input is zero records.
-- - field-count consistency across records is not checked — consumer
--   policy, like duplicate keys in json.
module Circuit.Parser.Csv
  ( -- * The table
    Csv (..),

    -- * Parsing
    csv,
    record,
    field,

    -- * Boundary
    decodeCsv,
  )
where

import Circuit.Parser
import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.Functor (($>))
import Data.Functor.Identity (Identity)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8')
import Data.Vector (Vector)
import Data.Vector qualified as V

-- $setup
-- >>> import Data.ByteString.Char8 qualified as C

-- | A CSV table: rows of fields, source order. No header policy — headers
-- are a consumer convention, not a parsing fact.
newtype Csv = Csv (Vector (Vector Text))
  deriving (Csv -> Csv -> Bool
(Csv -> Csv -> Bool) -> (Csv -> Csv -> Bool) -> Eq Csv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Csv -> Csv -> Bool
== :: Csv -> Csv -> Bool
$c/= :: Csv -> Csv -> Bool
/= :: Csv -> Csv -> Bool
Eq, Int -> Csv -> ShowS
[Csv] -> ShowS
Csv -> String
(Int -> Csv -> ShowS)
-> (Csv -> String) -> ([Csv] -> ShowS) -> Show Csv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Csv -> ShowS
showsPrec :: Int -> Csv -> ShowS
$cshow :: Csv -> String
show :: Csv -> String
$cshowList :: [Csv] -> ShowS
showList :: [Csv] -> ShowS
Show)

-- | Parse a whole CSV table.
csv :: Parser Identity ByteString Char Csv
csv :: Parser Identity ByteString Char Csv
csv = (Parser Identity ByteString Char ()
forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput Parser Identity ByteString Char ()
-> Csv -> Parser Identity ByteString Char Csv
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Vector (Vector Text) -> Csv
Csv Vector (Vector Text)
forall a. Vector a
V.empty) Parser Identity ByteString Char Csv
-> Parser Identity ByteString Char Csv
-> Parser Identity ByteString Char Csv
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Csv
rows
  where
    rows :: Parser Identity ByteString Char Csv
rows = do
      r <- Parser Identity ByteString Char [Text]
record
      Csv . V.fromList . map V.fromList <$> loop [r]
    loop :: [[Text]] -> Parser Identity ByteString Char [[Text]]
loop [[Text]]
acc =
      ( do
          _ <- Parser Identity ByteString Char ()
eol
          atEnd <- (endOfInput $> True) <|> pure False
          if atEnd
            then pure (reverse acc)
            else do
              r <- record
              loop (r : acc)
      )
        Parser Identity ByteString Char [[Text]]
-> Parser Identity ByteString Char [[Text]]
-> Parser Identity ByteString Char [[Text]]
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [[Text]] -> Parser Identity ByteString Char [[Text]]
forall a. a -> Parser Identity ByteString Char a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Text]] -> [[Text]]
forall a. [a] -> [a]
reverse [[Text]]
acc)

-- | Parse one record: fields separated by commas. A trailing comma is a
-- trailing empty field.
record :: Parser Identity ByteString Char [Text]
record :: Parser Identity ByteString Char [Text]
record = do
  f <- Parser Identity ByteString Char Text
field
  loop [f]
  where
    loop :: [Text] -> Parser Identity ByteString Char [Text]
loop [Text]
acc =
      ( do
          _ <- Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
','
          f <- field
          loop (f : acc)
      )
        Parser Identity ByteString Char [Text]
-> Parser Identity ByteString Char [Text]
-> Parser Identity ByteString Char [Text]
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Parser Identity ByteString Char [Text]
forall a. a -> Parser Identity ByteString Char a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc)

-- | Parse one field, quoted or plain. 'try' is load-bearing: without it, a
-- failed quoted attempt (say, an unterminated quote) would hand the plain
-- alternative the stream at the point of failure — consumed quote and all —
-- and an unterminated quote would silently parse as an empty field.
field :: Parser Identity ByteString Char Text
field :: Parser Identity ByteString Char Text
field = Parser Identity ByteString Char Text
-> Parser Identity ByteString Char Text
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s a
try Parser Identity ByteString Char Text
quoted Parser Identity ByteString Char Text
-> Parser Identity ByteString Char Text
-> Parser Identity ByteString Char Text
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Text
plain
  where
    plain :: Parser Identity ByteString Char Text
plain = do
      raw <- Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a -> Parser m ByteString Char ByteString
bs ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
      either (const empty) pure (decodeUtf8' raw)
    quoted :: Parser Identity ByteString Char Text
quoted = do
      _ <- Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'"'
      raw <- bs (skipMany (void (string "\"\"") <|> void (satisfy (/= '"'))))
      _ <- char '"'
      either (const empty) pure (unquote raw)

-- | Decode a quoted field's raw slice: @""@ collapses to @"@, then UTF-8.
unquote :: ByteString -> Either String Text
unquote :: ByteString -> Either String Text
unquote ByteString
raw = case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
raw of
  Left UnicodeException
e -> String -> Either String Text
forall a b. a -> Either a b
Left (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)
  Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
"\"") (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn (String -> Text
T.pack String
"\"\"") Text
t))

-- | Line ending: CRLF, LF, or lone CR.
eol :: Parser Identity ByteString Char ()
eol :: Parser Identity ByteString Char ()
eol = Parser Identity ByteString Char String
-> Parser Identity ByteString Char ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Parser Identity ByteString Char String
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string String
"\r\n") Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'\n') Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'\r')

-- | Parse a CSV document, rejecting trailing garbage.
--
-- >>> decodeCsv (C.pack "a,b\r\nc,d\r\n")
-- Right (Csv [["a","b"],["c","d"]])
--
-- >>> decodeCsv (C.pack "name,note\n\"say \"\"hi\"\"\",ok")
-- Right (Csv [["name","note"],["say \"hi\"","ok"]])
--
-- >>> decodeCsv (C.pack "a,b,\n")
-- Right (Csv [["a","b",""]])
--
-- >>> decodeCsv (C.pack "")
-- Right (Csv [])
--
-- >>> decodeCsv (C.pack "a\"b,c")
-- Left "invalid CSV"
decodeCsv :: ByteString -> Either String Csv
decodeCsv :: ByteString -> Either String Csv
decodeCsv ByteString
s = case Parser Identity ByteString Char Csv
-> ByteString -> These Csv ByteString
forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
runParserIdentity (Parser Identity ByteString Char Csv
csv Parser Identity ByteString Char Csv
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Csv
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Identity ByteString Char ()
forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput) ByteString
s of
  This Csv
c -> Csv -> Either String Csv
forall a b. b -> Either a b
Right Csv
c
  These Csv
c ByteString
_ -> Csv -> Either String Csv
forall a b. b -> Either a b
Right Csv
c
  That ByteString
_ -> String -> Either String Csv
forall a b. a -> Either a b
Left String
"invalid CSV"