{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.CSV.Conduit
    (

    -- * Main Interface
      decodeCSV
    , readCSVFile
    , writeCSVFile
    , transformCSV
    , transformCSV'
    , mapCSVFile
    , writeHeaders
    , writeHeadersOrdered

    -- Types
    , CSV (..)
    , CSVSettings (..)
    , defCSVSettings
    , MapRow
    , OrderedMapRow
    , Row

    -- * Re-exported For Convenience
    , runResourceT
    ) where

-------------------------------------------------------------------------------
import           Control.Exception
import           Control.Monad.Catch.Pure           (CatchT)
import           Control.Monad.Catch.Pure           (runCatchT)
import           Control.Monad.Except
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.Trans.Resource       (MonadResource, MonadThrow,
                                                     runResourceT)
import           Data.Attoparsec.Types              (Parser)
import qualified Data.ByteString                    as B
import           Data.ByteString.Char8              (ByteString)
import qualified Data.ByteString.Char8              as B8
import           Data.ByteString.Internal           (c2w)
import           Data.Conduit
import           Data.Conduit.Attoparsec
import           Data.Conduit.Binary                (sinkFile, sinkIOHandle,
                                                     sourceFile)
import qualified Data.Conduit.List                  as C
import qualified Data.Map                           as M
import qualified Data.Map.Ordered                   as MO
import           Data.String
import           Data.Text                          (Text)
import qualified Data.Text                          as T
import qualified Data.Text.Encoding                 as T
import qualified Data.Vector                        as V
import qualified Data.Vector.Generic                as GV
import qualified Data.Vector.Generic.Mutable        as GMV
import           Data.Void                           as Void
import           System.IO
-------------------------------------------------------------------------------
import           Data.CSV.Conduit.Conversion        (FromNamedRecord (..),
                                                     FromNamedRecordOrdered (..),
                                                     Named (..),
                                                     NamedOrdered (..),
                                                     ToNamedRecord (..),
                                                     ToNamedRecordOrdered (..),
                                                     runParser)
import qualified Data.CSV.Conduit.Parser.ByteString as BSP
import qualified Data.CSV.Conduit.Parser.Text       as TP
import           Data.CSV.Conduit.Types
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | Represents types 'r' that are CSV-like and can be converted
-- to/from an underlying stream of type 's'. There is nothing scary
-- about the type:
--
-- @s@ represents stream types that can be converted to\/from CSV rows.
-- Examples are 'ByteString', 'Text' and 'String'.
--
-- @r@ represents the target CSV row representations that this library
-- can work with. Examples are the 'Row' types, the 'Record' type and
-- the 'MapRow' family of types. We can also convert directly to
-- complex Haskell types using the 'Data.CSV.Conduit.Conversion'
-- module that was borrowed from the cassava package, which was itself
-- inspired by the aeson package.
--
--
-- Example #1: Basics Using Convenience API
--
-- >import Data.Conduit
-- >import Data.Conduit.Binary
-- >import Data.Conduit.List as CL
-- >import Data.CSV.Conduit
-- >
-- >myProcessor :: Conduit (Row Text) m (Row Text)
-- >myProcessor = CL.map reverse
-- >
-- >test = runResourceT $
-- >  transformCSV defCSVSettings
-- >               (sourceFile "input.csv")
-- >               myProcessor
-- >               (sinkFile "output.csv")
--
--
-- Example #2: Basics Using Conduit API
--
-- >import Data.Conduit
-- >import Data.Conduit.Binary
-- >import Data.CSV.Conduit
-- >
-- >myProcessor :: Conduit (MapRow Text) m (MapRow Text)
-- >myProcessor = undefined
-- >
-- >test = runResourceT $ runConduit $
-- >  sourceFile "test/BigFile.csv" .|
-- >  intoCSV defCSVSettings .|
-- >  myProcessor .|
-- >  (writeHeaders defCSVSettings >> fromCSV defCSVSettings) .|
-- >  sinkFile "test/BigFileOut.csv"
class CSV s r where

  -----------------------------------------------------------------------------
  -- | Convert a CSV row into strict ByteString equivalent.
  rowToStr :: CSVSettings -> r -> s

  -----------------------------------------------------------------------------
  -- | Turn a stream of 's' into a stream of CSV row type. An example
  -- would be parsing a ByteString stream as rows of 'MapRow' 'Text'.
  intoCSV :: (MonadThrow m) => CSVSettings -> ConduitM s r m ()

  -----------------------------------------------------------------------------
  -- | Turn a stream of CSV row type back into a stream of 's'. An
  -- example would be rendering a stream of 'Row' 'ByteString' rows as
  -- 'Text'.
  fromCSV :: Monad m => CSVSettings -> ConduitM r s m ()





------------------------------------------------------------------------------
-- | 'Row' instance using 'ByteString'
instance CSV ByteString (Row ByteString) where
  rowToStr :: CSVSettings -> Row ByteString -> ByteString
rowToStr CSVSettings
s !Row ByteString
r =
    let
      sep :: ByteString
sep = [Word8] -> ByteString
B.pack [Char -> Word8
c2w (CSVSettings -> Char
csvSep CSVSettings
s)]
      wrapField :: ByteString -> ByteString
wrapField !ByteString
f = case CSVSettings -> Maybe Char
csvQuoteChar CSVSettings
s of
        Just !Char
x-> (Char
x Char -> ByteString -> ByteString
`B8.cons` Char -> ByteString -> ByteString
escape Char
x ByteString
f) ByteString -> Char -> ByteString
`B8.snoc` Char
x
        Maybe Char
_      -> ByteString
f
      escape :: Char -> ByteString -> ByteString
escape Char
c ByteString
str = ByteString -> Row ByteString -> ByteString
B8.intercalate (String -> ByteString
B8.pack [Char
c,Char
c]) (Row ByteString -> ByteString) -> Row ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> Row ByteString
B8.split Char
c ByteString
str
    in ByteString -> Row ByteString -> ByteString
B.intercalate ByteString
sep (Row ByteString -> ByteString)
-> (Row ByteString -> Row ByteString)
-> Row ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> Row ByteString -> Row ByteString
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
wrapField (Row ByteString -> ByteString) -> Row ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Row ByteString
r

  intoCSV :: CSVSettings -> ConduitM ByteString (Row ByteString) m ()
intoCSV CSVSettings
set = Parser ByteString (Maybe (Row ByteString))
-> ConduitM ByteString (Row ByteString) m ()
forall (m :: * -> *) i o.
(MonadThrow m, AttoparsecInput i) =>
Parser i (Maybe o) -> ConduitM i o m ()
intoCSVRow (CSVSettings -> Parser ByteString (Maybe (Row ByteString))
BSP.row CSVSettings
set)
  fromCSV :: CSVSettings -> ConduitM (Row ByteString) ByteString m ()
fromCSV CSVSettings
set = CSVSettings -> ConduitM (Row ByteString) ByteString m ()
forall (m :: * -> *) s r.
(Monad m, IsString s, CSV s r) =>
CSVSettings -> ConduitM r s m ()
fromCSVRow CSVSettings
set


------------------------------------------------------------------------------
-- | 'Row' instance using 'Text'
instance CSV Text (Row Text) where
  rowToStr :: CSVSettings -> Row Text -> Text
rowToStr CSVSettings
s !Row Text
r =
    let
      sep :: Text
sep = String -> Text
T.pack [CSVSettings -> Char
csvSep CSVSettings
s]
      wrapField :: Text -> Text
wrapField !Text
f = case CSVSettings -> Maybe Char
csvQuoteChar CSVSettings
s of
        Just !Char
x-> Char
x Char -> Text -> Text
`T.cons` Char -> Text -> Text
escape Char
x Text
f Text -> Char -> Text
`T.snoc` Char
x
        Maybe Char
_      -> Text
f
      escape :: Char -> Text -> Text
escape Char
c Text
str = Text -> Row Text -> Text
T.intercalate (String -> Text
T.pack [Char
c,Char
c]) (Row Text -> Text) -> Row Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Row Text
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
str
    in Text -> Row Text -> Text
T.intercalate Text
sep (Row Text -> Text) -> (Row Text -> Row Text) -> Row Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Row Text -> Row Text
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
wrapField (Row Text -> Text) -> Row Text -> Text
forall a b. (a -> b) -> a -> b
$ Row Text
r

  intoCSV :: CSVSettings -> ConduitM Text (Row Text) m ()
intoCSV CSVSettings
set = Parser Text (Maybe (Row Text)) -> ConduitM Text (Row Text) m ()
forall (m :: * -> *) i o.
(MonadThrow m, AttoparsecInput i) =>
Parser i (Maybe o) -> ConduitM i o m ()
intoCSVRow (CSVSettings -> Parser Text (Maybe (Row Text))
TP.row CSVSettings
set)
  fromCSV :: CSVSettings -> ConduitM (Row Text) Text m ()
fromCSV CSVSettings
set = CSVSettings -> ConduitM (Row Text) Text m ()
forall (m :: * -> *) s r.
(Monad m, IsString s, CSV s r) =>
CSVSettings -> ConduitM r s m ()
fromCSVRow CSVSettings
set


-------------------------------------------------------------------------------
-- | 'Row' instance using 'Text' based on 'ByteString' stream
instance CSV ByteString (Row Text) where
    rowToStr :: CSVSettings -> Row Text -> ByteString
rowToStr CSVSettings
s Row Text
r = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ CSVSettings -> Row Text -> Text
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s Row Text
r
    intoCSV :: CSVSettings -> ConduitM ByteString (Row Text) m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM ByteString (Row ByteString) m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM ByteString (Row ByteString) m ()
-> ConduitM (Row ByteString) (Row Text) m ()
-> ConduitM ByteString (Row Text) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Row ByteString -> Row Text)
-> ConduitM (Row ByteString) (Row Text) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map ((ByteString -> Text) -> Row ByteString -> Row Text
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
T.decodeUtf8)
    fromCSV :: CSVSettings -> ConduitM (Row Text) ByteString m ()
fromCSV CSVSettings
set = CSVSettings -> ConduitM (Row Text) Text m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set ConduitM (Row Text) Text m ()
-> ConduitM Text ByteString m ()
-> ConduitM (Row Text) ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Text -> ByteString) -> ConduitM Text ByteString m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map Text -> ByteString
T.encodeUtf8



-------------------------------------------------------------------------------
-- | 'Row' instance using 'String' based on 'ByteString' stream.
-- Please note this uses the ByteString operations underneath and has
-- lots of unnecessary overhead. Included for convenience.
instance CSV ByteString (Row String) where
    rowToStr :: CSVSettings -> Row String -> ByteString
rowToStr CSVSettings
s Row String
r = CSVSettings -> Row ByteString -> ByteString
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (Row ByteString -> ByteString) -> Row ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (String -> ByteString) -> Row String -> Row ByteString
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B8.pack Row String
r
    intoCSV :: CSVSettings -> ConduitM ByteString (Row String) m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM ByteString (Row ByteString) m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM ByteString (Row ByteString) m ()
-> ConduitM (Row ByteString) (Row String) m ()
-> ConduitM ByteString (Row String) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Row ByteString -> Row String)
-> ConduitM (Row ByteString) (Row String) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map ((ByteString -> String) -> Row ByteString -> Row String
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
B8.unpack)
    fromCSV :: CSVSettings -> ConduitM (Row String) ByteString m ()
fromCSV CSVSettings
set = (Row String -> Row ByteString)
-> ConduitT (Row String) (Row ByteString) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map ((String -> ByteString) -> Row String -> Row ByteString
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B8.pack) ConduitT (Row String) (Row ByteString) m ()
-> ConduitM (Row ByteString) ByteString m ()
-> ConduitM (Row String) ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM (Row ByteString) ByteString m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set


-- | Support for parsing rows in the 'Vector' form.
instance (CSV s (Row s)) => CSV s (V.Vector s) where
    rowToStr :: CSVSettings -> Vector s -> s
rowToStr CSVSettings
s Vector s
r = CSVSettings -> Row s -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (Row s -> s) -> (Vector s -> Row s) -> Vector s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector s -> Row s
forall a. Vector a -> [a]
V.toList (Vector s -> s) -> Vector s -> s
forall a b. (a -> b) -> a -> b
$ Vector s
r
    intoCSV :: CSVSettings -> ConduitM s (Vector s) m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM s (Row s) m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM s (Row s) m ()
-> ConduitM (Row s) (Vector s) m () -> ConduitM s (Vector s) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Row s -> Vector s) -> ConduitM (Row s) (Vector s) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map (Row s -> Vector s
forall a. [a] -> Vector a
V.fromList)
    fromCSV :: CSVSettings -> ConduitM (Vector s) s m ()
fromCSV CSVSettings
set = (Vector s -> Row s) -> ConduitT (Vector s) (Row s) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map (Vector s -> Row s
forall a. Vector a -> [a]
V.toList) ConduitT (Vector s) (Row s) m ()
-> ConduitM (Row s) s m () -> ConduitM (Vector s) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM (Row s) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set



-------------------------------------------------------------------------------
fromCSVRow :: (Monad m, IsString s, CSV s r)
           => CSVSettings -> ConduitM r s m ()
fromCSVRow :: CSVSettings -> ConduitM r s m ()
fromCSVRow CSVSettings
set = (r -> ConduitM r s m ()) -> ConduitM r s m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((r -> ConduitM r s m ()) -> ConduitM r s m ())
-> (r -> ConduitM r s m ()) -> ConduitM r s m ()
forall a b. (a -> b) -> a -> b
$ \r
row -> (s -> ConduitM r s m ()) -> [s] -> ConduitM r s m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ s -> ConduitM r s m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [CSVSettings -> r -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set r
row, s
"\n"]



-------------------------------------------------------------------------------
intoCSVRow :: (MonadThrow m, AttoparsecInput i) => Parser i (Maybe o) -> ConduitM i o m ()
intoCSVRow :: Parser i (Maybe o) -> ConduitM i o m ()
intoCSVRow Parser i (Maybe o)
p = ConduitT i (PositionRange, Maybe o) m ()
parse ConduitT i (PositionRange, Maybe o) m ()
-> ConduitM (PositionRange, Maybe o) o m () -> ConduitM i o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (PositionRange, Maybe o) o m ()
forall a o. ConduitT (a, Maybe o) o m ()
puller
  where
    parse :: ConduitT i (PositionRange, Maybe o) m ()
parse = {-# SCC "conduitParser_p" #-} Parser i (Maybe o) -> ConduitT i (PositionRange, Maybe o) m ()
forall a (m :: * -> *) b.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a (PositionRange, b) m ()
conduitParser Parser i (Maybe o)
p
    puller :: ConduitT (a, Maybe o) o m ()
puller = {-# SCC "puller" #-}
      ((a, Maybe o) -> ConduitT (a, Maybe o) o m ())
-> ConduitT (a, Maybe o) o m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (((a, Maybe o) -> ConduitT (a, Maybe o) o m ())
 -> ConduitT (a, Maybe o) o m ())
-> ((a, Maybe o) -> ConduitT (a, Maybe o) o m ())
-> ConduitT (a, Maybe o) o m ()
forall a b. (a -> b) -> a -> b
$ \ (a
_, Maybe o
mrow) -> ConduitT (a, Maybe o) o m ()
-> (o -> ConduitT (a, Maybe o) o m ())
-> Maybe o
-> ConduitT (a, Maybe o) o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT (a, Maybe o) o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) o -> ConduitT (a, Maybe o) o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Maybe o
mrow


-------------------------------------------------------------------------------
-- | Generic 'MapRow' instance; any stream type with a 'Row' instance
-- automatically gets a 'MapRow' instance.
instance (CSV s (Row s'), Ord s', IsString s) => CSV s (MapRow s') where
  rowToStr :: CSVSettings -> MapRow s' -> s
rowToStr CSVSettings
s MapRow s'
r = CSVSettings -> Row s' -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (Row s' -> s) -> (MapRow s' -> Row s') -> MapRow s' -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapRow s' -> Row s'
forall k a. Map k a -> [a]
M.elems (MapRow s' -> s) -> MapRow s' -> s
forall a b. (a -> b) -> a -> b
$ MapRow s'
r
  intoCSV :: CSVSettings -> ConduitM s (MapRow s') m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM s (MapRow s') m ()
forall a (m :: * -> *) s.
(Ord a, MonadThrow m, CSV s [a]) =>
CSVSettings -> ConduitM s (MapRow a) m ()
intoCSVMap CSVSettings
set
  fromCSV :: CSVSettings -> ConduitM (MapRow s') s m ()
fromCSV CSVSettings
set = CSVSettings -> ConduitM (MapRow s') s m ()
forall (m :: * -> *) s a k.
(Monad m, IsString s, CSV s [a]) =>
CSVSettings -> ConduitM (Map k a) s m ()
fromCSVMap CSVSettings
set

instance (CSV s (Row s'), Ord s', IsString s) => CSV s (OrderedMapRow s') where
  rowToStr :: CSVSettings -> OrderedMapRow s' -> s
rowToStr CSVSettings
s OrderedMapRow s'
r = CSVSettings -> Row s' -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (Row s' -> s)
-> (OrderedMapRow s' -> Row s') -> OrderedMapRow s' -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((s', s') -> s') -> [(s', s')] -> Row s'
forall a b. (a -> b) -> [a] -> [b]
map (s', s') -> s'
forall a b. (a, b) -> b
snd ([(s', s')] -> Row s')
-> (OrderedMapRow s' -> [(s', s')]) -> OrderedMapRow s' -> Row s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderedMapRow s' -> [(s', s')]
forall k v. OMap k v -> [(k, v)]
MO.assocs) (OrderedMapRow s' -> s) -> OrderedMapRow s' -> s
forall a b. (a -> b) -> a -> b
$ OrderedMapRow s'
r
  intoCSV :: CSVSettings -> ConduitM s (OrderedMapRow s') m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM s (OrderedMapRow s') m ()
forall a (m :: * -> *) s.
(Ord a, MonadThrow m, CSV s [a]) =>
CSVSettings -> ConduitM s (OrderedMapRow a) m ()
intoCSVMapOrdered CSVSettings
set
  fromCSV :: CSVSettings -> ConduitM (OrderedMapRow s') s m ()
fromCSV CSVSettings
set = CSVSettings -> ConduitM (OrderedMapRow s') s m ()
forall (m :: * -> *) s a k.
(Monad m, IsString s, CSV s [a]) =>
CSVSettings -> ConduitM (OMap k a) s m ()
fromCSVMapOrdered CSVSettings
set


-------------------------------------------------------------------------------
intoCSVMap :: (Ord a, MonadThrow m, CSV s [a])
           => CSVSettings -> ConduitM s (MapRow a) m ()
intoCSVMap :: CSVSettings -> ConduitM s (MapRow a) m ()
intoCSVMap CSVSettings
set = CSVSettings -> ConduitM s [a] m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM s [a] m ()
-> ConduitM [a] (MapRow a) m () -> ConduitM s (MapRow a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ConduitT [a] (MapRow a) m [a]
forall a o. ConduitT [a] o m [a]
headers ConduitT [a] (MapRow a) m [a]
-> ([a] -> ConduitM [a] (MapRow a) m ())
-> ConduitM [a] (MapRow a) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ConduitM [a] (MapRow a) m ()
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
[k] -> ConduitT [a] (Map k a) m ()
converter)
  where
    headers :: ConduitT [a] o m [a]
headers = do
      Maybe [a]
mrow <- ConduitT [a] o m (Maybe [a])
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
      case Maybe [a]
mrow of
        Maybe [a]
Nothing -> [a] -> ConduitT [a] o m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just [] -> ConduitT [a] o m [a]
headers
        Just [a]
hs -> [a] -> ConduitT [a] o m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
hs
    converter :: [k] -> ConduitT [a] (Map k a) m ()
converter [k]
hs = ([a] -> ConduitT [a] (Map k a) m ()) -> ConduitT [a] (Map k a) m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (([a] -> ConduitT [a] (Map k a) m ())
 -> ConduitT [a] (Map k a) m ())
-> ([a] -> ConduitT [a] (Map k a) m ())
-> ConduitT [a] (Map k a) m ()
forall a b. (a -> b) -> a -> b
$ Map k a -> ConduitT [a] (Map k a) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Map k a -> ConduitT [a] (Map k a) m ())
-> ([a] -> Map k a) -> [a] -> ConduitT [a] (Map k a) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [a] -> Map k a
forall k a. Ord k => [k] -> [a] -> Map k a
toMapCSV [k]
hs
    toMapCSV :: [k] -> [a] -> Map k a
toMapCSV ![k]
hs ![a]
fs = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, a)] -> Map k a) -> [(k, a)] -> Map k a
forall a b. (a -> b) -> a -> b
$ [k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
hs [a]
fs

intoCSVMapOrdered :: (Ord a, MonadThrow m, CSV s [a])
           => CSVSettings -> ConduitM s (OrderedMapRow a) m ()
intoCSVMapOrdered :: CSVSettings -> ConduitM s (OrderedMapRow a) m ()
intoCSVMapOrdered CSVSettings
set = CSVSettings -> ConduitM s [a] m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM s [a] m ()
-> ConduitM [a] (OrderedMapRow a) m ()
-> ConduitM s (OrderedMapRow a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ConduitT [a] (OrderedMapRow a) m [a]
forall a o. ConduitT [a] o m [a]
headers ConduitT [a] (OrderedMapRow a) m [a]
-> ([a] -> ConduitM [a] (OrderedMapRow a) m ())
-> ConduitM [a] (OrderedMapRow a) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ConduitM [a] (OrderedMapRow a) m ()
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
[k] -> ConduitT [v] (OMap k v) m ()
converter)
  where
    headers :: ConduitT [a] o m [a]
headers = do
      Maybe [a]
mrow <- ConduitT [a] o m (Maybe [a])
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
      case Maybe [a]
mrow of
        Maybe [a]
Nothing -> [a] -> ConduitT [a] o m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just [] -> ConduitT [a] o m [a]
headers
        Just [a]
hs -> [a] -> ConduitT [a] o m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
hs
    converter :: [k] -> ConduitT [v] (OMap k v) m ()
converter [k]
hs = ([v] -> ConduitT [v] (OMap k v) m ())
-> ConduitT [v] (OMap k v) m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (([v] -> ConduitT [v] (OMap k v) m ())
 -> ConduitT [v] (OMap k v) m ())
-> ([v] -> ConduitT [v] (OMap k v) m ())
-> ConduitT [v] (OMap k v) m ()
forall a b. (a -> b) -> a -> b
$ OMap k v -> ConduitT [v] (OMap k v) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (OMap k v -> ConduitT [v] (OMap k v) m ())
-> ([v] -> OMap k v) -> [v] -> ConduitT [v] (OMap k v) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [v] -> OMap k v
forall k v. Ord k => [k] -> [v] -> OMap k v
toMapCSV [k]
hs
    toMapCSV :: [k] -> [v] -> OMap k v
toMapCSV ![k]
hs ![v]
fs = [(k, v)] -> OMap k v
forall k v. Ord k => [(k, v)] -> OMap k v
MO.fromList ([(k, v)] -> OMap k v) -> [(k, v)] -> OMap k v
forall a b. (a -> b) -> a -> b
$ [k] -> [v] -> [(k, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
hs [v]
fs


-- | Conversion of stream directly to/from a custom complex haskell
-- type.
instance (FromNamedRecord a, ToNamedRecord a, CSV s (MapRow ByteString)) =>
    CSV s (Named a) where
    rowToStr :: CSVSettings -> Named a -> s
rowToStr CSVSettings
s Named a
a = CSVSettings -> MapRow ByteString -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (MapRow ByteString -> s)
-> (Named a -> MapRow ByteString) -> Named a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MapRow ByteString
forall a. ToNamedRecord a => a -> MapRow ByteString
toNamedRecord (a -> MapRow ByteString)
-> (Named a -> a) -> Named a -> MapRow ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named a -> a
forall a. Named a -> a
getNamed (Named a -> s) -> Named a -> s
forall a b. (a -> b) -> a -> b
$ Named a
a
    intoCSV :: CSVSettings -> ConduitM s (Named a) m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM s (MapRow ByteString) m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM s (MapRow ByteString) m ()
-> ConduitM (MapRow ByteString) (Named a) m ()
-> ConduitM s (Named a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (MapRow ByteString -> Maybe (Named a))
-> ConduitM (MapRow ByteString) (Named a) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
C.mapMaybe MapRow ByteString -> Maybe (Named a)
forall a. FromNamedRecord a => MapRow ByteString -> Maybe (Named a)
go
        where
          go :: MapRow ByteString -> Maybe (Named a)
go MapRow ByteString
x = (String -> Maybe (Named a))
-> (a -> Maybe (Named a)) -> Either String a -> Maybe (Named a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Named a) -> String -> Maybe (Named a)
forall a b. a -> b -> a
const Maybe (Named a)
forall a. Maybe a
Nothing) (Named a -> Maybe (Named a)
forall a. a -> Maybe a
Just (Named a -> Maybe (Named a))
-> (a -> Named a) -> a -> Maybe (Named a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Named a
forall a. a -> Named a
Named) (Either String a -> Maybe (Named a))
-> Either String a -> Maybe (Named a)
forall a b. (a -> b) -> a -> b
$
                 Parser a -> Either String a
forall a. Parser a -> Either String a
runParser (MapRow ByteString -> Parser a
forall a. FromNamedRecord a => MapRow ByteString -> Parser a
parseNamedRecord MapRow ByteString
x)

    fromCSV :: CSVSettings -> ConduitM (Named a) s m ()
fromCSV CSVSettings
set = (Named a -> MapRow ByteString)
-> ConduitT (Named a) (MapRow ByteString) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map Named a -> MapRow ByteString
go ConduitT (Named a) (MapRow ByteString) m ()
-> ConduitM (MapRow ByteString) s m () -> ConduitM (Named a) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM (MapRow ByteString) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set
        where
          go :: Named a -> MapRow ByteString
go = a -> MapRow ByteString
forall a. ToNamedRecord a => a -> MapRow ByteString
toNamedRecord (a -> MapRow ByteString)
-> (Named a -> a) -> Named a -> MapRow ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named a -> a
forall a. Named a -> a
getNamed

instance (FromNamedRecordOrdered a, ToNamedRecordOrdered a, CSV s (OrderedMapRow ByteString)) =>
    CSV s (NamedOrdered a) where
    rowToStr :: CSVSettings -> NamedOrdered a -> s
rowToStr CSVSettings
s NamedOrdered a
a = CSVSettings -> OrderedMapRow ByteString -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
s (OrderedMapRow ByteString -> s)
-> (NamedOrdered a -> OrderedMapRow ByteString)
-> NamedOrdered a
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> OrderedMapRow ByteString
forall a. ToNamedRecordOrdered a => a -> OrderedMapRow ByteString
toNamedRecordOrdered (a -> OrderedMapRow ByteString)
-> (NamedOrdered a -> a)
-> NamedOrdered a
-> OrderedMapRow ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedOrdered a -> a
forall a. NamedOrdered a -> a
getNamedOrdered (NamedOrdered a -> s) -> NamedOrdered a -> s
forall a b. (a -> b) -> a -> b
$ NamedOrdered a
a
    intoCSV :: CSVSettings -> ConduitM s (NamedOrdered a) m ()
intoCSV CSVSettings
set = CSVSettings -> ConduitM s (OrderedMapRow ByteString) m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM s (OrderedMapRow ByteString) m ()
-> ConduitM (OrderedMapRow ByteString) (NamedOrdered a) m ()
-> ConduitM s (NamedOrdered a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (OrderedMapRow ByteString -> Maybe (NamedOrdered a))
-> ConduitM (OrderedMapRow ByteString) (NamedOrdered a) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
C.mapMaybe OrderedMapRow ByteString -> Maybe (NamedOrdered a)
forall a.
FromNamedRecordOrdered a =>
OrderedMapRow ByteString -> Maybe (NamedOrdered a)
go
        where
          go :: OrderedMapRow ByteString -> Maybe (NamedOrdered a)
go OrderedMapRow ByteString
x = (String -> Maybe (NamedOrdered a))
-> (a -> Maybe (NamedOrdered a))
-> Either String a
-> Maybe (NamedOrdered a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (NamedOrdered a) -> String -> Maybe (NamedOrdered a)
forall a b. a -> b -> a
const Maybe (NamedOrdered a)
forall a. Maybe a
Nothing) (NamedOrdered a -> Maybe (NamedOrdered a)
forall a. a -> Maybe a
Just (NamedOrdered a -> Maybe (NamedOrdered a))
-> (a -> NamedOrdered a) -> a -> Maybe (NamedOrdered a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NamedOrdered a
forall a. a -> NamedOrdered a
NamedOrdered) (Either String a -> Maybe (NamedOrdered a))
-> Either String a -> Maybe (NamedOrdered a)
forall a b. (a -> b) -> a -> b
$
                 Parser a -> Either String a
forall a. Parser a -> Either String a
runParser (OrderedMapRow ByteString -> Parser a
forall a.
FromNamedRecordOrdered a =>
OrderedMapRow ByteString -> Parser a
parseNamedRecordOrdered OrderedMapRow ByteString
x)

    fromCSV :: CSVSettings -> ConduitM (NamedOrdered a) s m ()
fromCSV CSVSettings
set = (NamedOrdered a -> OrderedMapRow ByteString)
-> ConduitT (NamedOrdered a) (OrderedMapRow ByteString) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map NamedOrdered a -> OrderedMapRow ByteString
go ConduitT (NamedOrdered a) (OrderedMapRow ByteString) m ()
-> ConduitM (OrderedMapRow ByteString) s m ()
-> ConduitM (NamedOrdered a) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM (OrderedMapRow ByteString) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set
        where
          go :: NamedOrdered a -> OrderedMapRow ByteString
go = a -> OrderedMapRow ByteString
forall a. ToNamedRecordOrdered a => a -> OrderedMapRow ByteString
toNamedRecordOrdered (a -> OrderedMapRow ByteString)
-> (NamedOrdered a -> a)
-> NamedOrdered a
-> OrderedMapRow ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedOrdered a -> a
forall a. NamedOrdered a -> a
getNamedOrdered


-------------------------------------------------------------------------------
fromCSVMap :: (Monad m, IsString s, CSV s [a])
           => CSVSettings -> ConduitM (M.Map k a) s m ()
fromCSVMap :: CSVSettings -> ConduitM (Map k a) s m ()
fromCSVMap CSVSettings
set = (Map k a -> ConduitM (Map k a) s m ()) -> ConduitM (Map k a) s m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever Map k a -> ConduitM (Map k a) s m ()
forall (m :: * -> *) o a k i.
(Monad m, CSV o [a], IsString o) =>
Map k a -> ConduitT i o m ()
push
  where
    push :: Map k a -> ConduitT i o m ()
push Map k a
r = (o -> ConduitT i o m ()) -> [o] -> ConduitT i o m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ o -> ConduitT i o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [CSVSettings -> [a] -> o
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (Map k a -> [a]
forall k a. Map k a -> [a]
M.elems Map k a
r), o
"\n"]

fromCSVMapOrdered :: (Monad m, IsString s, CSV s [a])
                  => CSVSettings -> ConduitM (MO.OMap k a) s m ()
fromCSVMapOrdered :: CSVSettings -> ConduitM (OMap k a) s m ()
fromCSVMapOrdered CSVSettings
set = (OMap k a -> ConduitM (OMap k a) s m ())
-> ConduitM (OMap k a) s m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever OMap k a -> ConduitM (OMap k a) s m ()
forall (m :: * -> *) o b a i.
(Monad m, CSV o [b], IsString o) =>
OMap a b -> ConduitT i o m ()
push
  where
    push :: OMap a b -> ConduitT i o m ()
push OMap a b
r = (o -> ConduitT i o m ()) -> [o] -> ConduitT i o m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ o -> ConduitT i o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [CSVSettings -> [b] -> o
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd ([(a, b)] -> [b]) -> [(a, b)] -> [b]
forall a b. (a -> b) -> a -> b
$ OMap a b -> [(a, b)]
forall k v. OMap k v -> [(k, v)]
MO.assocs OMap a b
r), o
"\n"]


-------------------------------------------------------------------------------
-- | Write headers AND the row into the output stream, once. If you
-- don't call this while using 'MapRow' family of row types, then your
-- resulting output will NOT have any headers in it.
--
-- Usage: Just chain this using the 'Monad' instance in your pipeline:
--
-- > runConduit $ ... .| writeHeaders settings >> fromCSV settings .| sinkFile "..."
writeHeaders
    :: (Monad m, CSV s (Row r), IsString s)
    => CSVSettings
    -> ConduitM (MapRow r) s m ()
writeHeaders :: CSVSettings -> ConduitM (MapRow r) s m ()
writeHeaders CSVSettings
set = do
  Maybe (MapRow r)
mrow <- ConduitT (MapRow r) s m (Maybe (MapRow r))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
  case Maybe (MapRow r)
mrow of
    Maybe (MapRow r)
Nothing -> () -> ConduitM (MapRow r) s m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just MapRow r
row -> (s -> ConduitM (MapRow r) s m ())
-> [s] -> ConduitM (MapRow r) s m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ s -> ConduitM (MapRow r) s m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [ CSVSettings -> [r] -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (MapRow r -> [r]
forall k a. Map k a -> [k]
M.keys MapRow r
row)
                            , s
"\n"
                            , CSVSettings -> [r] -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (MapRow r -> [r]
forall k a. Map k a -> [a]
M.elems MapRow r
row)
                            , s
"\n" ]

writeHeadersOrdered
    :: (Monad m, CSV s (Row r), IsString s)
    => CSVSettings
    -> ConduitM (OrderedMapRow r) s m ()
writeHeadersOrdered :: CSVSettings -> ConduitM (OrderedMapRow r) s m ()
writeHeadersOrdered CSVSettings
set = do
  Maybe (OrderedMapRow r)
mrow <- ConduitT (OrderedMapRow r) s m (Maybe (OrderedMapRow r))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
  case Maybe (OrderedMapRow r)
mrow of
    Maybe (OrderedMapRow r)
Nothing -> () -> ConduitM (OrderedMapRow r) s m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just OrderedMapRow r
row -> (s -> ConduitM (OrderedMapRow r) s m ())
-> [s] -> ConduitM (OrderedMapRow r) s m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ s -> ConduitM (OrderedMapRow r) s m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [ CSVSettings -> [r] -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (((r, r) -> r) -> [(r, r)] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map (r, r) -> r
forall a b. (a, b) -> a
fst ([(r, r)] -> [r]) -> [(r, r)] -> [r]
forall a b. (a -> b) -> a -> b
$ OrderedMapRow r -> [(r, r)]
forall k v. OMap k v -> [(k, v)]
MO.assocs OrderedMapRow r
row)
                            , s
"\n"
                            , CSVSettings -> [r] -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (((r, r) -> r) -> [(r, r)] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map (r, r) -> r
forall a b. (a, b) -> b
snd ([(r, r)] -> [r]) -> [(r, r)] -> [r]
forall a b. (a -> b) -> a -> b
$ OrderedMapRow r -> [(r, r)]
forall k v. OMap k v -> [(k, v)]
MO.assocs OrderedMapRow r
row)
                            , s
"\n" ]


                          ---------------------------
                          -- Convenience Functions --
                          ---------------------------


-------------------------------------------------------------------------------
-- | Read the entire contents of a CSV file into memory.
readCSVFile
    :: (MonadIO m, CSV ByteString a)
    => CSVSettings -- ^ Settings to use in deciphering stream
    -> FilePath    -- ^ Input file
    -> m (V.Vector a)
readCSVFile :: CSVSettings -> String -> m (Vector a)
readCSVFile CSVSettings
set String
fp = IO (Vector a) -> m (Vector a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector a) -> m (Vector a))
-> (ResourceT IO (Vector a) -> IO (Vector a))
-> ResourceT IO (Vector a)
-> m (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO (Vector a) -> IO (Vector a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Vector a) -> m (Vector a))
-> ResourceT IO (Vector a) -> m (Vector a)
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT IO) (Vector a)
-> ResourceT IO (Vector a)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) (Vector a)
 -> ResourceT IO (Vector a))
-> ConduitT () Void (ResourceT IO) (Vector a)
-> ResourceT IO (Vector a)
forall a b. (a -> b) -> a -> b
$ String -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
sourceFile String
fp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) (Vector a)
-> ConduitT () Void (ResourceT IO) (Vector a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM ByteString a (ResourceT IO) ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set ConduitM ByteString a (ResourceT IO) ()
-> ConduitM a Void (ResourceT IO) (Vector a)
-> ConduitM ByteString Void (ResourceT IO) (Vector a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (forall a. IO a -> ResourceT IO a)
-> ConduitT a Void IO (Vector a)
-> ConduitM a Void (ResourceT IO) (Vector a)
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 a. IO a -> ResourceT IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> ConduitT a Void IO (Vector a)
forall (m :: * -> *) (v :: * -> *) a o.
(PrimMonad m, Vector v a) =>
Int -> ConduitM a o m (v a)
sinkVector Int
growthFactor)
  where
    growthFactor :: Int
growthFactor = Int
10


-------------------------------------------------------------------------------
-- | A simple way to decode a CSV string. Don't be alarmed by the
-- polymorphic nature of the signature. 's' is the type for the string
-- and 'v' is a kind of 'Vector' here.
--
-- For example for 'ByteString':
--
-- >>> s <- LB.readFile "my.csv"
-- >>> decodeCSV defCSVSettings s :: Either SomeException (Vector (Vector ByteString))
--
-- will work as long as the data is comma separated.
decodeCSV
    :: forall v a s. (GV.Vector v a, CSV s a)
    => CSVSettings
    -> s
    -> Either SomeException (v a)
decodeCSV :: CSVSettings -> s -> Either SomeException (v a)
decodeCSV CSVSettings
set s
bs = (forall s. ST s (Either SomeException (v a)))
-> Either SomeException (v a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either SomeException (v a)))
 -> Either SomeException (v a))
-> (forall s. ST s (Either SomeException (v a)))
-> Either SomeException (v a)
forall a b. (a -> b) -> a -> b
$ ExceptT SomeException (ST s) (v a)
-> ST s (Either SomeException (v a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT SomeException (ST s) (v a)
forall s1. ExceptT SomeException (ST s1) (v a)
pipeline
  where
    src :: ConduitM () s (ExceptT SomeException (ST s1)) ()
    src :: ConduitM () s (ExceptT SomeException (ST s1)) ()
src = [s] -> ConduitM () s (ExceptT SomeException (ST s1)) ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
C.sourceList [s
bs]
    csvConvert :: ConduitM s a (ExceptT SomeException (ST s1)) ()
    csvConvert :: ConduitM s a (ExceptT SomeException (ST s1)) ()
csvConvert = (forall a. CatchT (ST s1) a -> ExceptT SomeException (ST s1) a)
-> ConduitT s a (CatchT (ST s1)) ()
-> ConduitM s a (ExceptT SomeException (ST s1)) ()
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 (ST s1 (Either SomeException a) -> ExceptT SomeException (ST s1) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ST s1 (Either SomeException a) -> ExceptT SomeException (ST s1) a)
-> (CatchT (ST s1) a -> ST s1 (Either SomeException a))
-> CatchT (ST s1) a
-> ExceptT SomeException (ST s1) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatchT (ST s1) a -> ST s1 (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT) ConduitT s a (CatchT (ST s1)) ()
forall s1. ConduitM s a (CatchT (ST s1)) ()
csvConvert'
    csvConvert' :: ConduitM s a (CatchT (ST s1)) ()
    csvConvert' :: ConduitM s a (CatchT (ST s1)) ()
csvConvert' = CSVSettings -> ConduitM s a (CatchT (ST s1)) ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
set
    growthFactor :: Int
growthFactor = Int
10
    sink :: ConduitM a Void.Void (ExceptT SomeException (ST s1)) (v a)
    sink :: ConduitM a Void (ExceptT SomeException (ST s1)) (v a)
sink = Int -> ConduitM a Void (ExceptT SomeException (ST s1)) (v a)
forall (m :: * -> *) (v :: * -> *) a o.
(PrimMonad m, Vector v a) =>
Int -> ConduitM a o m (v a)
sinkVector Int
growthFactor
    pipeline :: ExceptT SomeException (ST s1) (v a)
    pipeline :: ExceptT SomeException (ST s1) (v a)
pipeline = ConduitT () Void (ExceptT SomeException (ST s1)) (v a)
-> ExceptT SomeException (ST s1) (v a)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitM () s (ExceptT SomeException (ST s1)) ()
forall s1. ConduitM () s (ExceptT SomeException (ST s1)) ()
src ConduitM () s (ExceptT SomeException (ST s1)) ()
-> ConduitM s Void (ExceptT SomeException (ST s1)) (v a)
-> ConduitT () Void (ExceptT SomeException (ST s1)) (v a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM s a (ExceptT SomeException (ST s1)) ()
forall s1. ConduitM s a (ExceptT SomeException (ST s1)) ()
csvConvert ConduitM s a (ExceptT SomeException (ST s1)) ()
-> ConduitM a Void (ExceptT SomeException (ST s1)) (v a)
-> ConduitM s Void (ExceptT SomeException (ST s1)) (v a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM a Void (ExceptT SomeException (ST s1)) (v a)
forall s1. ConduitM a Void (ExceptT SomeException (ST s1)) (v a)
sink)



-------------------------------------------------------------------------------
-- | Write CSV data into file. As we use a 'ByteString' sink, you'll
-- need to get your data into a 'ByteString' stream type.
writeCSVFile
  :: (CSV ByteString a)
  => CSVSettings
  -- ^ CSV Settings
  -> FilePath
  -- ^ Target file
  -> IOMode
  -- ^ Write vs. append mode
  -> [a]
  -- ^ List of rows
  -> IO ()
writeCSVFile :: CSVSettings -> String -> IOMode -> [a] -> IO ()
writeCSVFile CSVSettings
set String
fo IOMode
fmode [a]
rows = ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ do
  [a] -> ConduitT () a (ResourceT IO) ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
C.sourceList [a]
rows ConduitT () a (ResourceT IO) ()
-> ConduitM a Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CSVSettings -> ConduitM a ByteString (ResourceT IO) ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
set ConduitM a ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM a Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    IO Handle -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
IO Handle -> ConduitT ByteString o m ()
sinkIOHandle (String -> IOMode -> IO Handle
openFile String
fo IOMode
fmode)


-------------------------------------------------------------------------------
-- | Map over the rows of a CSV file. Provided for convenience for
-- historical reasons.
--
-- An easy way to run this function would be 'runResourceT' after
-- feeding it all the arguments.
mapCSVFile
    :: ( MonadResource m
       , CSV ByteString a
       , CSV ByteString b
# if MIN_VERSION_resourcet(1,2,0)
       , MonadThrow m
#endif
       )
      => CSVSettings
      -- ^ Settings to use both for both input and output
      -> (a -> [b])
      -- ^ A mapping function
      -> FilePath
      -- ^ Input file
      -> FilePath
      -- ^ Output file
      -> m ()
mapCSVFile :: CSVSettings -> (a -> [b]) -> String -> String -> m ()
mapCSVFile CSVSettings
set a -> [b]
f String
fi String
fo =
  CSVSettings
-> ConduitM () ByteString m ()
-> ConduitM a b m ()
-> ConduitM ByteString Void m ()
-> m ()
forall (m :: * -> *) s a s' b.
(MonadThrow m, CSV s a, CSV s' b) =>
CSVSettings
-> ConduitM () s m ()
-> ConduitM a b m ()
-> ConduitM s' Void m ()
-> m ()
transformCSV CSVSettings
set (String -> ConduitM () ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
sourceFile String
fi) ((a -> [b]) -> ConduitM a b m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> [b]) -> ConduitT a b m ()
C.concatMap a -> [b]
f) (String -> ConduitM ByteString Void m ()
forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
sinkFile String
fo)


-------------------------------------------------------------------------------
-- | Like transformCSV' but uses the same settings for both input and
-- output.
transformCSV
    :: (MonadThrow m, CSV s a, CSV s' b)
    => CSVSettings
    -- ^ Settings to be used for both input and output
    -> ConduitM () s m ()
    -- ^ A raw stream data source. Ex: 'sourceFile inFile'
    -> ConduitM a b m ()
    -- ^ A transforming conduit
    -> ConduitM s' Void.Void m ()
    -- ^ A raw stream data sink. Ex: 'sinkFile outFile'
    -> m ()
transformCSV :: CSVSettings
-> ConduitM () s m ()
-> ConduitM a b m ()
-> ConduitM s' Void m ()
-> m ()
transformCSV CSVSettings
set = CSVSettings
-> CSVSettings
-> ConduitM () s m ()
-> ConduitM a b m ()
-> ConduitM s' Void m ()
-> m ()
forall (m :: * -> *) s a s' b.
(MonadThrow m, CSV s a, CSV s' b) =>
CSVSettings
-> CSVSettings
-> ConduitM () s m ()
-> ConduitM a b m ()
-> ConduitM s' Void m ()
-> m ()
transformCSV' CSVSettings
set CSVSettings
set


-------------------------------------------------------------------------------
-- | General purpose CSV transformer. Apply a list-like processing
-- function from 'Data.Conduit.List' to the rows of a CSV stream. You
-- need to provide a stream data source, a transformer and a stream
-- data sink.
--
-- An easy way to run this function would be 'runResourceT' after
-- feeding it all the arguments.
--
-- Example - map a function over the rows of a CSV file:
--
-- > transformCSV setIn setOut (sourceFile inFile) (C.map f) (sinkFile outFile)
transformCSV'
    :: (MonadThrow m, CSV s a, CSV s' b)
    => CSVSettings
    -- ^ Settings to be used for input
    -> CSVSettings
    -- ^ Settings to be used for output
    -> ConduitM () s m ()
    -- ^ A raw stream data source. Ex: 'sourceFile inFile'
    -> ConduitM a b m ()
    -- ^ A transforming conduit
    -> ConduitM s' Void.Void m ()
    -- ^ A raw stream data sink. Ex: 'sinkFile outFile'
    -> m ()
transformCSV' :: CSVSettings
-> CSVSettings
-> ConduitM () s m ()
-> ConduitM a b m ()
-> ConduitM s' Void m ()
-> m ()
transformCSV' CSVSettings
setIn CSVSettings
setOut ConduitM () s m ()
source ConduitM a b m ()
c ConduitM s' Void m ()
sink = ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$
    ConduitM () s m ()
source ConduitM () s m () -> ConduitM s Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    CSVSettings -> ConduitM s a m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
intoCSV CSVSettings
setIn ConduitM s a m () -> ConduitM a Void m () -> ConduitM s Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    ConduitM a b m ()
c ConduitM a b m () -> ConduitM b Void m () -> ConduitM a Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    CSVSettings -> ConduitM b s' m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
fromCSV CSVSettings
setOut ConduitM b s' m () -> ConduitM s' Void m () -> ConduitM b Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    ConduitM s' Void m ()
sink




                              ------------------
                              -- Vector Utils --
                              ------------------



-------------------------------------------------------------------------------
-- | An efficient sink that incrementally grows a vector from the input stream
sinkVector :: (PrimMonad m, GV.Vector v a) => Int -> ConduitM a o m (v a)
sinkVector :: Int -> ConduitM a o m (v a)
sinkVector Int
by = do
    Mutable v (PrimState m) a
v <- m (Mutable v (PrimState m) a)
-> ConduitT a o m (Mutable v (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Mutable v (PrimState m) a)
 -> ConduitT a o m (Mutable v (PrimState m) a))
-> m (Mutable v (PrimState m) a)
-> ConduitT a o m (Mutable v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Int -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
GMV.new Int
by
    Int -> Mutable v (PrimState m) a -> ConduitM a o m (v a)
forall (m :: * -> *) (v :: * -> *) a o.
(PrimMonad m, Vector v a) =>
Int -> Mutable v (PrimState m) a -> ConduitT a o m (v a)
go Int
0 Mutable v (PrimState m) a
v
  where
    -- i is the index of the next element to be written by go
    -- also exactly the number of elements in v so far
    go :: Int -> Mutable v (PrimState m) a -> ConduitT a o m (v a)
go Int
i Mutable v (PrimState m) a
v = do
        Maybe a
res <- ConduitT a o m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
        case Maybe a
res of
          Maybe a
Nothing -> do
            v a
v' <- m (v a) -> ConduitT a o m (v a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (v a) -> ConduitT a o m (v a))
-> m (v a) -> ConduitT a o m (v a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
GV.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GMV.slice Int
0 Int
i Mutable v (PrimState m) a
v
            v a -> ConduitT a o m (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ConduitT a o m (v a)) -> v a -> ConduitT a o m (v a)
forall a b. (a -> b) -> a -> b
$! v a
v'
          Just a
x -> do
            Mutable v (PrimState m) a
v' <- case Mutable v (PrimState m) a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GMV.length Mutable v (PrimState m) a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i of
                    Bool
True  -> m (Mutable v (PrimState m) a)
-> ConduitT a o m (Mutable v (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Mutable v (PrimState m) a)
 -> ConduitT a o m (Mutable v (PrimState m) a))
-> m (Mutable v (PrimState m) a)
-> ConduitT a o m (Mutable v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> Int -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
GMV.grow Mutable v (PrimState m) a
v Int
by
                    Bool
False -> Mutable v (PrimState m) a
-> ConduitT a o m (Mutable v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable v (PrimState m) a
v
            m () -> ConduitT a o m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitT a o m ()) -> m () -> ConduitT a o m ()
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
GMV.write Mutable v (PrimState m) a
v' Int
i a
x
            Int -> Mutable v (PrimState m) a -> ConduitT a o m (v a)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Mutable v (PrimState m) a
v'