{-# LANGUAGE OverloadedStrings #-}
-- | This module provides functions for incorporating Goal into a
-- data-processing project. In particular, this module provides tools for
-- managing CSV files, and connecting them with gnuplot scripts for plotting.
-- CSV management is powered by @cassava@.
module Goal.Core.Project
    (
    -- * CSV
      goalImport
    , goalImportNamed
    , goalExport
    , goalExportLines
    , goalExportNamed
    , goalExportNamedLines
    -- ** CSV Instances
    , goalCSVParser
    , goalCSVNamer
    , goalCSVOrder
    -- * Util
    , runGnuplot
    , runGnuplotWithVariables
    ) where


--- Imports ---


-- Unqualified --

import System.Process
import System.Directory
import Data.Csv
import Data.Char
import GHC.Generics

-- Qualified --

import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString as BSI


--- Experiments ---


--- Import/Export ---


-- | Runs @gnuplot@ on the given @.gpi@, passing it a @load_path@ variable to
-- help it find Goal-generated csvs.
runGnuplot
    :: FilePath -- ^ Gnuplot loadpath
    -> String -- ^ Gnuplot script
    -> IO ()
runGnuplot :: FilePath -> FilePath -> IO ()
runGnuplot FilePath
ldpth FilePath
gpipth = do
    let cmd :: FilePath
cmd = [FilePath] -> FilePath
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ FilePath
"gnuplot ", FilePath
" -e \"load_path='", FilePath
ldpth, FilePath
"'\" ",FilePath
gpipth,FilePath
".gpi" ]
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Running Command: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cmd
    FilePath -> IO ()
callCommand FilePath
cmd

-- | Runs @gnuplot@ on the given @.gpi@, passing it a @load_path@ variable to
-- help it find Goal-generated csvs, and a list of variables.
runGnuplotWithVariables
    :: FilePath -- ^ Gnuplot loadpath
    -> String -- ^ Gnuplot script
    -> [(String,String)] -- ^ Arguments
    -> IO ()
runGnuplotWithVariables :: FilePath -> FilePath -> [(FilePath, FilePath)] -> IO ()
runGnuplotWithVariables FilePath
ldpth FilePath
gpipth [(FilePath, FilePath)]
args = do
    let cmd :: FilePath
cmd = [FilePath] -> FilePath
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [ FilePath
"gnuplot ", FilePath
" -e \"load_path='", FilePath
ldpth, FilePath
"'" ]
            [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ((FilePath, FilePath) -> FilePath
mapArgs ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FilePath, FilePath)]
args) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"\" ",FilePath
gpipth,FilePath
".gpi" ]
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Running Command: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cmd
    FilePath -> IO ()
callCommand FilePath
cmd
        where mapArgs :: (FilePath, FilePath) -> FilePath
mapArgs (FilePath
nm,FilePath
val) = [FilePath] -> FilePath
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [FilePath
"; ",FilePath
nm,FilePath
"='",FilePath
val,FilePath
"'"]


-- | Load the given CSV file. The @.csv@ extension is automatically added.
goalImport
    :: FromRecord r
    => FilePath
    -> IO (Either String [r]) -- ^ CSVs
goalImport :: FilePath -> IO (Either FilePath [r])
goalImport FilePath
flpth = do
    Either FilePath (Vector r)
bstrm <- HasHeader -> ByteString -> Either FilePath (Vector r)
forall a.
FromRecord a =>
HasHeader -> ByteString -> Either FilePath (Vector a)
decode HasHeader
NoHeader (ByteString -> Either FilePath (Vector r))
-> IO ByteString -> IO (Either FilePath (Vector r))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (FilePath
flpth FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".csv")
    case Either FilePath (Vector r)
bstrm of
      Right Vector r
as -> Either FilePath [r] -> IO (Either FilePath [r])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either FilePath [r] -> IO (Either FilePath [r]))
-> ([r] -> Either FilePath [r]) -> [r] -> IO (Either FilePath [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> Either FilePath [r]
forall a b. b -> Either a b
Right ([r] -> IO (Either FilePath [r]))
-> [r] -> IO (Either FilePath [r])
forall a b. (a -> b) -> a -> b
$ Vector r -> [r]
forall a. Vector a -> [a]
V.toList Vector r
as
      Left FilePath
str -> Either FilePath [r] -> IO (Either FilePath [r])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either FilePath [r] -> IO (Either FilePath [r]))
-> Either FilePath [r] -> IO (Either FilePath [r])
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath [r]
forall a b. a -> Either a b
Left FilePath
str

-- | Load the given CSV file with headers. The @.csv@ extension is automatically added.
goalImportNamed
    :: FromNamedRecord r
    => FilePath
    -> IO (Either String [r]) -- ^ CSVs
goalImportNamed :: FilePath -> IO (Either FilePath [r])
goalImportNamed FilePath
flpth = do
    Either FilePath (Header, Vector r)
bstrm <- ByteString -> Either FilePath (Header, Vector r)
forall a.
FromNamedRecord a =>
ByteString -> Either FilePath (Header, Vector a)
decodeByName (ByteString -> Either FilePath (Header, Vector r))
-> IO ByteString -> IO (Either FilePath (Header, Vector r))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (FilePath
flpth FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".csv")
    case Either FilePath (Header, Vector r)
bstrm of
      Right (Header, Vector r)
as -> Either FilePath [r] -> IO (Either FilePath [r])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either FilePath [r] -> IO (Either FilePath [r]))
-> (Vector r -> Either FilePath [r])
-> Vector r
-> IO (Either FilePath [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> Either FilePath [r]
forall a b. b -> Either a b
Right ([r] -> Either FilePath [r])
-> (Vector r -> [r]) -> Vector r -> Either FilePath [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector r -> [r]
forall a. Vector a -> [a]
V.toList (Vector r -> IO (Either FilePath [r]))
-> Vector r -> IO (Either FilePath [r])
forall a b. (a -> b) -> a -> b
$ (Header, Vector r) -> Vector r
forall a b. (a, b) -> b
snd (Header, Vector r)
as
      Left FilePath
str -> Either FilePath [r] -> IO (Either FilePath [r])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either FilePath [r] -> IO (Either FilePath [r]))
-> Either FilePath [r] -> IO (Either FilePath [r])
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath [r]
forall a b. a -> Either a b
Left FilePath
str

filePather :: FilePath -> FilePath -> IO FilePath
filePather :: FilePath -> FilePath -> IO FilePath
filePather FilePath
ldpth FilePath
flnm = do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
ldpth
    FilePath -> IO FilePath
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [FilePath
ldpth,FilePath
"/",FilePath
flnm,FilePath
".csv"]

-- | Export the given CSVs to a file in the given directory. The @.csv@
-- extension is automatically added to the file name.
goalExport
    :: ToRecord r
    => FilePath -- load_path
    -> String -- File Name
    -> [r] -- ^ CSVs
    -> IO ()
goalExport :: FilePath -> FilePath -> [r] -> IO ()
goalExport FilePath
ldpth FilePath
flnm [r]
csvs = do
    FilePath
flpth <- FilePath -> FilePath -> IO FilePath
filePather FilePath
ldpth FilePath
flnm
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
flpth (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [r] -> ByteString
forall a. ToRecord a => [a] -> ByteString
encode [r]
csvs

-- | Export the given list of CSVs to a file in the given directory, seperating
-- each set of CSVs by a single line. This causes gnuplot to the read CSV as a
-- collection of line segments. The @.csv@ extension is automatically added to
-- the file name.
goalExportLines
    :: ToRecord r
    => FilePath
    -> FilePath
    -> [[r]] -- ^ CSVss
    -> IO ()
goalExportLines :: FilePath -> FilePath -> [[r]] -> IO ()
goalExportLines FilePath
ldpth FilePath
flnm [[r]]
csvss = do
    FilePath
flpth <- FilePath -> FilePath -> IO FilePath
filePather FilePath
ldpth FilePath
flnm
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
flpth (ByteString -> IO ())
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.tail (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.tail (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BS.append ByteString
"\r\n" (ByteString -> ByteString)
-> ([r] -> ByteString) -> [r] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> ByteString
forall a. ToRecord a => [a] -> ByteString
encode ([r] -> ByteString) -> [[r]] -> [ByteString]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[r]]
csvss

-- | Export the named CSVs to a file in the given directory, adding a header to
-- the @.csv@ file.
goalExportNamed
    :: (ToNamedRecord r, DefaultOrdered r)
    => FilePath
    -> FilePath
    -> [r] -- ^ CSVs
    -> IO ()
goalExportNamed :: FilePath -> FilePath -> [r] -> IO ()
goalExportNamed FilePath
ldpth FilePath
flnm [r]
csvs = do
    FilePath
flpth <- FilePath -> FilePath -> IO FilePath
filePather FilePath
ldpth FilePath
flnm
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
flpth (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [r] -> ByteString
forall a. (DefaultOrdered a, ToNamedRecord a) => [a] -> ByteString
encodeDefaultOrderedByName [r]
csvs

-- | Export the given list of named CSVs to a file, breaking it into a set of
-- line segments (with headers).
goalExportNamedLines
    :: (ToNamedRecord r, DefaultOrdered r)
    => FilePath
    -> FilePath
    -> [[r]] -- ^ CSVss
    -> IO ()
goalExportNamedLines :: FilePath -> FilePath -> [[r]] -> IO ()
goalExportNamedLines FilePath
ldpth FilePath
flnm [[r]]
csvss = do
    FilePath
flpth <- FilePath -> FilePath -> IO FilePath
filePather FilePath
ldpth FilePath
flnm
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
flpth (ByteString -> IO ())
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BS.append ByteString
"\r\n" (ByteString -> ByteString)
-> ([r] -> ByteString) -> [r] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> ByteString
forall a. (DefaultOrdered a, ToNamedRecord a) => [a] -> ByteString
encodeDefaultOrderedByName ([r] -> ByteString) -> [[r]] -> [ByteString]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[r]]
csvss


--- Util ---


deCamelCaseLoop :: String -> String
deCamelCaseLoop :: FilePath -> FilePath
deCamelCaseLoop FilePath
"" = FilePath
""
deCamelCaseLoop (Char
c:FilePath
wrds) =
    let (FilePath
wrd,FilePath
wrds') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLower FilePath
wrds
     in (Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
wrd) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
deCamelCaseLoop FilePath
wrds'

deCamelCase :: String -> String
deCamelCase :: FilePath -> FilePath
deCamelCase (Char
c:FilePath
wrds) = FilePath -> FilePath
forall a. [a] -> [a]
init (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
deCamelCaseLoop (Char -> Char
toUpper Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
wrds)
deCamelCase FilePath
"" = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"How is deCamelCase being run on an empty string?"

deCamelCaseCSV :: Options
deCamelCaseCSV :: Options
deCamelCaseCSV = Options
defaultOptions { fieldLabelModifier :: FilePath -> FilePath
fieldLabelModifier = FilePath -> FilePath
deCamelCase }

-- | A generic @.csv@ parser which reorganizes a header name in camel case into
-- "human readable" text. Useful for instantiating 'FromNamedRecord'.
goalCSVParser :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a
goalCSVParser :: NamedRecord -> Parser a
goalCSVParser = Options -> NamedRecord -> Parser a
forall a.
(Generic a, GFromNamedRecord (Rep a)) =>
Options -> NamedRecord -> Parser a
genericParseNamedRecord Options
deCamelCaseCSV

-- | A generic @.csv@ namer which reorganizes a header name in camel case into
-- "human readable" text. Useful for instantiating 'ToNamedRecord'.
goalCSVNamer
    :: (Generic a, GToRecord (Rep a) (BSI.ByteString, BSI.ByteString)) => a -> NamedRecord
goalCSVNamer :: a -> NamedRecord
goalCSVNamer = Options -> a -> NamedRecord
forall a.
(Generic a, GToRecord (Rep a) (ByteString, ByteString)) =>
Options -> a -> NamedRecord
genericToNamedRecord Options
deCamelCaseCSV

-- | A generic @.csv@ order which reorganizes a header name in camel case into
-- "human readable" text. Useful for instantiating 'DefaultOrdered'.
goalCSVOrder :: (Generic a, GToNamedRecordHeader (Rep a)) => a -> Header
goalCSVOrder :: a -> Header
goalCSVOrder = Options -> a -> Header
forall a.
(Generic a, GToNamedRecordHeader (Rep a)) =>
Options -> a -> Header
genericHeaderOrder Options
deCamelCaseCSV