{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Frames.CSV where
import Control.Exception (IOException, try)
import Control.Monad (unless, when)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Foldable as F
import Data.List (intercalate)
import Data.Maybe (fromMaybe, isNothing)
#if __GLASGOW_HASKELL__ < 808
import Data.Monoid ((<>))
#endif
import Data.Proxy
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Vinyl (ElField (..), RMap, Rec (..), RecMapMethod, RecordToList, recordToList, rmap, rmapMethod)
import Data.Vinyl.Class.Method (PayloadType)
import Data.Vinyl.Functor (Compose (..), Const (..), (:.))
import Frames.Col
import Frames.ColumnTypeable
import Frames.Rec
import Frames.RecF
import Frames.ShowCSV
import GHC.TypeLits (KnownSymbol)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Parse as P
import qualified Pipes.Prelude as P
import qualified Pipes.Safe as P
import qualified Pipes.Safe.Prelude as Safe
import System.IO (Handle, IOMode (ReadMode, WriteMode), hPrint, stderr)
type Separator = T.Text
type QuoteChar = Char
data QuotingMode
=
NoQuoting
|
RFC4180Quoting QuoteChar
deriving (QuotingMode -> QuotingMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuotingMode -> QuotingMode -> Bool
$c/= :: QuotingMode -> QuotingMode -> Bool
== :: QuotingMode -> QuotingMode -> Bool
$c== :: QuotingMode -> QuotingMode -> Bool
Eq, Int -> QuotingMode -> ShowS
[QuotingMode] -> ShowS
QuotingMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuotingMode] -> ShowS
$cshowList :: [QuotingMode] -> ShowS
show :: QuotingMode -> String
$cshow :: QuotingMode -> String
showsPrec :: Int -> QuotingMode -> ShowS
$cshowsPrec :: Int -> QuotingMode -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => QuotingMode -> m Exp
forall (m :: * -> *). Quote m => QuotingMode -> Code m QuotingMode
liftTyped :: forall (m :: * -> *). Quote m => QuotingMode -> Code m QuotingMode
$cliftTyped :: forall (m :: * -> *). Quote m => QuotingMode -> Code m QuotingMode
lift :: forall (m :: * -> *). Quote m => QuotingMode -> m Exp
$clift :: forall (m :: * -> *). Quote m => QuotingMode -> m Exp
Lift)
data ParserOptions = ParserOptions
{ :: Maybe [T.Text]
, ParserOptions -> Text
columnSeparator :: Separator
, ParserOptions -> QuotingMode
quotingMode :: QuotingMode
}
deriving (ParserOptions -> ParserOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserOptions -> ParserOptions -> Bool
$c/= :: ParserOptions -> ParserOptions -> Bool
== :: ParserOptions -> ParserOptions -> Bool
$c== :: ParserOptions -> ParserOptions -> Bool
Eq, Int -> ParserOptions -> ShowS
[ParserOptions] -> ShowS
ParserOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserOptions] -> ShowS
$cshowList :: [ParserOptions] -> ShowS
show :: ParserOptions -> String
$cshow :: ParserOptions -> String
showsPrec :: Int -> ParserOptions -> ShowS
$cshowsPrec :: Int -> ParserOptions -> ShowS
Show)
instance Lift ParserOptions where
lift :: forall (m :: * -> *). Quote m => ParserOptions -> m Exp
lift (ParserOptions Maybe [Text]
Nothing Text
sep QuotingMode
quoting) = [|ParserOptions Nothing $sep' $quoting'|]
where
sep' :: m Exp
sep' = [|T.pack $(stringE $ T.unpack sep)|]
quoting' :: m Exp
quoting' = forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift QuotingMode
quoting
lift (ParserOptions (Just [Text]
hs) Text
sep QuotingMode
quoting) = [|ParserOptions (Just $hs') $sep' $quoting'|]
where
sep' :: m Exp
sep' = [|T.pack $(stringE $ T.unpack sep)|]
hs' :: m Exp
hs' = [|map T.pack $(listE $ map (stringE . T.unpack) hs)|]
quoting' :: m Exp
quoting' = forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift QuotingMode
quoting
#if MIN_VERSION_template_haskell(2,16,0)
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *).
Quote m =>
ParserOptions -> Code m ParserOptions
liftTyped = forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#else
liftTyped = unsafeTExpCoerce . lift
#endif
#endif
defaultParser :: ParserOptions
defaultParser :: ParserOptions
defaultParser = Maybe [Text] -> Text -> QuotingMode -> ParserOptions
ParserOptions forall a. Maybe a
Nothing Text
defaultSep (Char -> QuotingMode
RFC4180Quoting Char
'\"')
defaultSep :: Separator
defaultSep :: Text
defaultSep = String -> Text
T.pack String
","
tokenizeRow :: ParserOptions -> T.Text -> [T.Text]
tokenizeRow :: ParserOptions -> Text -> [Text]
tokenizeRow ParserOptions
options = [Text] -> [Text]
handleQuoting forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
sep
where
sep :: Text
sep = ParserOptions -> Text
columnSeparator ParserOptions
options
quoting :: QuotingMode
quoting = ParserOptions -> QuotingMode
quotingMode ParserOptions
options
handleQuoting :: [Text] -> [Text]
handleQuoting = case QuotingMode
quoting of
QuotingMode
NoQuoting -> forall a. a -> a
id
RFC4180Quoting Char
quote -> Text -> Char -> [Text] -> [Text]
reassembleRFC4180QuotedParts Text
sep Char
quote
reassembleRFC4180QuotedParts :: Separator -> QuoteChar -> [T.Text] -> [T.Text]
reassembleRFC4180QuotedParts :: Text -> Char -> [Text] -> [Text]
reassembleRFC4180QuotedParts Text
sep Char
quoteChar = [Text] -> [Text]
go
where
go :: [Text] -> [Text]
go [] = []
go (Text
part : [Text]
parts)
| Text -> Bool
T.null Text
part = Text
T.empty forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
parts
| Text -> Bool
prefixQuoted Text
part =
if Text -> Bool
suffixQuoted Text
part
then Text -> Text
unescape (Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 forall a b. (a -> b) -> a -> b
$ Text
part) forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
parts
else case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
suffixQuoted [Text]
parts of
([Text]
h, []) -> [Text -> Text
unescape (Text -> [Text] -> Text
T.intercalate Text
sep (Int -> Text -> Text
T.drop Int
1 Text
part forall a. a -> [a] -> [a]
: [Text]
h))]
([Text]
h, Text
t : [Text]
ts) ->
Text -> Text
unescape
( Text -> [Text] -> Text
T.intercalate
Text
sep
(Int -> Text -> Text
T.drop Int
1 Text
part forall a. a -> [a] -> [a]
: [Text]
h forall a. [a] -> [a] -> [a]
++ [Int -> Text -> Text
T.dropEnd Int
1 Text
t])
)
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ts
| Bool
otherwise = Text -> Text
T.strip Text
part forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
parts
prefixQuoted :: Text -> Bool
prefixQuoted Text
t =
Text -> Char
T.head Text
t forall a. Eq a => a -> a -> Bool
== Char
quoteChar
suffixQuoted :: Text -> Bool
suffixQuoted Text
t =
Text
quoteText Text -> Text -> Bool
`T.isSuffixOf` Text
t
quoteText :: Text
quoteText = Char -> Text
T.singleton Char
quoteChar
unescape :: T.Text -> T.Text
unescape :: Text -> Text
unescape = Text -> Text -> Text -> Text
T.replace Text
q2 Text
quoteText
where
q2 :: Text
q2 = Text
quoteText forall a. Semigroup a => a -> a -> a
<> Text
quoteText
prefixInference ::
(ColumnTypeable a, Semigroup a, Monad m, Show a) =>
P.Parser [T.Text] m [a]
prefixInference :: forall a (m :: * -> *).
(ColumnTypeable a, Semigroup a, Monad m, Show a) =>
Parser [Text] m [a]
prefixInference =
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
P.draw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [Text]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [Text]
row1 ->
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Parser a m b
P.foldAll
(\[a]
ts -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Semigroup a => a -> a -> a
(<>) [a]
ts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [a]
inferCols)
([Text] -> [a]
inferCols [Text]
row1)
forall a. a -> a
id
where
inferCols :: [Text] -> [a]
inferCols = forall a b. (a -> b) -> [a] -> [b]
map forall a. ColumnTypeable a => Text -> a
inferType
readColHeaders ::
(ColumnTypeable a, Semigroup a, Monad m, Show a) =>
ParserOptions
-> P.Producer [T.Text] m ()
-> m [(T.Text, a)]
ParserOptions
opts = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
P.evalStateT forall a b. (a -> b) -> a -> b
$
do
[Text]
headerRow <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
P.draw)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ParserOptions -> Maybe [Text]
headerOverride ParserOptions
opts)
[a]
colTypes <- forall a (m :: * -> *).
(ColumnTypeable a, Semigroup a, Monad m, Show a) =>
Parser [Text] m [a]
prefixInference
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
headerRow forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
colTypes) (forall a. HasCallStack => String -> a
error String
errNumColumns)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
headerRow [a]
colTypes)
where
err :: a
err = forall a. HasCallStack => String -> a
error String
"Empty Producer has no header row"
errNumColumns :: String
errNumColumns =
[String] -> String
unlines
[ String
""
, String
"Error parsing CSV: "
, String
" Number of columns in header differs from number of columns"
, String
" found in the remaining file. This may be due to newlines"
, String
" being present within the data itself (not just separating"
, String
" rows). If support for embedded newlines is required, "
, String
" consider using the Frames-dsv package in conjunction with"
, String
" Frames to make use of a different CSV parser."
]
class ReadRec rs where
readRec :: [T.Text] -> Rec (Either T.Text :. ElField) rs
instance ReadRec '[] where
readRec :: [Text] -> Rec (Either Text :. ElField) '[]
readRec [Text]
_ = forall {u} (a :: u -> *). Rec a '[]
RNil
instance (Parseable t, ReadRec ts, KnownSymbol s) => ReadRec (s :-> t ': ts) where
readRec :: [Text] -> Rec (Either Text :. ElField) ((s :-> t) : ts)
readRec [] = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall a b. a -> Either a b
Left forall a. Monoid a => a
mempty) forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall (rs :: [(Symbol, *)]).
ReadRec rs =>
[Text] -> Rec (Either Text :. ElField) rs
readRec []
readRec (Text
h : [Text]
t) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall a b. a -> Either a b
Left (Text -> Text
T.copy Text
h)))
(forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (Symbol, *)). Snd t -> ElField t
Field)
(forall (m :: * -> *) a. (MonadPlus m, Parseable a) => Text -> m a
parse' Text
h)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall (rs :: [(Symbol, *)]).
ReadRec rs =>
[Text] -> Rec (Either Text :. ElField) rs
readRec [Text]
t
pipeLines ::
(P.MonadSafe m) =>
(Handle -> IO (Either IOException T.Text))
-> FilePath
-> P.Producer T.Text m ()
pipeLines :: forall (m :: * -> *).
MonadSafe m =>
(Handle -> IO (Either IOException Text))
-> String -> Producer Text m ()
pipeLines Handle -> IO (Either IOException Text)
pgetLine String
fp = forall (m :: * -> *) r.
MonadSafe m =>
String -> IOMode -> (Handle -> m r) -> m r
Safe.withFile String
fp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
let loop :: Proxy X () () Text m ()
loop = do
Either IOException Text
txt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (Handle -> IO (Either IOException Text)
pgetLine Handle
h)
case Either IOException Text
txt of
Left IOException
_e -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right Text
y -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield Text
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy X () () Text m ()
loop
in Proxy X () () Text m ()
loop
produceTextLines :: (P.MonadSafe m) => FilePath -> P.Producer T.Text m ()
produceTextLines :: forall (m :: * -> *). MonadSafe m => String -> Producer Text m ()
produceTextLines = forall (m :: * -> *).
MonadSafe m =>
(Handle -> IO (Either IOException Text))
-> String -> Producer Text m ()
pipeLines (forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Text
T.hGetLine)
produceTokens ::
(P.MonadSafe m) =>
FilePath
-> Separator
-> P.Producer [T.Text] m ()
produceTokens :: forall (m :: * -> *).
MonadSafe m =>
String -> Text -> Producer [Text] m ()
produceTokens String
fp Text
sep = forall (m :: * -> *). MonadSafe m => String -> Producer Text m ()
produceTextLines String
fp forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map Text -> [Text]
tokenize
where
tokenize :: Text -> [Text]
tokenize = ParserOptions -> Text -> [Text]
tokenizeRow ParserOptions
popts
popts :: ParserOptions
popts = ParserOptions
defaultParser{columnSeparator :: Text
columnSeparator = Text
sep}
consumeTextLines :: (P.MonadSafe m) => FilePath -> P.Consumer T.Text m r
consumeTextLines :: forall (m :: * -> *) r. MonadSafe m => String -> Consumer Text m r
consumeTextLines String
fp = forall (m :: * -> *) r.
MonadSafe m =>
String -> IOMode -> (Handle -> m r) -> m r
Safe.withFile String
fp IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
let loop :: Proxy () Text () X m r
loop = forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy () Text () X m r
loop
in Proxy () Text () X m r
loop
readFileLatin1Ln :: (P.MonadSafe m) => FilePath -> P.Producer [T.Text] m ()
readFileLatin1Ln :: forall (m :: * -> *). MonadSafe m => String -> Producer [Text] m ()
readFileLatin1Ln String
fp =
forall (m :: * -> *).
MonadSafe m =>
(Handle -> IO (Either IOException Text))
-> String -> Producer Text m ()
pipeLines (forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
T.decodeLatin1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B8.hGetLine) String
fp
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (ParserOptions -> Text -> [Text]
tokenizeRow ParserOptions
defaultParser)
readRow ::
(ReadRec rs) =>
ParserOptions
-> T.Text
-> Rec (Either T.Text :. ElField) rs
readRow :: forall (rs :: [(Symbol, *)]).
ReadRec rs =>
ParserOptions -> Text -> Rec (Either Text :. ElField) rs
readRow = (forall (rs :: [(Symbol, *)]).
ReadRec rs =>
[Text] -> Rec (Either Text :. ElField) rs
readRec forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserOptions -> Text -> [Text]
tokenizeRow
readTableMaybeOpt ::
(P.MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions
-> FilePath
-> P.Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybeOpt :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions
-> String -> Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybeOpt ParserOptions
opts String
csvFile =
forall (m :: * -> *).
MonadSafe m =>
String -> Text -> Producer [Text] m ()
produceTokens String
csvFile (ParserOptions -> Text
columnSeparator ParserOptions
opts) forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs, RMap rs) =>
ParserOptions -> Pipe [Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybeOpt ParserOptions
opts
pipeTableMaybeOpt ::
(Monad m, ReadRec rs, RMap rs) =>
ParserOptions
-> P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybeOpt :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs, RMap rs) =>
ParserOptions -> Pipe [Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybeOpt ParserOptions
opts = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (ParserOptions -> Maybe [Text]
headerOverride ParserOptions
opts)) (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await)
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map
( forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap
( forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(forall a b. a -> b -> a
const (forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall a. Maybe a
Nothing))
(forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rs :: [(Symbol, *)]).
ReadRec rs =>
[Text] -> Rec (Either Text :. ElField) rs
readRec
)
pipeTableEitherOpt ::
(Monad m, ReadRec rs) =>
ParserOptions
-> P.Pipe T.Text (Rec (Either T.Text :. ElField) rs) m ()
pipeTableEitherOpt :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs) =>
ParserOptions -> Pipe Text (Rec (Either Text :. ElField) rs) m ()
pipeTableEitherOpt ParserOptions
opts = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (ParserOptions -> Maybe [Text]
headerOverride ParserOptions
opts)) (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await)
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (forall (rs :: [(Symbol, *)]).
ReadRec rs =>
ParserOptions -> Text -> Rec (Either Text :. ElField) rs
readRow ParserOptions
opts)
readTableMaybe ::
(P.MonadSafe m, ReadRec rs, RMap rs) =>
FilePath
-> P.Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybe :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
String -> Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybe = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions
-> String -> Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybeOpt ParserOptions
defaultParser
pipeTableMaybe ::
(Monad m, ReadRec rs, RMap rs) =>
P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybe :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs, RMap rs) =>
Pipe [Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybe = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs, RMap rs) =>
ParserOptions -> Pipe [Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybeOpt ParserOptions
defaultParser
pipeTableEither ::
(Monad m, ReadRec rs) =>
P.Pipe T.Text (Rec (Either T.Text :. ElField) rs) m ()
pipeTableEither :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs) =>
Pipe Text (Rec (Either Text :. ElField) rs) m ()
pipeTableEither = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs) =>
ParserOptions -> Pipe Text (Rec (Either Text :. ElField) rs) m ()
pipeTableEitherOpt ParserOptions
defaultParser
readTableOpt ::
(P.MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions
-> FilePath
-> P.Producer (Record rs) m ()
readTableOpt :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions -> String -> Producer (Record rs) m ()
readTableOpt ParserOptions
opts String
csvFile = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions
-> String -> Producer (Rec (Maybe :. ElField) rs) m ()
readTableMaybeOpt ParserOptions
opts String
csvFile forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
P.>-> forall {cs :: [(Symbol, *)]} {b}.
Proxy () (Rec (Maybe :. ElField) cs) () (Record cs) m b
go
where
go :: Proxy () (Rec (Maybe :. ElField) cs) () (Record cs) m b
go = forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Proxy () (Rec (Maybe :. ElField) cs) () (Record cs) m b
go (\Record cs
x -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield Record cs
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy () (Rec (Maybe :. ElField) cs) () (Record cs) m b
go) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cs :: [(Symbol, *)]).
Rec (Maybe :. ElField) cs -> Maybe (Record cs)
recMaybe
pipeTableOpt ::
(ReadRec rs, RMap rs, Monad m) =>
ParserOptions
-> P.Pipe [T.Text] (Record rs) m ()
pipeTableOpt :: forall (rs :: [(Symbol, *)]) (m :: * -> *).
(ReadRec rs, RMap rs, Monad m) =>
ParserOptions -> Pipe [Text] (Record rs) m ()
pipeTableOpt ParserOptions
opts = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(Monad m, ReadRec rs, RMap rs) =>
ParserOptions -> Pipe [Text] (Rec (Maybe :. ElField) rs) m ()
pipeTableMaybeOpt ParserOptions
opts forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map forall (cs :: [(Symbol, *)]).
Rec (Maybe :. ElField) cs -> Maybe (Record cs)
recMaybe forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) (f :: * -> *) a r.
(Functor m, Foldable f) =>
Pipe (f a) a m r
P.concat
readTable ::
(P.MonadSafe m, ReadRec rs, RMap rs) =>
FilePath
-> P.Producer (Record rs) m ()
readTable :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
String -> Producer (Record rs) m ()
readTable = forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs) =>
ParserOptions -> String -> Producer (Record rs) m ()
readTableOpt ParserOptions
defaultParser
readRecEither ::
(ReadRec rs, RMap rs) =>
[T.Text]
-> Either (Rec (Either T.Text :. ElField) rs) (Record rs)
readRecEither :: forall (rs :: [(Symbol, *)]).
(ReadRec rs, RMap rs) =>
[Text] -> Either (Rec (Either Text :. ElField) rs) (Record rs)
readRecEither [Text]
tokens =
let tmp :: Rec (Either Text :. ElField) rs
tmp = forall (rs :: [(Symbol, *)]).
ReadRec rs =>
[Text] -> Rec (Either Text :. ElField) rs
readRec [Text]
tokens
in case forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose Rec (Either Text :. ElField) rs
tmp of
Right Record rs
r -> forall a b. b -> Either a b
Right Record rs
r
Either Text (Record rs)
_ -> forall a b. a -> Either a b
Left Rec (Either Text :. ElField) rs
tmp
readTableDebug ::
forall m rs.
( P.MonadSafe m
, ReadRec rs
, RMap rs
, RecMapMethod ShowCSV (Either T.Text :. ElField) rs
, RecordToList rs
) =>
FilePath
-> P.Producer (Record rs) m ()
readTableDebug :: forall (m :: * -> *) (rs :: [(Symbol, *)]).
(MonadSafe m, ReadRec rs, RMap rs,
RecMapMethod ShowCSV (Either Text :. ElField) rs,
RecordToList rs) =>
String -> Producer (Record rs) m ()
readTableDebug String
csvFile =
forall (m :: * -> *).
MonadSafe m =>
String -> Text -> Producer [Text] m ()
produceTokens String
csvFile (ParserOptions -> Text
columnSeparator ParserOptions
opts) forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall {b}.
Proxy
()
[Text]
()
(Either (Rec (Either Text :. ElField) rs) (Record rs))
m
b
go forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy
()
(Either (Rec (Either Text :. ElField) rs) (Record rs))
()
(Record rs)
m
()
debugAll
where
opts :: ParserOptions
opts = ParserOptions
defaultParser
go :: Proxy
()
[Text]
()
(Either (Rec (Either Text :. ElField) rs) (Record rs))
m
b
go = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (ParserOptions -> Maybe [Text]
headerOverride ParserOptions
opts)) (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await)
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map forall (rs :: [(Symbol, *)]).
(ReadRec rs, RMap rs) =>
[Text] -> Either (Rec (Either Text :. ElField) rs) (Record rs)
readRecEither
debugAll :: Proxy
()
(Either (Rec (Either Text :. ElField) rs) (Record rs))
()
(Record rs)
m
()
debugAll = do
forall (m :: * -> *) a. Functor m => Consumer' a m a
P.await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (Either Text :. ElField) rs -> [Text]
debugOne) forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield
Proxy
()
(Either (Rec (Either Text :. ElField) rs) (Record rs))
()
(Record rs)
m
()
debugAll
debugOne :: Rec (Either Text :. ElField) rs -> [Text]
debugOne = forall {u} (rs :: [u]) a.
RecordToList rs =>
Rec (Const a) rs -> [a]
recordToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (c :: * -> Constraint) (f :: u -> *) (ts :: [u])
(g :: u -> *).
RecMapMethod c f ts =>
(forall (a :: u). c (PayloadType f a) => f a -> g a)
-> Rec f ts -> Rec g ts
rmapMethod @ShowCSV (forall (a :: (Symbol, *)).
ShowCSV (PayloadType ElField a) =>
Either Text (ElField a) -> Const Text a
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose)
aux ::
(ShowCSV (PayloadType ElField a)) =>
Either T.Text (ElField a)
-> Const T.Text a
aux :: forall (a :: (Symbol, *)).
ShowCSV (PayloadType ElField a) =>
Either Text (ElField a) -> Const Text a
aux (Right (Field Snd a
x)) = forall k a (b :: k). a -> Const a b
Const (Text
"Right " forall a. Semigroup a => a -> a -> a
<> forall a. ShowCSV a => a -> Text
showCSV Snd a
x)
aux (Left Text
txt) = forall k a (b :: k). a -> Const a b
Const (Text
"Left " forall a. Semigroup a => a -> a -> a
<> Text
txt)
pipeTable ::
(ReadRec rs, RMap rs, Monad m) =>
P.Pipe [T.Text] (Record rs) m ()
pipeTable :: forall (rs :: [(Symbol, *)]) (m :: * -> *).
(ReadRec rs, RMap rs, Monad m) =>
Pipe [Text] (Record rs) m ()
pipeTable = forall (rs :: [(Symbol, *)]) (m :: * -> *).
(ReadRec rs, RMap rs, Monad m) =>
ParserOptions -> Pipe [Text] (Record rs) m ()
pipeTableOpt ParserOptions
defaultParser
showFieldsCSV ::
(RecMapMethod ShowCSV ElField ts, RecordToList ts) =>
Record ts
-> [T.Text]
showFieldsCSV :: forall (ts :: [(Symbol, *)]).
(RecMapMethod ShowCSV ElField ts, RecordToList ts) =>
Record ts -> [Text]
showFieldsCSV = forall {u} (rs :: [u]) a.
RecordToList rs =>
Rec (Const a) rs -> [a]
recordToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (c :: * -> Constraint) (f :: u -> *) (ts :: [u])
(g :: u -> *).
RecMapMethod c f ts =>
(forall (a :: u). c (PayloadType f a) => f a -> g a)
-> Rec f ts -> Rec g ts
rmapMethod @ShowCSV forall (a :: (Symbol, *)).
ShowCSV (PayloadType ElField a) =>
ElField a -> Const Text a
aux
where
aux ::
(ShowCSV (PayloadType ElField a)) =>
ElField a
-> Const T.Text a
aux :: forall (a :: (Symbol, *)).
ShowCSV (PayloadType ElField a) =>
ElField a -> Const Text a
aux (Field Snd a
x) = forall k a (b :: k). a -> Const a b
Const (forall a. ShowCSV a => a -> Text
showCSV Snd a
x)
produceCSV ::
forall f ts m.
( ColumnHeaders ts
, Foldable f
, Monad m
, RecordToList ts
, RecMapMethod ShowCSV ElField ts
) =>
f (Record ts)
-> P.Producer String m ()
produceCSV :: forall (f :: * -> *) (ts :: [(Symbol, *)]) (m :: * -> *).
(ColumnHeaders ts, Foldable f, Monad m, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
f (Record ts) -> Producer String m ()
produceCSV = forall (f :: * -> *) (ts :: [(Symbol, *)]) (m :: * -> *).
(ColumnHeaders ts, Foldable f, Monad m, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
ParserOptions -> f (Record ts) -> Producer String m ()
produceDSV ParserOptions
defaultParser
produceDSV ::
forall f ts m.
( ColumnHeaders ts
, Foldable f
, Monad m
, RecordToList ts
, RecMapMethod ShowCSV ElField ts
) =>
ParserOptions
-> f (Record ts)
-> P.Producer String m ()
produceDSV :: forall (f :: * -> *) (ts :: [(Symbol, *)]) (m :: * -> *).
(ColumnHeaders ts, Foldable f, Monad m, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
ParserOptions -> f (Record ts) -> Producer String m ()
produceDSV ParserOptions
opts f (Record ts)
recs = do
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (forall a. [a] -> [[a]] -> [a]
intercalate (Text -> String
T.unpack Text
separator) (forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
(f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Record ts))))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
separator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [(Symbol, *)]).
(RecMapMethod ShowCSV ElField ts, RecordToList ts) =>
Record ts -> [Text]
showFieldsCSV) f (Record ts)
recs
where
separator :: Text
separator = ParserOptions -> Text
columnSeparator ParserOptions
opts
pipeToCSV ::
forall ts m.
( Monad m
, ColumnHeaders ts
, RecordToList ts
, RecMapMethod ShowCSV ElField ts
) =>
P.Pipe (Record ts) T.Text m ()
pipeToCSV :: forall (ts :: [(Symbol, *)]) (m :: * -> *).
(Monad m, ColumnHeaders ts, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
Pipe (Record ts) Text m ()
pipeToCSV = forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
header)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy () (Record ts) () Text m ()
go
where
header :: [String]
header = forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
(f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Record ts))
go :: P.Pipe (Record ts) T.Text m ()
go :: Proxy () (Record ts) () Text m ()
go = forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (Text -> [Text] -> Text
T.intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [(Symbol, *)]).
(RecMapMethod ShowCSV ElField ts, RecordToList ts) =>
Record ts -> [Text]
showFieldsCSV)
writeCSV ::
( ColumnHeaders ts
, Foldable f
, RecordToList ts
, RecMapMethod ShowCSV ElField ts
) =>
FilePath
-> f (Record ts)
-> IO ()
writeCSV :: forall (ts :: [(Symbol, *)]) (f :: * -> *).
(ColumnHeaders ts, Foldable f, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
String -> f (Record ts) -> IO ()
writeCSV = forall (ts :: [(Symbol, *)]) (f :: * -> *).
(ColumnHeaders ts, Foldable f, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
ParserOptions -> String -> f (Record ts) -> IO ()
writeDSV ParserOptions
defaultParser
writeDSV ::
( ColumnHeaders ts
, Foldable f
, RecordToList ts
, RecMapMethod ShowCSV ElField ts
) =>
ParserOptions
-> FilePath
-> f (Record ts)
-> IO ()
writeDSV :: forall (ts :: [(Symbol, *)]) (f :: * -> *).
(ColumnHeaders ts, Foldable f, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
ParserOptions -> String -> f (Record ts) -> IO ()
writeDSV ParserOptions
opts String
fp f (Record ts)
recs =
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
P.runSafeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => Effect m r -> m r
P.runEffect forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) (ts :: [(Symbol, *)]) (m :: * -> *).
(ColumnHeaders ts, Foldable f, Monad m, RecordToList ts,
RecMapMethod ShowCSV ElField ts) =>
ParserOptions -> f (Record ts) -> Producer String m ()
produceDSV ParserOptions
opts f (Record ts)
recs forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map String -> Text
T.pack forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) r. MonadSafe m => String -> Consumer Text m r
consumeTextLines String
fp