{-# 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

-- | Reads CSV as 2-D T.Text list. If doesn't exist, creates new
-- file with empty contents and returns []
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

-- | Write CSV from 2-D T.Text list
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

-- | Appends the given tabular `Text` data to the CSV present at the given path. If no
-- such CSV exists, a new one is created.
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]
:[])