{-# LANGUAGE AllowAmbiguousTypes #-}

-- | Stream, parse, and validate CSVs
--
-- A minor extension of [cassava](https://hackage.haskell.org/package/cassava).
-- Using `MonadValidate` and `Conduit`.
--
module Freckle.App.Csv
  ( csvWithValidationSink
  , csvWithParserAndValidationSink
   -- * Conduit Primitives
  , runCsvConduit
  , decodeCsv
  -- * Header Validation
  , ValidateHeader
  , validateHeader
  , hasHeader
  , defaultValidateOrderedHeader
  -- * Exceptions
  , CsvException(..)
  -- * Options
  , defaultOptions
  ) where

import Freckle.App.Prelude

import Conduit
import Control.Monad (foldM)
import Control.Monad.Validate
  (MonadValidate(..), Validate, ValidateT, refute, runValidate, runValidateT)
import Data.Aeson (KeyValue(..), ToJSON(..), object, pairs, (.=))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Conduit.Combinators as Conduit
import qualified Data.Conduit.Text as Conduit
import Data.Csv
  ( DefaultOrdered
  , FromNamedRecord(..)
  , Header
  , Name
  , NamedRecord
  , Parser
  , defaultDecodeOptions
  , defaultOptions
  , headerOrder
  )
import qualified Data.Csv.Incremental as CsvI
import Data.Functor.Bind (Bind)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NE
import Data.Proxy (Proxy(Proxy))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Sequence.NonEmpty (NESeq)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import UnliftIO.Exception (handle)

-- | Treat CSV header line as 1
--
-- CSVs can break rows over lines, but we don't currently handle that.
--
headerLineNumber :: Int
headerLineNumber :: Int
headerLineNumber = Int
1

class ValidateHeader a where
  validateHeader :: (Bind m, Monad m) => proxy a -> Header -> ValidateT (NESeq String) m ()

hasHeader :: Monad m => Header -> Name -> ValidateT (NESeq String) m ()
hasHeader :: forall (m :: * -> *).
Monad m =>
Header -> ByteString -> ValidateT (NESeq String) m ()
hasHeader Header
h ByteString
name
  | ByteString
name forall a. Eq a => a -> Vector a -> Bool
`V.elem` Header
h = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS8.unpack ByteString
name

defaultValidateOrderedHeader
  :: forall a proxy m
   . (DefaultOrdered a, Monad m)
  => proxy a
  -> Header
  -> ValidateT (NESeq String) m ()
defaultValidateOrderedHeader :: forall a (proxy :: * -> *) (m :: * -> *).
(DefaultOrdered a, Monad m) =>
proxy a -> Header -> ValidateT (NESeq String) m ()
defaultValidateOrderedHeader proxy a
_ Header
h =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Header
h forall (m :: * -> *).
Monad m =>
Header -> ByteString -> ValidateT (NESeq String) m ()
`hasHeader`) forall a b. (a -> b) -> a -> b
$ forall a. DefaultOrdered a => a -> Header
headerOrder (forall a. HasCallStack => String -> a
error String
"old school haskell" :: a)

-- | Stream parse a CSV
--
-- - Expects UTF-8
-- - Provides incremental validation
--
csvWithValidationSink
  :: forall a b err m
   . ( MonadThrow m
     , MonadUnliftIO m
     , PrimMonad m
     , ValidateHeader a
     , FromNamedRecord a
     )
  => ConduitT () ByteString (ResourceT m) ()
  -- ^ CSV as a byte stream
  -> (Vector a -> Validate (NonEmpty (CsvException err)) (Vector b))
  -- ^ Validation to apply to resulting rows
  -> m (Validate (NonEmpty (CsvException err)) (Vector b))
csvWithValidationSink :: forall a b err (m :: * -> *).
(MonadThrow m, MonadUnliftIO m, PrimMonad m, ValidateHeader a,
 FromNamedRecord a) =>
ConduitT () ByteString (ResourceT m) ()
-> (Vector a -> Validate (NonEmpty (CsvException err)) (Vector b))
-> m (Validate (NonEmpty (CsvException err)) (Vector b))
csvWithValidationSink =
  forall a b err (m :: * -> *).
(MonadThrow m, MonadUnliftIO m, PrimMonad m) =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a)
-> ConduitT () ByteString (ResourceT m) ()
-> (Vector a -> Validate (NonEmpty (CsvException err)) (Vector b))
-> m (Validate (NonEmpty (CsvException err)) (Vector b))
csvWithParserAndValidationSink (forall a (m :: * -> *) (proxy :: * -> *).
(ValidateHeader a, Bind m, Monad m) =>
proxy a -> Header -> ValidateT (NESeq String) m ()
validateHeader (forall {k} (t :: k). Proxy t
Proxy @a)) forall a. FromNamedRecord a => NamedRecord -> Parser a
parseNamedRecord

-- | Stream parse a CSV with a custom parser
--
-- - Expects UTF-8
-- - Provides incremental validation
--
csvWithParserAndValidationSink
  :: forall a b err m
   . (MonadThrow m, MonadUnliftIO m, PrimMonad m)
  => (Header -> Validate (NESeq String) ())
  -> (NamedRecord -> Parser a)
  -- ^ Custom record parser
  -> ConduitT () ByteString (ResourceT m) ()
  -- ^ CSV as a byte stream
  -> (Vector a -> Validate (NonEmpty (CsvException err)) (Vector b))
  -- ^ Validation to apply to resulting rows
  -> m (Validate (NonEmpty (CsvException err)) (Vector b))
csvWithParserAndValidationSink :: forall a b err (m :: * -> *).
(MonadThrow m, MonadUnliftIO m, PrimMonad m) =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a)
-> ConduitT () ByteString (ResourceT m) ()
-> (Vector a -> Validate (NonEmpty (CsvException err)) (Vector b))
-> m (Validate (NonEmpty (CsvException err)) (Vector b))
csvWithParserAndValidationSink Header -> Validate (NESeq String) ()
headerValidator NamedRecord -> Parser a
p ConduitT () ByteString (ResourceT m) ()
source Vector a -> Validate (NonEmpty (CsvException err)) (Vector b)
validation = do
  Either (Seq (CsvException err)) (Vector a)
validatedCsv <-
    forall r (m :: * -> *) err.
MonadUnliftIO m =>
ConduitT
  () Void (ValidateT (Seq (CsvException err)) (ResourceT m)) r
-> m (Either (Seq (CsvException err)) r)
runCsvConduit
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
transPipe forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ConduitT () ByteString (ResourceT m) ()
source
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall a (m :: * -> *) err.
(MonadThrow m, MonadValidate (Seq (CsvException err)) m) =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a) -> ConduitT ByteString a m ()
decodeCsvWithP Header -> Validate (NESeq String) ()
headerValidator NamedRecord -> Parser a
p
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
transPipe forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (v :: * -> *) a (m :: * -> *) o.
(Vector v a, PrimMonad m) =>
ConduitT a o m (v a)
sinkVector

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either (Seq (CsvException err)) (Vector a)
validatedCsv of
    Left Seq (CsvException err)
errs -> forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (CsvException err)
errs
    Right Vector a
rows -> Vector a -> Validate (NonEmpty (CsvException err)) (Vector b)
validation Vector a
rows

-- | Run a CSV conduit handling invalid UTF8
runCsvConduit
  :: forall r m err
   . MonadUnliftIO m
  => ConduitT () Void (ValidateT (Seq (CsvException err)) (ResourceT m)) r
  -> m (Either (Seq (CsvException err)) r)
runCsvConduit :: forall r (m :: * -> *) err.
MonadUnliftIO m =>
ConduitT
  () Void (ValidateT (Seq (CsvException err)) (ResourceT m)) r
-> m (Either (Seq (CsvException err)) r)
runCsvConduit = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle TextException -> m (Either (Seq (CsvException err)) r)
nonUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
 where
  nonUtf8 :: Conduit.TextException -> m (Either (Seq (CsvException err)) r)
  nonUtf8 :: TextException -> m (Either (Seq (CsvException err)) r)
nonUtf8 = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. CsvException a
CsvUnknownFileEncoding

-- | Stream in 'ByteString's and parse records in constant space
decodeCsv
  :: forall a m err
   . ( MonadThrow m
     , MonadValidate (Seq (CsvException err)) m
     , ValidateHeader a
     , FromNamedRecord a
     )
  => ConduitT ByteString a m ()
decodeCsv :: forall a (m :: * -> *) err.
(MonadThrow m, MonadValidate (Seq (CsvException err)) m,
 ValidateHeader a, FromNamedRecord a) =>
ConduitT ByteString a m ()
decodeCsv = forall a (m :: * -> *) err.
(MonadThrow m, MonadValidate (Seq (CsvException err)) m) =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a) -> ConduitT ByteString a m ()
decodeCsvWithP (forall a (m :: * -> *) (proxy :: * -> *).
(ValidateHeader a, Bind m, Monad m) =>
proxy a -> Header -> ValidateT (NESeq String) m ()
validateHeader (forall {k} (t :: k). Proxy t
Proxy @a)) forall a. FromNamedRecord a => NamedRecord -> Parser a
parseNamedRecord

-- | Stream in 'ByteString's and parse records in constant space with a custom
-- record parser
--
decodeCsvWithP
  :: forall a m err
   . (MonadThrow m, MonadValidate (Seq (CsvException err)) m)
  => (Header -> Validate (NESeq String) ())
  -> (NamedRecord -> Parser a)
  -- ^ Custom record parser
  -> ConduitT ByteString a m ()
decodeCsvWithP :: forall a (m :: * -> *) err.
(MonadThrow m, MonadValidate (Seq (CsvException err)) m) =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a) -> ConduitT ByteString a m ()
decodeCsvWithP Header -> Validate (NESeq String) ()
headerValidator NamedRecord -> Parser a
p =
  forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
Conduit.detectUtf -- Strip any BOMs and decode UTF-*
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) text binary.
(Monad m, Utf8 text binary) =>
ConduitT text binary m ()
Conduit.encodeUtf8 -- Cassava needs ByteString
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall a (m :: * -> *) err.
MonadValidate (Seq (CsvException err)) m =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a) -> ConduitT ByteString a m ()
parseCsv Header -> Validate (NESeq String) ()
headerValidator NamedRecord -> Parser a
p

parseCsv
  :: forall a m err
   . (MonadValidate (Seq (CsvException err)) m)
  => (Header -> Validate (NESeq String) ())
  -> (NamedRecord -> Parser a)
  -> ConduitT ByteString a m ()
parseCsv :: forall a (m :: * -> *) err.
MonadValidate (Seq (CsvException err)) m =>
(Header -> Validate (NESeq String) ())
-> (NamedRecord -> Parser a) -> ConduitT ByteString a m ()
parseCsv Header -> Validate (NESeq String) ()
headerValidator NamedRecord -> Parser a
p = forall a (m :: * -> *) err.
MonadValidate (Seq (CsvException err)) m =>
(Header -> Validate (NESeq String) ())
-> HeaderParser (Parser a) -> ConduitT ByteString a m ()
parseHeader
  Header -> Validate (NESeq String) ()
headerValidator
  (forall a.
(NamedRecord -> Parser a)
-> DecodeOptions -> HeaderParser (Parser a)
CsvI.decodeByNameWithP (forall a. (NamedRecord -> Parser a) -> NamedRecord -> Parser a
stripParser NamedRecord -> Parser a
p) DecodeOptions
defaultDecodeOptions)

data CsvException a
  = CsvMissingColumn !Text
  | CsvParseException !Int !Text
  | CsvFileNotFound
  | CsvUnknownFileEncoding
  | CsvExceptionExtension a
  -- ^ A constructor for providing extensible csv exceptions
  deriving stock (CsvException a -> CsvException a -> Bool
forall a. Eq a => CsvException a -> CsvException a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CsvException a -> CsvException a -> Bool
$c/= :: forall a. Eq a => CsvException a -> CsvException a -> Bool
== :: CsvException a -> CsvException a -> Bool
$c== :: forall a. Eq a => CsvException a -> CsvException a -> Bool
Eq, Int -> CsvException a -> ShowS
forall a. Show a => Int -> CsvException a -> ShowS
forall a. Show a => [CsvException a] -> ShowS
forall a. Show a => CsvException a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CsvException a] -> ShowS
$cshowList :: forall a. Show a => [CsvException a] -> ShowS
show :: CsvException a -> String
$cshow :: forall a. Show a => CsvException a -> String
showsPrec :: Int -> CsvException a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CsvException a -> ShowS
Show)

instance ToJSON a => ToJSON (CsvException a) where
  toJSON :: CsvException a -> Value
toJSON = forall kv r a.
KeyValue kv =>
([kv] -> r) -> (a -> r) -> CsvException a -> r
csvExceptionPairs [Pair] -> Value
object forall a. ToJSON a => a -> Value
toJSON
  toEncoding :: CsvException a -> Encoding
toEncoding = forall kv r a.
KeyValue kv =>
([kv] -> r) -> (a -> r) -> CsvException a -> r
csvExceptionPairs (Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall a. ToJSON a => a -> Encoding
toEncoding

csvExceptionPairs
  :: KeyValue kv => ([kv] -> r) -> (a -> r) -> CsvException a -> r
csvExceptionPairs :: forall kv r a.
KeyValue kv =>
([kv] -> r) -> (a -> r) -> CsvException a -> r
csvExceptionPairs [kv] -> r
done a -> r
extend = \case
  CsvMissingColumn Text
column -> [kv] -> r
done
    [ Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Missing column " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Text
column)
    , Key
"missingColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
column
    ]
  CsvParseException Int
rowNumber Text
message ->
    [kv] -> r
done [Key
"rowNumber" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
rowNumber, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
message]
  CsvException a
CsvFileNotFound -> [kv] -> r
done [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"file not found" :: Text)]
  CsvException a
CsvUnknownFileEncoding ->
    [kv] -> r
done [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"file could not be decoded" :: Text)]
  CsvExceptionExtension a
a -> a -> r
extend a
a

parseHeader
  :: forall a m err
   . (MonadValidate (Seq (CsvException err)) m)
  => (Header -> Validate (NESeq String) ())
  -> CsvI.HeaderParser (CsvI.Parser a)
  -> ConduitT ByteString a m ()
parseHeader :: forall a (m :: * -> *) err.
MonadValidate (Seq (CsvException err)) m =>
(Header -> Validate (NESeq String) ())
-> HeaderParser (Parser a) -> ConduitT ByteString a m ()
parseHeader Header -> Validate (NESeq String) ()
headerValidator = \case
  CsvI.FailH ByteString
_ String
err ->
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> Text -> CsvException a
CsvParseException Int
headerLineNumber forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
err
  CsvI.PartialH ByteString -> HeaderParser (Parser a)
k ->
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a (m :: * -> *) err.
MonadValidate (Seq (CsvException err)) m =>
(Header -> Validate (NESeq String) ())
-> HeaderParser (Parser a) -> ConduitT ByteString a m ()
parseHeader Header -> Validate (NESeq String) ()
headerValidator forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HeaderParser (Parser a)
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty
  CsvI.DoneH Header
header Parser a
parser ->
    case forall e a. Validate e a -> Either e a
runValidate forall a b. (a -> b) -> a -> b
$ Header -> Validate (NESeq String) ()
headerValidator forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
stripUtf8 Header
header of
      Right{} -> forall err (m :: * -> *) a.
MonadValidate (Seq (CsvException err)) m =>
Int -> Parser a -> ConduitT ByteString a m ()
parseRow (forall a. Enum a => a -> a
succ Int
headerLineNumber) Parser a
parser
      Left NESeq String
errs ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a. Text -> CsvException a
CsvMissingColumn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESeq String
errs

parseRow
  :: MonadValidate (Seq (CsvException err)) m
  => Int
  -> CsvI.Parser a
  -> ConduitT ByteString a m ()
parseRow :: forall err (m :: * -> *) a.
MonadValidate (Seq (CsvException err)) m =>
Int -> Parser a -> ConduitT ByteString a m ()
parseRow Int
rowNumber Parser a
parse = case Parser a
parse of
  CsvI.Fail ByteString
_ String
err ->
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> Text -> CsvException a
CsvParseException Int
rowNumber forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
err
  CsvI.Many [Either String a]
rows ByteString -> Parser a
k -> do
    !Int
newRowNumber <- [Either String a] -> ConduitT ByteString a m Int
handleRows [Either String a]
rows
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall err (m :: * -> *) a.
MonadValidate (Seq (CsvException err)) m =>
Int -> Parser a -> ConduitT ByteString a m ()
parseRow Int
newRowNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser a
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty
  CsvI.Done [Either String a]
rows -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Either String a] -> ConduitT ByteString a m Int
handleRows [Either String a]
rows
  where handleRows :: [Either String a] -> ConduitT ByteString a m Int
handleRows = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall err (m :: * -> *) a i.
MonadValidate (Seq (CsvException err)) m =>
Int -> Either String a -> ConduitT i a m Int
handleRow Int
rowNumber

handleRow
  :: MonadValidate (Seq (CsvException err)) m
  => Int
  -> Either String a
  -> ConduitT i a m Int
handleRow :: forall err (m :: * -> *) a i.
MonadValidate (Seq (CsvException err)) m =>
Int -> Either String a -> ConduitT i a m Int
handleRow Int
rowNumber Either String a
result = do
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Text -> CsvException a
CsvParseException Int
rowNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack)
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield
    Either String a
result
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
rowNumber forall a. Num a => a -> a -> a
+ Int
1

-- | Strip leading/trailing whitespace from each key-value pairs
stripNamedRecord :: NamedRecord -> NamedRecord
stripNamedRecord :: NamedRecord -> NamedRecord
stripNamedRecord =
  forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> ByteString
stripUtf8 ByteString -> ByteString
stripUtf8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList

-- | Strip leading/trailing whitespace from @'ByteString'@ via UTF-8
stripUtf8 :: ByteString -> ByteString
stripUtf8 :: ByteString -> ByteString
stripUtf8 = Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8

-- | Take a custom parser and return one that strips prior to parsing
stripParser :: (NamedRecord -> Parser a) -> (NamedRecord -> Parser a)
stripParser :: forall a. (NamedRecord -> Parser a) -> NamedRecord -> Parser a
stripParser NamedRecord -> Parser a
p = NamedRecord -> Parser a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedRecord -> NamedRecord
stripNamedRecord