-- | CSV parser as specified in RFC4180
--

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Foundation.Format.CSV.Parser
    ( file
    , recordC
    , record
    , record_
    , field
    ) where

import Basement.Imports hiding (throw)
import Foundation.Format.CSV.Types
import Basement.String (snoc)
import Foundation.Parser
import Foundation.Monad
import Foundation.Collection (Collection (elem))
import Foundation.Conduit
import Control.Monad (void)
import Data.Typeable (typeRep)
import Data.Proxy (Proxy(..))

recordC :: (Monad m, MonadThrow m) => Conduit String Row m ()
recordC :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Conduit String Row m ()
recordC = forall input output (monad :: * -> *) b.
(input -> Conduit input output monad b)
-> Conduit input output monad ()
awaitForever forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {input} {o}.
(MonadThrow m, Typeable input, Show input) =>
Result input o -> Conduit (Chunk input) o m ()
recordC' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall input a.
ParserSource input =>
Parser input a -> input -> Result input a
parse (Parser String Row
record forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall input.
(ParserSource input, Sequential (Chunk input),
 Element (Chunk input) ~ Element input, Eq (Chunk input)) =>
Chunk input -> Parser input ()
elements String
crlf))
  where
    recordC' :: Result input o -> Conduit (Chunk input) o m ()
recordC' (ParseFailed ParseError input
err) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw ParseError input
err
    recordC' (ParseOk Chunk input
rest o
v)  = forall i o (m :: * -> *). i -> Conduit i o m ()
leftover Chunk input
rest forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield o
v
    recordC' (ParseMore Chunk input -> Result input o
more)  = do
        Maybe (Chunk input)
mm <- forall i o (m :: * -> *). Conduit i o m (Maybe i)
await
        case Maybe (Chunk input)
mm of
            Maybe (Chunk input)
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (forall input. ParseError input
NotEnoughParseOnly :: ParseError String)
            Just Chunk input
b  -> Result input o -> Conduit (Chunk input) o m ()
recordC' (Chunk input -> Result input o
more Chunk input
b)

record_ :: forall row . (Typeable row, Record row) => Parser String row
record_ :: forall row. (Typeable row, Record row) => Parser String row
record_ = do
    Row
rs <- Parser String Row
record
    case forall a. Record a => Row -> Either String a
fromRow Row
rs of
        Left String
err -> forall input a. ParseError input -> Parser input a
reportError forall a b. (a -> b) -> a -> b
$ forall input. Chunk input -> Chunk input -> ParseError input
Expected (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @row)) String
err
        Right row
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure row
v

file :: Parser String CSV
file :: Parser String CSV
file = do
    Maybe Row
mh <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Parser String Row
header forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Sequential (Chunk input),
 Element (Chunk input) ~ Element input, Eq (Chunk input)) =>
Chunk input -> Parser input ()
elements String
crlf
    Row
x <- Parser String Row
record
    [Row]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Sequential (Chunk input),
 Element (Chunk input) ~ Element input, Eq (Chunk input)) =>
Chunk input -> Parser input ()
elements String
crlf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String Row
record
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Sequential (Chunk input),
 Element (Chunk input) ~ Element input, Eq (Chunk input)) =>
Chunk input -> Parser input ()
elements String
crlf
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ case Maybe Row
mh of
        Maybe Row
Nothing -> Row
x forall a. a -> [a] -> [a]
: [Row]
xs
        Just Row
h  -> Row
h forall a. a -> [a] -> [a]
: Row
x forall a. a -> [a] -> [a]
: [Row]
xs

header :: Parser String Row
header :: Parser String Row
header = do
    Field
x <- Parser String Field
name
    [Field]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String Field
name
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ Field
x forall a. a -> [a] -> [a]
: [Field]
xs

record :: Parser String Row
record :: Parser String Row
record = do
    Field
x <- Parser String Field
field
    [Field]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String Field
field
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ Field
x forall a. a -> [a] -> [a]
: [Field]
xs

name :: Parser String Field
name :: Parser String Field
name = Parser String Field
field
{-# INLINE name #-}

field :: Parser String Field
field :: Parser String Field
field = Parser String Field
escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser String Field
nonEscaped

escaped :: Parser String Field
escaped :: Parser String Field
escaped = forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
dquote forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String Field
escaped'
  where
    escaped' :: Parser String Field
escaped' = do
        String
x <- forall input.
(ParserSource input, Sequential (Chunk input)) =>
(Element input -> Bool) -> Parser input (Chunk input)
takeWhile (Char
dquote forall a. Eq a => a -> a -> Bool
/=)
        forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
dquote
        Maybe Char
p <- forall input.
ParserSource input =>
Parser input (Maybe (Element input))
peek
        if Maybe Char
p forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just Char
dquote)
            then forall input.
ParserSource input =>
CountOf (Element input) -> Parser input ()
skip CountOf (Element String)
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {input}.
(Chunk input ~ String, Element input ~ Char,
 Element input ~ Element (Chunk input), ParserSource input,
 Eq (Element input), Sequential (Chunk input)) =>
String -> Parser input Field
descaped' (String -> Char -> String
snoc String
x Char
dquote)
            else forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Escaping -> Field
FieldString String
x Escaping
Escape)
    descaped' :: String -> Parser input Field
descaped' String
acc = do
        String
x <- forall input.
(ParserSource input, Sequential (Chunk input)) =>
(Element input -> Bool) -> Parser input (Chunk input)
takeWhile (Char
dquote forall a. Eq a => a -> a -> Bool
/=)
        forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
dquote
        Maybe Char
p <- forall input.
ParserSource input =>
Parser input (Maybe (Element input))
peek
        if Maybe Char
p forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just Char
dquote)
            then forall input.
ParserSource input =>
CountOf (Element input) -> Parser input ()
skip CountOf (Element input)
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser input Field
descaped' (String
acc forall a. Semigroup a => a -> a -> a
<> String -> Char -> String
snoc String
x Char
dquote)
            else forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Escaping -> Field
FieldString (String
acc forall a. Semigroup a => a -> a -> a
<> String
x) Escaping
DoubleEscape)

nonEscaped :: Parser String Field
nonEscaped :: Parser String Field
nonEscaped = forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Escaping -> Field
FieldString Escaping
NoEscape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall input.
(ParserSource input, Sequential (Chunk input)) =>
(Element input -> Bool) -> Parser input (Chunk input)
takeWhile (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
elem String
specials)
{-# INLINE nonEscaped #-}

comma :: Char
comma :: Char
comma = Char
','
{-# INLINE comma #-}

cr :: Char
cr :: Char
cr = Char
'\r'
{-# INLINE cr #-}

dquote :: Char
dquote :: Char
dquote = Char
'"'
{-# INLINE dquote #-}

lf :: Char
lf :: Char
lf = Char
'\n'
{-# INLINE lf #-}

crlf :: String
crlf :: String
crlf = forall l. IsList l => [Item l] -> l
fromList [Char
cr, Char
lf]
{-# NOINLINE crlf #-}

{-
textdataQuoted :: String
textdataQuoted = textdata <> specials
{-# NOINLINE textdataQuoted #-}
-}

specials :: String
specials :: String
specials = String
",\r\n"
{-# INLINE specials #-}

{-
textdata :: String
textdata = fromList $ [' '..'!'] <> ['#'..'+'] <> ['-'..'~']
{-# NOINLINE textdata #-}
-}