{-# LANGUAGE OverloadedStrings #-}
module CSV ( configDir
, readCSV
, readSingleColCSV
, writeCSV
, writeSingleColCSV
, addToCSV
, writeHashMapToCSV
) where
import Control.Applicative ( (<|>) )
import Control.Exception ( handle
, IOException
)
import Control.Monad ( void )
import Data.Bifunctor ( bimap )
import Data.Functor ( (<&>) )
import qualified Data.HashMap.Strict as HM
import Data.List ( transpose )
import Data.Maybe ( fromMaybe )
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Directory ( createDirectoryIfMissing
, getXdgDirectory
, XdgDirectory( XdgConfig )
)
import System.IO ( stderr )
import Text.ParserCombinators.Parsec hiding ( (<|>))
import Text.Parsec.Text hiding ( GenParser )
configDir :: IO FilePath
configDir :: IO FilePath
configDir = XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
"owen/"
csvFile :: GenParser Char st [[String]]
csvFile :: GenParser Char st [[FilePath]]
csvFile = ParsecT FilePath st Identity [FilePath]
-> ParsecT FilePath st Identity FilePath
-> GenParser Char st [[FilePath]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy ParsecT FilePath st Identity [FilePath]
forall st. GenParser Char st [FilePath]
line ParsecT FilePath st Identity FilePath
forall st. GenParser Char st FilePath
eol
line :: GenParser Char st [String]
line :: GenParser Char st [FilePath]
line = ParsecT FilePath st Identity FilePath
-> ParsecT FilePath st Identity Char
-> GenParser Char st [FilePath]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT FilePath st Identity FilePath
forall st. GenParser Char st FilePath
cell (Char -> ParsecT FilePath st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
cell :: GenParser Char st String
cell :: GenParser Char st FilePath
cell = GenParser Char st FilePath
forall st. GenParser Char st FilePath
quotedCell GenParser Char st FilePath
-> GenParser Char st FilePath -> GenParser Char st FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT FilePath st Identity Char -> GenParser Char st FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (FilePath -> ParsecT FilePath st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
",\n\r")
quotedCell :: GenParser Char st String
quotedCell :: GenParser Char st FilePath
quotedCell = do
Char -> ParsecT FilePath st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
FilePath
content <- ParsecT FilePath st Identity Char -> GenParser Char st FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT FilePath st Identity Char
forall st. GenParser Char st Char
quotedChar
Char -> ParsecT FilePath st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
FilePath -> GenParser Char st FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
content
quotedChar :: GenParser Char st Char
quotedChar :: GenParser Char st Char
quotedChar = FilePath -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
"\"" GenParser Char st Char
-> GenParser Char st Char -> GenParser Char st Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GenParser Char st Char -> GenParser Char st Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (FilePath -> ParsecT FilePath st Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\"\"" ParsecT FilePath st Identity FilePath
-> GenParser Char st Char -> GenParser Char st Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> GenParser Char st Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"')
escapeQuotes :: T.Text -> T.Text
escapeQuotes :: Text -> Text
escapeQuotes Text
x = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\"" Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
eol :: GenParser Char st String
eol :: GenParser Char st FilePath
eol = GenParser Char st FilePath -> GenParser Char st FilePath
forall tok st a. GenParser tok st a -> GenParser tok st a
try (FilePath -> GenParser Char st FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\n\r")
GenParser Char st FilePath
-> GenParser Char st FilePath -> GenParser Char st FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GenParser Char st FilePath -> GenParser Char st FilePath
forall tok st a. GenParser tok st a -> GenParser tok st a
try (FilePath -> GenParser Char st FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\r\n")
GenParser Char st FilePath
-> GenParser Char st FilePath -> GenParser Char st FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> GenParser Char st FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\n"
GenParser Char st FilePath
-> GenParser Char st FilePath -> GenParser Char st FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> GenParser Char st FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\r"
GenParser Char st FilePath
-> FilePath -> GenParser Char st FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
"end of line"
errStrLn :: String -> IO ()
errStrLn :: FilePath -> IO ()
errStrLn = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text -> IO ()) -> (FilePath -> Text) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
readCSV :: FilePath -> IO [[T.Text]]
readCSV :: FilePath -> IO [[Text]]
readCSV FilePath
path = do
FilePath
base <- IO FilePath
configDir
FilePath
contents <- (IOException -> IO FilePath) -> IO FilePath -> IO FilePath
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
(\IOException
e -> do
let err :: FilePath
err = IOException -> FilePath
forall a. Show a => a -> FilePath
show (IOException
e :: IOException)
FilePath -> IO ()
errStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"[CSV] Error reading " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
FilePath -> IO ()
errStrLn FilePath
err
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"")
(IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile (FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path)
case Parsec FilePath () [[FilePath]]
-> FilePath -> FilePath -> Either ParseError [[FilePath]]
forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
parse Parsec FilePath () [[FilePath]]
forall st. GenParser Char st [[FilePath]]
csvFile FilePath
path FilePath
contents of
Left ParseError
e -> ParseError -> IO ()
forall a. Show a => a -> IO ()
print ParseError
e IO () -> IO [[Text]] -> IO [[Text]]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [[Text]] -> IO [[Text]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Right [[FilePath]]
result -> [[Text]] -> IO [[Text]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Text]] -> IO [[Text]]) -> [[Text]] -> IO [[Text]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text
T.pack (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([FilePath] -> [Text]) -> [[FilePath]] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[FilePath]]
result
readSingleColCSV :: FilePath -> IO [T.Text]
readSingleColCSV :: FilePath -> IO [Text]
readSingleColCSV FilePath
path = do
[[Text]]
contents <- [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([[Text]] -> [[Text]]) -> IO [[Text]] -> IO [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [[Text]]
readCSV FilePath
path
if [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
contents
then [Text] -> IO [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else [Text] -> IO [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall a. [a] -> a
head [[Text]]
contents
writeCSV :: FilePath -> [[T.Text]] -> IO ()
writeCSV :: FilePath -> [[Text]] -> IO ()
writeCSV FilePath
path [[Text]]
contents = do
FilePath
base <- IO FilePath
configDir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
base
(IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
(\IOException
e -> do
let err :: FilePath
err = IOException -> FilePath
forall a. Show a => a -> FilePath
show (IOException
e :: IOException)
FilePath -> IO ()
errStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"[CSV] Error writing to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
errStrLn FilePath
err)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
TIO.writeFile (FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path)
(Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Text) -> [[Text]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeQuotes) [[Text]]
contents
writeHashMapToCSV :: FilePath -> HM.HashMap T.Text T.Text -> IO ()
writeHashMapToCSV :: FilePath -> HashMap Text Text -> IO ()
writeHashMapToCSV FilePath
path HashMap Text Text
hmap = do
let textMap :: [(Text, Text)]
textMap = HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Text
hmap
let textArray :: [[Text]]
textArray = ((Text, Text) -> [Text]) -> [(Text, Text)] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
key, Text
value) -> [Text
key, Text
value]) [(Text, Text)]
textMap
FilePath -> [[Text]] -> IO ()
writeCSV FilePath
path [[Text]]
textArray
addToCSV :: FilePath -> [[T.Text]] -> IO ()
addToCSV :: FilePath -> [[Text]] -> IO ()
addToCSV FilePath
path [[Text]]
contents = do
[[Text]]
oldData <- FilePath -> IO [[Text]]
readCSV FilePath
path
FilePath -> [[Text]] -> IO ()
writeCSV FilePath
path ([[Text]] -> IO ()) -> [[Text]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Text]]
oldData [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> [[Text]]
contents
writeSingleColCSV :: FilePath -> [T.Text] -> IO ()
writeSingleColCSV :: FilePath -> [Text] -> IO ()
writeSingleColCSV FilePath
path = FilePath -> [[Text]] -> IO ()
writeCSV FilePath
path ([[Text]] -> IO ()) -> ([Text] -> [[Text]]) -> [Text] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[])