{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# 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           (runCatchT, CatchT)
import           Control.Monad.IO.Class             (MonadIO (liftIO))
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.Trans.Class          (MonadTrans(lift))
import           Control.Monad.Trans.Except         (ExceptT(..), runExceptT)
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, QuoteEmpty)
csvQuoteCharAndStyle CSVSettings
s of
        Just (Char
x, QuoteEmpty
quoteEmpty) ->
          case QuoteEmpty
quoteEmpty QuoteEmpty -> QuoteEmpty -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteEmpty
DoQuoteEmpty Bool -> Bool -> Bool
|| ByteString -> Int
B8.length ByteString
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 of
            Bool
True -> (Char
x Char -> ByteString -> ByteString
`B8.cons` Char -> ByteString -> ByteString
escape Char
x ByteString
f) ByteString -> Char -> ByteString
`B8.snoc` Char
x
            Bool
False -> ByteString
f
        Maybe (Char, QuoteEmpty)
Nothing   -> 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 :: forall (m :: * -> *).
MonadThrow m =>
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 :: forall (m :: * -> *).
Monad m =>
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, QuoteEmpty)
csvQuoteCharAndStyle CSVSettings
s of
        Just (Char
x, QuoteEmpty
quoteEmpty) -> case QuoteEmpty
quoteEmpty QuoteEmpty -> QuoteEmpty -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteEmpty
DoQuoteEmpty Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
T.null Text
f) of
          Bool
True -> Char
x Char -> Text -> Text
`T.cons` Char -> Text -> Text
escape Char
x Text
f Text -> Char -> Text
`T.snoc` Char
x
          Bool
False -> Text
f
        Maybe (Char, QuoteEmpty)
Nothing -> 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 :: forall (m :: * -> *).
MonadThrow m =>
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 :: forall (m :: * -> *).
Monad m =>
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 :: forall (m :: * -> *).
MonadThrow m =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM ByteString (Row ByteString) m ()
intoCSV CSVSettings
set ConduitM ByteString (Row ByteString) m ()
-> ConduitT (Row ByteString) (Row Text) m ()
-> ConduitT ByteString (Row Text) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Row ByteString -> Row Text)
-> ConduitT (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 :: forall (m :: * -> *).
Monad m =>
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 ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM (Row Text) Text m ()
fromCSV CSVSettings
set ConduitM (Row Text) Text m ()
-> ConduitT Text ByteString m ()
-> ConduitT (Row Text) ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Text -> ByteString) -> ConduitT 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 :: forall (m :: * -> *).
MonadThrow m =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM ByteString (Row ByteString) m ()
intoCSV CSVSettings
set ConduitM ByteString (Row ByteString) m ()
-> ConduitT (Row ByteString) (Row String) m ()
-> ConduitT ByteString (Row String) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Row ByteString -> Row String)
-> ConduitT (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 :: forall (m :: * -> *).
Monad m =>
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 ()
-> ConduitT (Row ByteString) ByteString m ()
-> ConduitT (Row String) ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitT (Row ByteString) ByteString m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM (Row ByteString) ByteString 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 :: forall (m :: * -> *).
MonadThrow m =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s (Row s) m ()
intoCSV CSVSettings
set ConduitM s (Row s) m ()
-> ConduitT (Row s) (Vector s) m () -> ConduitT s (Vector s) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Row s -> Vector s) -> ConduitT (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 :: forall (m :: * -> *).
Monad m =>
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 ()
-> ConduitT (Row s) s m () -> ConduitT (Vector s) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitT (Row s) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM (Row s) s m ()
fromCSV CSVSettings
set



-------------------------------------------------------------------------------
fromCSVRow :: (Monad m, IsString s, CSV s r)
           => CSVSettings -> ConduitM r s m ()
fromCSVRow :: forall (m :: * -> *) s r.
(Monad m, IsString s, CSV s r) =>
CSVSettings -> ConduitM r s m ()
fromCSVRow CSVSettings
set = (r -> ConduitT r s m ()) -> ConduitT r s m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((r -> ConduitT r s m ()) -> ConduitT r s m ())
-> (r -> ConduitT r s m ()) -> ConduitT r s m ()
forall a b. (a -> b) -> a -> b
$ \r
row -> (s -> ConduitT r s m ()) -> [s] -> ConduitT r s m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ s -> ConduitT 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 :: forall (m :: * -> *) i o.
(MonadThrow m, AttoparsecInput i) =>
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 ()
-> ConduitT (PositionRange, Maybe o) o m () -> ConduitT i o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT (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 a. a -> ConduitT (a, Maybe o) o m a
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 :: forall (m :: * -> *).
MonadThrow m =>
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 :: forall (m :: * -> *).
Monad m =>
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 :: forall (m :: * -> *).
MonadThrow m =>
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 :: forall (m :: * -> *).
Monad m =>
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 :: forall a (m :: * -> *) s.
(Ord a, MonadThrow m, CSV s [a]) =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s [a] m ()
intoCSV CSVSettings
set ConduitM s [a] m ()
-> ConduitT [a] (MapRow a) m () -> ConduitT s (MapRow a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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] -> ConduitT [a] (MapRow a) m ())
-> ConduitT [a] (MapRow a) m ()
forall a b.
ConduitT [a] (MapRow a) m a
-> (a -> ConduitT [a] (MapRow a) m b)
-> ConduitT [a] (MapRow a) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ConduitT [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 o. Monad m => ConduitT i o m (Maybe i)
await
      case Maybe [a]
mrow of
        Maybe [a]
Nothing -> [a] -> ConduitT [a] o m [a]
forall a. 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 a. 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 :: forall a (m :: * -> *) s.
(Ord a, MonadThrow m, CSV s [a]) =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s [a] m ()
intoCSV CSVSettings
set ConduitM s [a] m ()
-> ConduitT [a] (OrderedMapRow a) m ()
-> ConduitT s (OrderedMapRow a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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] -> ConduitT [a] (OrderedMapRow a) m ())
-> ConduitT [a] (OrderedMapRow a) m ()
forall a b.
ConduitT [a] (OrderedMapRow a) m a
-> (a -> ConduitT [a] (OrderedMapRow a) m b)
-> ConduitT [a] (OrderedMapRow a) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ConduitT [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 o. Monad m => ConduitT i o m (Maybe i)
await
      case Maybe [a]
mrow of
        Maybe [a]
Nothing -> [a] -> ConduitT [a] o m [a]
forall a. 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 a. 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 :: forall (m :: * -> *).
MonadThrow m =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s (MapRow ByteString) m ()
intoCSV CSVSettings
set ConduitM s (MapRow ByteString) m ()
-> ConduitT (MapRow ByteString) (Named a) m ()
-> ConduitT s (Named a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (MapRow ByteString -> Maybe (Named a))
-> ConduitT (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 {b}.
FromNamedRecord b =>
MapRow ByteString -> Maybe (Named b)
go
        where
          go :: MapRow ByteString -> Maybe (Named b)
go MapRow ByteString
x = (String -> Maybe (Named b))
-> (b -> Maybe (Named b)) -> Either String b -> Maybe (Named b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Named b) -> String -> Maybe (Named b)
forall a b. a -> b -> a
const Maybe (Named b)
forall a. Maybe a
Nothing) (Named b -> Maybe (Named b)
forall a. a -> Maybe a
Just (Named b -> Maybe (Named b))
-> (b -> Named b) -> b -> Maybe (Named b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Named b
forall a. a -> Named a
Named) (Either String b -> Maybe (Named b))
-> Either String b -> Maybe (Named b)
forall a b. (a -> b) -> a -> b
$
                 Parser b -> Either String b
forall a. Parser a -> Either String a
runParser (MapRow ByteString -> Parser b
forall a. FromNamedRecord a => MapRow ByteString -> Parser a
parseNamedRecord MapRow ByteString
x)

    fromCSV :: forall (m :: * -> *).
Monad m =>
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 ()
-> ConduitT (MapRow ByteString) s m () -> ConduitT (Named a) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitT (MapRow ByteString) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM (MapRow ByteString) 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 :: forall (m :: * -> *).
MonadThrow m =>
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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s (OrderedMapRow ByteString) m ()
intoCSV CSVSettings
set ConduitM s (OrderedMapRow ByteString) m ()
-> ConduitT (OrderedMapRow ByteString) (NamedOrdered a) m ()
-> ConduitT s (NamedOrdered a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (OrderedMapRow ByteString -> Maybe (NamedOrdered a))
-> ConduitT (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 {b}.
FromNamedRecordOrdered b =>
OrderedMapRow ByteString -> Maybe (NamedOrdered b)
go
        where
          go :: OrderedMapRow ByteString -> Maybe (NamedOrdered b)
go OrderedMapRow ByteString
x = (String -> Maybe (NamedOrdered b))
-> (b -> Maybe (NamedOrdered b))
-> Either String b
-> Maybe (NamedOrdered b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (NamedOrdered b) -> String -> Maybe (NamedOrdered b)
forall a b. a -> b -> a
const Maybe (NamedOrdered b)
forall a. Maybe a
Nothing) (NamedOrdered b -> Maybe (NamedOrdered b)
forall a. a -> Maybe a
Just (NamedOrdered b -> Maybe (NamedOrdered b))
-> (b -> NamedOrdered b) -> b -> Maybe (NamedOrdered b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> NamedOrdered b
forall a. a -> NamedOrdered a
NamedOrdered) (Either String b -> Maybe (NamedOrdered b))
-> Either String b -> Maybe (NamedOrdered b)
forall a b. (a -> b) -> a -> b
$
                 Parser b -> Either String b
forall a. Parser a -> Either String a
runParser (OrderedMapRow ByteString -> Parser b
forall a.
FromNamedRecordOrdered a =>
OrderedMapRow ByteString -> Parser a
parseNamedRecordOrdered OrderedMapRow ByteString
x)

    fromCSV :: forall (m :: * -> *).
Monad m =>
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 ()
-> ConduitT (OrderedMapRow ByteString) s m ()
-> ConduitT (NamedOrdered a) s m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitT (OrderedMapRow ByteString) s m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM (OrderedMapRow ByteString) 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 :: forall (m :: * -> *) s a k.
(Monad m, IsString s, CSV s [a]) =>
CSVSettings -> ConduitM (Map k a) s m ()
fromCSVMap CSVSettings
set = (Map k a -> ConduitT (Map k a) s m ()) -> ConduitT (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 -> ConduitT (Map k a) s m ()
forall {m :: * -> *} {a} {a} {k} {i}.
(Monad m, CSV a [a], IsString a) =>
Map k a -> ConduitT i a m ()
push
  where
    push :: Map k a -> ConduitT i a m ()
push Map k a
r = (a -> ConduitT i a m ()) -> [a] -> ConduitT i a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [CSVSettings -> [a] -> a
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), a
"\n"]

fromCSVMapOrdered :: (Monad m, IsString s, CSV s [a])
                  => CSVSettings -> ConduitM (MO.OMap k a) s m ()
fromCSVMapOrdered :: forall (m :: * -> *) s a k.
(Monad m, IsString s, CSV s [a]) =>
CSVSettings -> ConduitM (OMap k a) s m ()
fromCSVMapOrdered CSVSettings
set = (OMap k a -> ConduitT (OMap k a) s m ())
-> ConduitT (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 -> ConduitT (OMap k a) s m ()
forall {m :: * -> *} {a} {b} {a} {i}.
(Monad m, CSV a [b], IsString a) =>
OMap a b -> ConduitT i a m ()
push
  where
    push :: OMap a b -> ConduitT i a m ()
push OMap a b
r = (a -> ConduitT i a m ()) -> [a] -> ConduitT i a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [CSVSettings -> [b] -> a
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), a
"\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 :: forall (m :: * -> *) s r.
(Monad m, CSV s (Row r), IsString s) =>
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 o. Monad m => ConduitT i o m (Maybe i)
await
  case Maybe (MapRow r)
mrow of
    Maybe (MapRow r)
Nothing -> () -> ConduitM (MapRow r) s m ()
forall a. a -> ConduitT (MapRow r) s m a
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 -> Row r -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (MapRow r -> Row r
forall k a. Map k a -> [k]
M.keys MapRow r
row)
                            , s
"\n"
                            , CSVSettings -> Row r -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (MapRow r -> Row 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 :: forall (m :: * -> *) s r.
(Monad m, CSV s (Row r), IsString s) =>
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 o. Monad m => ConduitT i o m (Maybe i)
await
  case Maybe (OrderedMapRow r)
mrow of
    Maybe (OrderedMapRow r)
Nothing -> () -> ConduitM (OrderedMapRow r) s m ()
forall a. a -> ConduitT (OrderedMapRow r) s m a
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 -> Row r -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (((r, r) -> r) -> [(r, r)] -> Row r
forall a b. (a -> b) -> [a] -> [b]
map (r, r) -> r
forall a b. (a, b) -> a
fst ([(r, r)] -> Row r) -> [(r, r)] -> Row 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 -> Row r -> s
forall s r. CSV s r => CSVSettings -> r -> s
rowToStr CSVSettings
set (((r, r) -> r) -> [(r, r)] -> Row r
forall a b. (a -> b) -> [a] -> [b]
map (r, r) -> r
forall a b. (a, b) -> b
snd ([(r, r)] -> Row r) -> [(r, r)] -> Row 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 :: forall (m :: * -> *) a.
(MonadIO m, CSV ByteString a) =>
CSVSettings -> String -> m (Vector a)
readCSVFile CSVSettings
set String
fp = IO (Vector a) -> m (Vector a)
forall a. IO a -> m 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) ()
-> ConduitT ByteString Void (ResourceT IO) (Vector a)
-> ConduitT () Void (ResourceT IO) (Vector a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitM ByteString a (ResourceT IO) ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM ByteString a m ()
intoCSV CSVSettings
set ConduitM ByteString a (ResourceT IO) ()
-> ConduitT a Void (ResourceT IO) (Vector a)
-> ConduitT ByteString Void (ResourceT IO) (Vector a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (forall a. IO a -> ResourceT IO a)
-> ConduitT a Void IO (Vector a)
-> ConduitT 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 IO a -> ResourceT IO a
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => m a -> ResourceT m 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 :: forall (v :: * -> *) a s.
(Vector v a, CSV s a) =>
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 :: forall s1. ConduitM () s (ExceptT SomeException (ST s1)) ()
src = [s] -> ConduitT () 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 :: forall s1. 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)) ()
-> ConduitT 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' :: forall s1. 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 ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s a m ()
intoCSV CSVSettings
set
    growthFactor :: Int
growthFactor = Int
10
    sink :: ConduitM a Void.Void (ExceptT SomeException (ST s1)) (v a)
    sink :: forall s1. 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 :: forall s1. 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)) ()
-> ConduitT s Void (ExceptT SomeException (ST s1)) (v a)
-> ConduitT () Void (ExceptT SomeException (ST s1)) (v a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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)) ()
-> ConduitT a Void (ExceptT SomeException (ST s1)) (v a)
-> ConduitT s Void (ExceptT SomeException (ST s1)) (v a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT 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 :: forall a.
CSV ByteString a =>
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) ()
-> ConduitT a Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| CSVSettings -> ConduitM a ByteString (ResourceT IO) ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *).
Monad m =>
CSVSettings -> ConduitM a ByteString m ()
fromCSV CSVSettings
set ConduitM a ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) ()
-> ConduitT a Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
    IO Handle -> ConduitT 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 :: forall (m :: * -> *) a b.
(MonadResource m, CSV ByteString a, CSV ByteString b,
 MonadThrow m) =>
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 :: 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 = 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' :: 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
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 () -> ConduitT s Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
    CSVSettings -> ConduitM s a m ()
forall s r (m :: * -> *).
(CSV s r, MonadThrow m) =>
CSVSettings -> ConduitM s r m ()
forall (m :: * -> *).
MonadThrow m =>
CSVSettings -> ConduitM s a m ()
intoCSV CSVSettings
setIn ConduitM s a m () -> ConduitT a Void m () -> ConduitT s Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
    ConduitM a b m ()
c ConduitM a b m () -> ConduitT b Void m () -> ConduitT a Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
    CSVSettings -> ConduitM b s' m ()
forall s r (m :: * -> *).
(CSV s r, Monad m) =>
CSVSettings -> ConduitM r s m ()
forall (m :: * -> *). Monad m => CSVSettings -> ConduitM b s' m ()
fromCSV CSVSettings
setOut ConduitM b s' m () -> ConduitM s' Void m () -> ConduitT b Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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 :: forall (m :: * -> *) (v :: * -> *) a o.
(PrimMonad m, Vector v a) =>
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 (m :: * -> *) a. Monad m => m a -> ConduitT a o 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.
(HasCallStack, 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 o. Monad m => ConduitT i o 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 (m :: * -> *) a. Monad m => m a -> ConduitT a o m 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.
(HasCallStack, 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 a. a -> ConduitT a o m 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 (m :: * -> *) a. Monad m => m a -> ConduitT a o 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.
(HasCallStack, 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 a. a -> ConduitT a o m a
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable v (PrimState m) a
v
            m () -> ConduitT a o m ()
forall (m :: * -> *) a. Monad m => m a -> ConduitT a o m a
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.
(HasCallStack, 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'