{-# 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
= 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 #-}
specials :: String
specials :: String
specials = String
",\r\n"
{-# INLINE specials #-}