{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
module Box.Csv
( CsvConfig (..),
defaultCsvConfig,
Header (..),
rowEmitter,
rowCommitter,
runCsv,
sep,
field_,
field,
skipField_,
skipField,
int,
int',
A.double,
double',
fields,
ints,
doubles,
day',
tod',
localtime',
)
where
import Box
import Control.Monad
import qualified Data.Attoparsec.Text as A
import Data.Functor.Contravariant
import Data.Text (Text, unpack)
import qualified Data.Text as Text
import Data.Time
import GHC.Generics
data CsvConfig = CsvConfig
{
CsvConfig -> FilePath
file :: FilePath,
CsvConfig -> Char
fsep :: Char,
:: Header
}
deriving (Int -> CsvConfig -> ShowS
[CsvConfig] -> ShowS
CsvConfig -> FilePath
(Int -> CsvConfig -> ShowS)
-> (CsvConfig -> FilePath)
-> ([CsvConfig] -> ShowS)
-> Show CsvConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CsvConfig] -> ShowS
$cshowList :: [CsvConfig] -> ShowS
show :: CsvConfig -> FilePath
$cshow :: CsvConfig -> FilePath
showsPrec :: Int -> CsvConfig -> ShowS
$cshowsPrec :: Int -> CsvConfig -> ShowS
Show, (forall x. CsvConfig -> Rep CsvConfig x)
-> (forall x. Rep CsvConfig x -> CsvConfig) -> Generic CsvConfig
forall x. Rep CsvConfig x -> CsvConfig
forall x. CsvConfig -> Rep CsvConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CsvConfig x -> CsvConfig
$cfrom :: forall x. CsvConfig -> Rep CsvConfig x
Generic, CsvConfig -> CsvConfig -> Bool
(CsvConfig -> CsvConfig -> Bool)
-> (CsvConfig -> CsvConfig -> Bool) -> Eq CsvConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CsvConfig -> CsvConfig -> Bool
$c/= :: CsvConfig -> CsvConfig -> Bool
== :: CsvConfig -> CsvConfig -> Bool
$c== :: CsvConfig -> CsvConfig -> Bool
Eq)
defaultCsvConfig :: CsvConfig
defaultCsvConfig :: CsvConfig
defaultCsvConfig =
FilePath -> Char -> Header -> CsvConfig
CsvConfig
FilePath
"./other/time_series_covid19_deaths_global_narrow.csv"
Char
','
Header
HasHXL
data = | HasHXL | deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> FilePath
(Int -> Header -> ShowS)
-> (Header -> FilePath) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> FilePath
$cshow :: Header -> FilePath
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq)
parseE :: (Functor m) => A.Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE :: Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE Parser a
parser Emitter m Text
e = (\Text
t -> (FilePath -> Either Text a)
-> (a -> Either Text a) -> Either FilePath a -> Either Text a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Text a -> FilePath -> Either Text a
forall a b. a -> b -> a
const (Either Text a -> FilePath -> Either Text a)
-> Either Text a -> FilePath -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left Text
t) a -> Either Text a
forall a b. b -> Either a b
Right (Parser a -> Text -> Either FilePath a
forall a. Parser a -> Text -> Either FilePath a
A.parseOnly Parser a
parser Text
t)) (Text -> Either Text a)
-> Emitter m Text -> Emitter m (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emitter m Text
e
rowEmitter :: CsvConfig -> (Char -> A.Parser a) -> CoEmitter IO (Either Text a)
rowEmitter :: CsvConfig -> (Char -> Parser a) -> CoEmitter IO (Either Text a)
rowEmitter CsvConfig
cfg Char -> Parser a
p = Parser a -> Emitter IO Text -> Emitter IO (Either Text a)
forall (m :: * -> *) a.
Functor m =>
Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE (Char -> Parser a
p (CsvConfig -> Char
fsep CsvConfig
cfg)) (Emitter IO Text -> Emitter IO (Either Text a))
-> Codensity IO (Emitter IO Text) -> CoEmitter IO (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Codensity IO (Emitter IO Text)
fileE (CsvConfig -> FilePath
file CsvConfig
cfg)
rowCommitter :: CsvConfig -> (a -> [Text]) -> CoCommitter IO a
rowCommitter :: CsvConfig -> (a -> [Text]) -> CoCommitter IO a
rowCommitter CsvConfig
cfg a -> [Text]
f = (a -> Text) -> Committer IO Text -> Committer IO a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ CsvConfig -> Char
fsep CsvConfig
cfg) ([Text] -> Text) -> (a -> [Text]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Text]
f) (Committer IO Text -> Committer IO a)
-> Codensity IO (Committer IO Text) -> CoCommitter IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Codensity IO (Committer IO Text)
fileWriteC (CsvConfig -> FilePath
file CsvConfig
cfg)
runCsv :: CsvConfig -> (Char -> A.Parser a) -> IO [Either Text a]
runCsv :: CsvConfig -> (Char -> Parser a) -> IO [Either Text a]
runCsv CsvConfig
cfg Char -> Parser a
p = Emitter IO (Either Text a) -> IO [Either Text a]
forall (m :: * -> *) a. Monad m => Emitter m a -> m [a]
toListM (Emitter IO (Either Text a) -> IO [Either Text a])
-> Codensity IO (Emitter IO (Either Text a)) -> IO [Either Text a]
forall a (m :: * -> *) r. (a -> m r) -> Codensity m a -> m r
<$|> CsvConfig
-> (Char -> Parser a) -> Codensity IO (Emitter IO (Either Text a))
forall a.
CsvConfig -> (Char -> Parser a) -> CoEmitter IO (Either Text a)
rowEmitter CsvConfig
cfg Char -> Parser a
p
sep :: Char -> A.Parser ()
sep :: Char -> Parser ()
sep Char
c = Parser Text Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Text Char
A.char Char
c)
field_ :: Char -> A.Parser Text
field_ :: Char -> Parser Text
field_ Char
c = (Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c)
field :: Char -> A.Parser Text
field :: Char -> Parser Text
field Char
c = (Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c) Parser Text -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
c
skipField_ :: Char -> A.Parser ()
skipField_ :: Char -> Parser ()
skipField_ Char
c = (Char -> Bool) -> Parser ()
A.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c)
skipField :: Char -> A.Parser ()
skipField :: Char -> Parser ()
skipField Char
c = (Char -> Bool) -> Parser ()
A.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c) Parser () -> Parser Text Char -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
','
int :: A.Parser Int
int :: Parser Int
int = Parser Int
forall a. Integral a => Parser a
A.decimal
int' :: Char -> A.Parser Int
int' :: Char -> Parser Int
int' Char
c = Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser Text Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
c
double' :: Char -> A.Parser Double
double' :: Char -> Parser Double
double' Char
c = Parser Double
A.double Parser Double -> Parser Text Char -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
c
day' :: Char -> A.Parser Day
day' :: Char -> Parser Day
day' Char
c = do
Text
d <- (Char -> Bool) -> Parser Text
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
Day
d' <- Bool -> TimeLocale -> FilePath -> FilePath -> Parser Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale FilePath
"%F" (Text -> FilePath
unpack Text
d)
Char
_ <- Char -> Parser Text Char
A.char Char
c
Day -> Parser Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
d'
tod' :: Char -> A.Parser TimeOfDay
tod' :: Char -> Parser TimeOfDay
tod' Char
c = do
Text
d <- (Char -> Bool) -> Parser Text
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
TimeOfDay
d' <- Bool -> TimeLocale -> FilePath -> FilePath -> Parser TimeOfDay
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale FilePath
"%T%Q" (Text -> FilePath
unpack Text
d)
Char
_ <- Char -> Parser Text Char
A.char Char
c
TimeOfDay -> Parser TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
d'
localtime' :: Char -> A.Parser LocalTime
localtime' :: Char -> Parser LocalTime
localtime' Char
c = do
Text
d <- (Char -> Bool) -> Parser Text
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
LocalTime
d' <- Bool -> TimeLocale -> FilePath -> FilePath -> Parser LocalTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale FilePath
"%Y %b %e %k:%M%p" (Text -> FilePath
unpack (Text
"2020 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d))
Char
_ <- Char -> Parser Text Char
A.char Char
c
LocalTime -> Parser LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
d'
fields :: Char -> A.Parser [Text]
fields :: Char -> Parser [Text]
fields Char
c =
Char -> Parser Text
field_ Char
c Parser Text -> Parser () -> Parser [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ()
sep Char
c
doubles :: Char -> A.Parser [Double]
doubles :: Char -> Parser [Double]
doubles Char
c = Parser Double
A.double Parser Double -> Parser () -> Parser [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ()
sep Char
c
ints :: Char -> A.Parser [Int]
ints :: Char -> Parser [Int]
ints Char
c = Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser () -> Parser [Int]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ()
sep Char
c