{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Frames.Streamly.CSV
(
readTable
, readTableOpt
, readTableMaybe
, readTableMaybeOpt
, readTableEither
, readTableEitherOpt
, streamTable
, streamTableOpt
, streamTableMaybe
, streamTableMaybeOpt
, streamTableEither
, streamTableEitherOpt
, streamToCSV
, streamCSV
, streamToSV
, streamSV
, streamSV'
, writeCSV
, writeSV
, writeStreamSV
, writeCSV_Show
, writeSV_Show
, writeStreamSV_Show
, streamToList
, liftFieldFormatter
, liftFieldFormatter1
, formatTextAsIs
, formatWithShow
, formatWithShowCSV
, writeLines
, writeLines'
, word8ToTextLines
)
where
import qualified Streamly.Prelude as Streamly
import qualified Streamly as Streamly
import Streamly ( IsStream )
import qualified Streamly.Data.Fold as Streamly.Fold
import qualified Streamly.Data.Unicode.Stream as Streamly.Unicode
import qualified Streamly.Internal.FileSystem.File as Streamly.File
import qualified Streamly.Internal.Data.Unfold as Streamly.Unfold
import Control.Monad.Catch ( MonadCatch )
import Control.Monad.IO.Class ( MonadIO )
import Data.Maybe (isNothing)
import qualified Data.Text as T
import qualified Data.Vinyl as Vinyl
import qualified Data.Vinyl.Functor as Vinyl
import qualified Data.Vinyl.TypeLevel as Vinyl
import qualified Data.Vinyl.Class.Method as Vinyl
import Data.Word ( Word8 )
import qualified Frames as Frames
import qualified Frames.CSV as Frames
import qualified Frames.ShowCSV as Frames
import Data.Proxy (Proxy (..))
streamToSV
:: forall rs m t.
( Frames.ColumnHeaders rs
, Monad m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, IsStream t
)
=> T.Text
-> t m (Frames.Record rs)
-> t m T.Text
streamToSV = streamSVClass @Frames.ShowCSV Frames.showCSV
{-# INLINEABLE streamToSV #-}
streamToCSV
:: forall rs m t
. ( Frames.ColumnHeaders rs
, Monad m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, IsStream t
)
=> t m (Frames.Record rs)
-> t m T.Text
streamToCSV = streamToSV ","
{-# INLINEABLE streamToCSV #-}
streamSV
:: forall f rs m t.
( Frames.ColumnHeaders rs
, Foldable f
, Monad m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, IsStream t
)
=> T.Text
-> f (Frames.Record rs)
-> t m T.Text
streamSV sep = streamToSV sep . Streamly.fromFoldable
{-# INLINEABLE streamSV #-}
streamCSV
:: forall f rs m t.
( Frames.ColumnHeaders rs
, Foldable f
, Monad m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, IsStream t
)
=> f (Frames.Record rs)
-> t m T.Text
streamCSV = streamSV ","
streamSVClass
:: forall c rs t m .
( Vinyl.RecMapMethod c Vinyl.ElField rs
, Vinyl.RecordToList rs
, Frames.ColumnHeaders rs
, IsStream t
, Monad m
)
=> (forall a. c a => a -> T.Text)
-> T.Text
-> t m (Frames.Record rs)
-> t m T.Text
streamSVClass toText sep s =
(T.intercalate sep . fmap T.pack $ Frames.columnHeaders (Proxy :: Proxy (Frames.Record rs)))
`Streamly.cons`
(Streamly.map (T.intercalate sep . Vinyl.recordToList . Vinyl.rmapMethod @c aux) s)
where
aux :: (c (Vinyl.PayloadType Vinyl.ElField a))
=> Vinyl.ElField a
-> Vinyl.Const T.Text a
aux (Vinyl.Field x) = Vinyl.Const $ toText x
streamSV'
:: forall rs t m f.
(Vinyl.RecordToList rs
, Vinyl.RApply rs
, Frames.ColumnHeaders rs
, IsStream t
, Monad m
)
=> Vinyl.Rec (Vinyl.Lift (->) f (Vinyl.Const T.Text)) rs
-> T.Text
-> t m (Frames.Rec f rs)
-> t m T.Text
streamSV' toTextRec sep s =
(T.intercalate sep . fmap T.pack $ Frames.columnHeaders (Proxy :: Proxy (Frames.Record rs)))
`Streamly.cons`
(Streamly.map (T.intercalate sep . Vinyl.recordToList . Vinyl.rapply toTextRec) s)
{-# INLINEABLE streamSV' #-}
streamToList :: (IsStream t, Monad m) => t m a -> m [a]
streamToList = Streamly.toList . Streamly.adapt
liftFieldFormatter :: Vinyl.KnownField t
=> (Vinyl.Snd t -> T.Text)
-> Vinyl.Lift (->) Vinyl.ElField (Vinyl.Const T.Text) t
liftFieldFormatter toText = Vinyl.Lift $ Vinyl.Const . toText . Vinyl.getField
{-# INLINEABLE liftFieldFormatter #-}
liftFieldFormatter1 :: (Functor f, Vinyl.KnownField t)
=> (f (Vinyl.Snd t) -> T.Text)
-> Vinyl.Lift (->) (f Vinyl.:. Vinyl.ElField) (Vinyl.Const T.Text) t
liftFieldFormatter1 toText = Vinyl.Lift $ Vinyl.Const . toText . fmap Vinyl.getField . Vinyl.getCompose
{-# INLINEABLE liftFieldFormatter1 #-}
formatTextAsIs :: (Vinyl.KnownField t, Vinyl.Snd t ~ T.Text) => Vinyl.Lift (->) Vinyl.ElField (Vinyl.Const T.Text) t
formatTextAsIs = liftFieldFormatter id
{-# INLINE formatTextAsIs #-}
formatWithShow :: (Vinyl.KnownField t, Show (Vinyl.Snd t)) => Vinyl.Lift (->) Vinyl.ElField (Vinyl.Const T.Text) t
formatWithShow = liftFieldFormatter $ T.pack . show
{-# INLINE formatWithShow #-}
formatWithShowCSV :: (Vinyl.KnownField t, Frames.ShowCSV (Vinyl.Snd t)) => Vinyl.Lift (->) Vinyl.ElField (Vinyl.Const T.Text) t
formatWithShowCSV = liftFieldFormatter Frames.showCSV
{-# INLINE formatWithShowCSV #-}
writeLines' :: (Streamly.MonadAsync m, MonadCatch m, Streamly.IsStream t) => FilePath -> t m T.Text -> m ()
writeLines' fp s = do
Streamly.fold (Streamly.File.write fp)
$ Streamly.Unicode.encodeUtf8
$ Streamly.adapt
$ Streamly.concatUnfold Streamly.Unfold.fromList
$ Streamly.map T.unpack
$ Streamly.intersperse "\n" s
{-# INLINEABLE writeLines' #-}
writeLines :: (Streamly.MonadAsync m, MonadCatch m) => FilePath -> Streamly.SerialT m T.Text -> m ()
writeLines = writeLines'
{-# INLINE writeLines #-}
writeStreamSV
:: forall rs m t.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, IsStream t
, Streamly.MonadAsync m
)
=> T.Text
-> FilePath
-> t m (Frames.Record rs)
-> m ()
writeStreamSV sep fp = writeLines' fp . streamToSV sep
{-# INLINEABLE writeStreamSV #-}
writeSV
:: forall rs m f.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, Streamly.MonadAsync m
, Foldable f
)
=> T.Text
-> FilePath
-> f (Frames.Record rs)
-> m ()
writeSV sep fp = writeStreamSV sep fp . Streamly.fromFoldable @Streamly.AheadT
{-# INLINEABLE writeSV #-}
writeCSV
:: forall rs m f.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Frames.ShowCSV Vinyl.ElField rs
, Streamly.MonadAsync m
, Foldable f
)
=> FilePath
-> f (Frames.Record rs)
-> m ()
writeCSV fp = writeSV "," fp
{-# INLINEABLE writeCSV #-}
writeStreamSV_Show
:: forall rs m t.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Show Vinyl.ElField rs
, IsStream t
, Streamly.MonadAsync m
)
=> T.Text
-> FilePath
-> t m (Frames.Record rs)
-> m ()
writeStreamSV_Show sep fp = writeLines' fp . streamSVClass @Show (T.pack . show) sep
{-# INLINEABLE writeStreamSV_Show #-}
writeSV_Show
:: forall rs m f.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Show Vinyl.ElField rs
, Streamly.MonadAsync m
, Foldable f
)
=> T.Text
-> FilePath
-> f (Frames.Record rs)
-> m ()
writeSV_Show sep fp = writeStreamSV_Show sep fp . Streamly.fromFoldable @Streamly.AheadT
{-# INLINEABLE writeSV_Show #-}
writeCSV_Show
:: forall rs m f.
( Frames.ColumnHeaders rs
, MonadCatch m
, Vinyl.RecordToList rs
, Vinyl.RecMapMethod Show Vinyl.ElField rs
, Streamly.MonadAsync m
, Foldable f
)
=> FilePath
-> f (Frames.Record rs)
-> m ()
writeCSV_Show fp = writeSV_Show "," fp
{-# INLINEABLE writeCSV_Show #-}
readTableMaybe
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> FilePath
-> t m (Vinyl.Rec (Maybe Vinyl.:. Vinyl.ElField) rs)
readTableMaybe = readTableMaybeOpt Frames.defaultParser
{-# INLINEABLE readTableMaybe #-}
readTableMaybeOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> Frames.ParserOptions
-> FilePath
-> t m (Vinyl.Rec (Maybe Vinyl.:. Vinyl.ElField) rs)
readTableMaybeOpt opts = Streamly.map recEitherToMaybe . readTableEitherOpt opts
{-# INLINEABLE readTableMaybeOpt #-}
readTableEither
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> FilePath
-> t m (Vinyl.Rec (Either T.Text Vinyl.:. Vinyl.ElField) rs)
readTableEither = readTableEitherOpt Frames.defaultParser
readTableEitherOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> Frames.ParserOptions
-> FilePath
-> t m (Vinyl.Rec (Either T.Text Vinyl.:. Vinyl.ElField) rs)
readTableEitherOpt opts = streamTableEitherOpt opts . word8ToTextLines . Streamly.File.toBytes
{-# INLINEABLE readTableEitherOpt #-}
readTable
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> FilePath
-> t m (Frames.Record rs)
readTable = readTableOpt Frames.defaultParser
{-# INLINEABLE readTable #-}
readTableOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
, MonadCatch m)
=> Frames.ParserOptions
-> FilePath
-> t m (Frames.Record rs)
readTableOpt opts = streamTableOpt opts . word8ToTextLines . Streamly.File.toBytes
{-# INLINEABLE readTableOpt #-}
streamTableEither
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs)
=> t m T.Text
-> t m (Vinyl.Rec ((Either T.Text) Vinyl.:. Vinyl.ElField) rs)
streamTableEither = streamTableEitherOpt Frames.defaultParser
{-# INLINEABLE streamTableEither #-}
streamTableEitherOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs)
=> Frames.ParserOptions
-> t m T.Text
-> t m (Vinyl.Rec ((Either T.Text) Vinyl.:. Vinyl.ElField) rs)
streamTableEitherOpt opts =
Streamly.map (doParse . Frames.tokenizeRow opts)
. handleHeader
where
handleHeader | isNothing (Frames.headerOverride opts) = Streamly.drop 1
| otherwise = id
doParse = Frames.readRec
{-# INLINEABLE streamTableEitherOpt #-}
streamTableMaybe
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs)
=> t m T.Text
-> t m (Vinyl.Rec (Maybe Vinyl.:. Vinyl.ElField) rs)
streamTableMaybe = streamTableMaybeOpt Frames.defaultParser
{-# INLINEABLE streamTableMaybe #-}
streamTableMaybeOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs)
=> Frames.ParserOptions
-> t m T.Text
-> t m (Vinyl.Rec (Maybe Vinyl.:. Vinyl.ElField) rs)
streamTableMaybeOpt opts = Streamly.map recEitherToMaybe . streamTableEitherOpt opts
{-# INLINEABLE streamTableMaybeOpt #-}
streamTable
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
)
=> t m T.Text
-> t m (Frames.Record rs)
streamTable = streamTableOpt Frames.defaultParser
{-# INLINEABLE streamTable #-}
streamTableOpt
:: forall rs t m.
(MonadIO m
, IsStream t
, Vinyl.RMap rs
, Frames.ReadRec rs
)
=> Frames.ParserOptions
-> t m T.Text
-> t m (Frames.Record rs)
streamTableOpt opts =
Streamly.mapMaybe (Frames.recMaybe . doParse . Frames.tokenizeRow opts)
. handleHeader
where
handleHeader | isNothing (Frames.headerOverride opts) = Streamly.drop 1
| otherwise = id
doParse = recEitherToMaybe . Frames.readRec
{-# INLINE streamTableOpt #-}
recEitherToMaybe :: Vinyl.RMap rs => Vinyl.Rec (Either T.Text Vinyl.:. Vinyl.ElField) rs -> Vinyl.Rec (Maybe Vinyl.:. Vinyl.ElField) rs
recEitherToMaybe = Vinyl.rmap (either (const (Vinyl.Compose Nothing)) (Vinyl.Compose . Just) . Vinyl.getCompose)
{-# INLINE recEitherToMaybe #-}
word8ToTextLines :: (IsStream t, Monad m) => t m Word8 -> t m T.Text
word8ToTextLines = Streamly.splitOnSuffix (== '\n') (fmap T.pack $ Streamly.Fold.toList)
. Streamly.Unicode.decodeUtf8
{-# INLINE word8ToTextLines #-}