{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{- | CLI application harness.

-}
module Console.Gemini.Exports.Main
    ( run
    , getArgs
    , Args(..)
    , loadConfigFile
    , ConfigFile(..)
    ) where

import           Control.Applicative            ( (<|>) )
import           Control.Exception.Safe         ( try )
import           Control.Monad                  ( forM )
import           Data.Aeson                     ( (.:?)
                                                , FromJSON(..)
                                                , withObject
                                                )
import           Data.Maybe                     ( catMaybes
                                                , fromMaybe
                                                )
import           Data.Text                      ( Text )
import           Data.Time                      ( LocalTime(..)
                                                , UTCTime(..)
                                                , ZonedTime(..)
                                                , fromGregorian
                                                , getTimeZone
                                                , timeToTimeOfDay
                                                , zonedTimeToUTC
                                                )
import           Data.Version                   ( showVersion )
import           Data.Yaml                      ( prettyPrintParseException )
import           Data.Yaml.Config               ( ignoreEnv
                                                , loadYamlSettings
                                                )
import           System.Console.CmdArgs         ( (&=)
                                                , Data
                                                , Typeable
                                                , cmdArgs
                                                , def
                                                , details
                                                , explicit
                                                , help
                                                , helpArg
                                                , name
                                                , program
                                                , summary
                                                , typ
                                                )
import           System.Directory               ( doesFileExist )
import           System.Environment             ( lookupEnv )
import           System.Environment.XDG.BaseDir ( getUserConfigFile )
import           System.Exit                    ( exitFailure )
import           System.IO                      ( hPutStrLn
                                                , stderr
                                                )
import           Text.RawString.QQ              ( r )

import           Console.Gemini.Exports.Csv
import           Paths_gemini_exports           ( version )
import           Web.Gemini

import qualified Data.ByteString.Lazy.Char8    as LBS
import qualified Data.List                     as L
import qualified Data.Map.Strict               as M
import qualified Data.Text                     as T


-- | Run the executable.
run :: ConfigFile -> Args -> IO ()
run :: ConfigFile -> Args -> IO ()
run ConfigFile
cfg Args
cfgArgs = do
    AppConfig {FilePath
Maybe (UTCTime, UTCTime)
GeminiConfig
dateRange :: AppConfig -> Maybe (UTCTime, UTCTime)
outputFile :: AppConfig -> FilePath
geminiCfg :: AppConfig -> GeminiConfig
dateRange :: Maybe (UTCTime, UTCTime)
outputFile :: FilePath
geminiCfg :: GeminiConfig
..} <- ConfigFile -> Args -> IO AppConfig
makeConfig ConfigFile
cfg Args
cfgArgs
    [ExportData]
exportData     <- GeminiConfig -> GeminiApiM [ExportData] -> IO [ExportData]
forall a. GeminiConfig -> GeminiApiM a -> IO a
runApi GeminiConfig
geminiCfg (GeminiApiM [ExportData] -> IO [ExportData])
-> GeminiApiM [ExportData] -> IO [ExportData]
forall a b. (a -> b) -> a -> b
$ do
        [Trade]
trades <- Maybe (UTCTime, UTCTime) -> GeminiApiM [Trade]
getMyTrades Maybe (UTCTime, UTCTime)
dateRange
        let symbols :: [Text]
symbols = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Trade -> Text) -> [Trade] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Trade -> Text
tSymbol [Trade]
trades
        Map Text SymbolDetails
symbolDetails <- ([(Text, SymbolDetails)] -> Map Text SymbolDetails)
-> GeminiApiM [(Text, SymbolDetails)]
-> GeminiApiM (Map Text SymbolDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, SymbolDetails)] -> Map Text SymbolDetails
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (GeminiApiM [(Text, SymbolDetails)]
 -> GeminiApiM (Map Text SymbolDetails))
-> ((Text -> GeminiApiM (Text, SymbolDetails))
    -> GeminiApiM [(Text, SymbolDetails)])
-> (Text -> GeminiApiM (Text, SymbolDetails))
-> GeminiApiM (Map Text SymbolDetails)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text]
-> (Text -> GeminiApiM (Text, SymbolDetails))
-> GeminiApiM [(Text, SymbolDetails)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
symbols ((Text -> GeminiApiM (Text, SymbolDetails))
 -> GeminiApiM (Map Text SymbolDetails))
-> (Text -> GeminiApiM (Text, SymbolDetails))
-> GeminiApiM (Map Text SymbolDetails)
forall a b. (a -> b) -> a -> b
$ \Text
symbol -> do
            (Text
symbol, ) (SymbolDetails -> (Text, SymbolDetails))
-> GeminiApiM SymbolDetails -> GeminiApiM (Text, SymbolDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GeminiApiM SymbolDetails
forall (m :: * -> *). MonadHttp m => Text -> m SymbolDetails
getSymbolDetails Text
symbol
        [ExportData]
tradeExport <- ([Maybe ExportData] -> [ExportData])
-> GeminiApiM [Maybe ExportData] -> GeminiApiM [ExportData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ExportData] -> [ExportData]
forall a. [Maybe a] -> [a]
catMaybes (GeminiApiM [Maybe ExportData] -> GeminiApiM [ExportData])
-> ((Trade -> GeminiApiM (Maybe ExportData))
    -> GeminiApiM [Maybe ExportData])
-> (Trade -> GeminiApiM (Maybe ExportData))
-> GeminiApiM [ExportData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Trade]
-> (Trade -> GeminiApiM (Maybe ExportData))
-> GeminiApiM [Maybe ExportData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Trade]
trades ((Trade -> GeminiApiM (Maybe ExportData))
 -> GeminiApiM [ExportData])
-> (Trade -> GeminiApiM (Maybe ExportData))
-> GeminiApiM [ExportData]
forall a b. (a -> b) -> a -> b
$ \Trade
t -> do
            let mbTrade :: Maybe ExportLine
mbTrade = Trade -> SymbolDetails -> ExportLine
TradeExport Trade
t (SymbolDetails -> ExportLine)
-> Maybe SymbolDetails -> Maybe ExportLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text SymbolDetails -> Maybe SymbolDetails
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Trade -> Text
tSymbol Trade
t) Map Text SymbolDetails
symbolDetails
            (ExportLine -> GeminiApiM ExportData)
-> Maybe ExportLine -> GeminiApiM (Maybe ExportData)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ExportLine -> GeminiApiM ExportData
forall (m :: * -> *). MonadIO m => ExportLine -> m ExportData
makeExportData Maybe ExportLine
mbTrade
        [Transfer]
transfers        <- Maybe (UTCTime, UTCTime) -> GeminiApiM [Transfer]
getMyTransfers Maybe (UTCTime, UTCTime)
dateRange
        [ExportData]
transferExport   <- (Transfer -> GeminiApiM ExportData)
-> [Transfer] -> GeminiApiM [ExportData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ExportLine -> GeminiApiM ExportData
forall (m :: * -> *). MonadIO m => ExportLine -> m ExportData
makeExportData (ExportLine -> GeminiApiM ExportData)
-> (Transfer -> ExportLine) -> Transfer -> GeminiApiM ExportData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transfer -> ExportLine
TransferExport) [Transfer]
transfers
        [EarnTransaction]
earnTransactions <- Maybe (UTCTime, UTCTime) -> GeminiApiM [EarnTransaction]
getMyEarnTransactions Maybe (UTCTime, UTCTime)
dateRange
        [ExportData]
earnExport       <- (EarnTransaction -> GeminiApiM ExportData)
-> [EarnTransaction] -> GeminiApiM [ExportData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ExportLine -> GeminiApiM ExportData
forall (m :: * -> *). MonadIO m => ExportLine -> m ExportData
makeExportData (ExportLine -> GeminiApiM ExportData)
-> (EarnTransaction -> ExportLine)
-> EarnTransaction
-> GeminiApiM ExportData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EarnTransaction -> ExportLine
EarnExport) [EarnTransaction]
earnTransactions
        [ExportData] -> GeminiApiM [ExportData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExportData] -> GeminiApiM [ExportData])
-> [ExportData] -> GeminiApiM [ExportData]
forall a b. (a -> b) -> a -> b
$ [ExportData]
tradeExport [ExportData] -> [ExportData] -> [ExportData]
forall a. Semigroup a => a -> a -> a
<> [ExportData]
transferExport [ExportData] -> [ExportData] -> [ExportData]
forall a. Semigroup a => a -> a -> a
<> [ExportData]
earnExport
    let
        csvData :: ByteString
csvData = [ExportData] -> ByteString
makeExportCsv
            ([ExportData] -> ByteString) -> [ExportData] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ExportData -> POSIXTime) -> [ExportData] -> [ExportData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (ExportLine -> POSIXTime
getExportLineTimestamp (ExportLine -> POSIXTime)
-> (ExportData -> ExportLine) -> ExportData -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportData -> ExportLine
edLine) [ExportData]
exportData
    if FilePath
outputFile FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-"
        then ByteString -> IO ()
LBS.putStrLn ByteString
csvData
        else FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
outputFile ByteString
csvData

-- | Print some text to stderr and then exit with an error.
exitWithError :: String -> IO a
exitWithError :: FilePath -> IO a
exitWithError FilePath
msg = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"[ERROR] " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
msg) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure


-- CONFIGURATION

data AppConfig = AppConfig
    { AppConfig -> GeminiConfig
geminiCfg  :: GeminiConfig
    , AppConfig -> FilePath
outputFile :: FilePath
    , AppConfig -> Maybe (UTCTime, UTCTime)
dateRange  :: Maybe (UTCTime, UTCTime)
    }
    deriving (Int -> AppConfig -> FilePath -> FilePath
[AppConfig] -> FilePath -> FilePath
AppConfig -> FilePath
(Int -> AppConfig -> FilePath -> FilePath)
-> (AppConfig -> FilePath)
-> ([AppConfig] -> FilePath -> FilePath)
-> Show AppConfig
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [AppConfig] -> FilePath -> FilePath
$cshowList :: [AppConfig] -> FilePath -> FilePath
show :: AppConfig -> FilePath
$cshow :: AppConfig -> FilePath
showsPrec :: Int -> AppConfig -> FilePath -> FilePath
$cshowsPrec :: Int -> AppConfig -> FilePath -> FilePath
Show, ReadPrec [AppConfig]
ReadPrec AppConfig
Int -> ReadS AppConfig
ReadS [AppConfig]
(Int -> ReadS AppConfig)
-> ReadS [AppConfig]
-> ReadPrec AppConfig
-> ReadPrec [AppConfig]
-> Read AppConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AppConfig]
$creadListPrec :: ReadPrec [AppConfig]
readPrec :: ReadPrec AppConfig
$creadPrec :: ReadPrec AppConfig
readList :: ReadS [AppConfig]
$creadList :: ReadS [AppConfig]
readsPrec :: Int -> ReadS AppConfig
$creadsPrec :: Int -> ReadS AppConfig
Read, AppConfig -> AppConfig -> Bool
(AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> Bool) -> Eq AppConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppConfig -> AppConfig -> Bool
$c/= :: AppConfig -> AppConfig -> Bool
== :: AppConfig -> AppConfig -> Bool
$c== :: AppConfig -> AppConfig -> Bool
Eq, Eq AppConfig
Eq AppConfig
-> (AppConfig -> AppConfig -> Ordering)
-> (AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> Bool)
-> (AppConfig -> AppConfig -> AppConfig)
-> (AppConfig -> AppConfig -> AppConfig)
-> Ord AppConfig
AppConfig -> AppConfig -> Bool
AppConfig -> AppConfig -> Ordering
AppConfig -> AppConfig -> AppConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AppConfig -> AppConfig -> AppConfig
$cmin :: AppConfig -> AppConfig -> AppConfig
max :: AppConfig -> AppConfig -> AppConfig
$cmax :: AppConfig -> AppConfig -> AppConfig
>= :: AppConfig -> AppConfig -> Bool
$c>= :: AppConfig -> AppConfig -> Bool
> :: AppConfig -> AppConfig -> Bool
$c> :: AppConfig -> AppConfig -> Bool
<= :: AppConfig -> AppConfig -> Bool
$c<= :: AppConfig -> AppConfig -> Bool
< :: AppConfig -> AppConfig -> Bool
$c< :: AppConfig -> AppConfig -> Bool
compare :: AppConfig -> AppConfig -> Ordering
$ccompare :: AppConfig -> AppConfig -> Ordering
$cp1Ord :: Eq AppConfig
Ord)

-- | Pull Environmental variables, then merge the config file, env vars,
-- and cli args into an AppConfig.
--
-- Exit with an error if we cannot construct a 'GeminiConfig'.
makeConfig :: ConfigFile -> Args -> IO AppConfig
makeConfig :: ConfigFile -> Args -> IO AppConfig
makeConfig ConfigFile {Maybe Text
cfgApiSecret :: ConfigFile -> Maybe Text
cfgApiKey :: ConfigFile -> Maybe Text
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
..} Args {Maybe Integer
Maybe FilePath
Maybe Text
argYear :: Args -> Maybe Integer
argOutputFile :: Args -> Maybe FilePath
argApiSecret :: Args -> Maybe Text
argApiKey :: Args -> Maybe Text
argYear :: Maybe Integer
argOutputFile :: Maybe FilePath
argApiSecret :: Maybe Text
argApiKey :: Maybe Text
..} = do
    Maybe Text
envApiKey <- (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GEMINI_API_KEY"
    Text
gcApiKey  <-
        FilePath -> Maybe Text -> IO Text
forall a. FilePath -> Maybe a -> IO a
errorIfNothing FilePath
"Pass a Gemini API Key with `-k` or $GEMINI_API_KEY."
        (Maybe Text -> IO Text) -> Maybe Text -> IO Text
forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiKey
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiKey
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiKey
    Maybe Text
envApiSecret <- (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GEMINI_API_SECRET"
    Text
gcApiSecret  <-
        FilePath -> Maybe Text -> IO Text
forall a. FilePath -> Maybe a -> IO a
errorIfNothing
            FilePath
"Pass a Gemini API Secret with `-s` or $GEMINI_API_SECRET."
        (Maybe Text -> IO Text) -> Maybe Text -> IO Text
forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiSecret
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiSecret
        Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiSecret
    let geminiCfg :: GeminiConfig
geminiCfg = GeminiConfig :: Text -> Text -> GeminiConfig
GeminiConfig { Text
gcApiSecret :: Text
gcApiKey :: Text
gcApiSecret :: Text
gcApiKey :: Text
.. }
    Maybe (UTCTime, UTCTime)
dateRange <- (Integer -> IO (UTCTime, UTCTime))
-> Maybe Integer -> IO (Maybe (UTCTime, UTCTime))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Integer -> IO (UTCTime, UTCTime)
buildDateRange Maybe Integer
argYear
    AppConfig -> IO AppConfig
forall (m :: * -> *) a. Monad m => a -> m a
return AppConfig :: GeminiConfig -> FilePath -> Maybe (UTCTime, UTCTime) -> AppConfig
AppConfig { outputFile :: FilePath
outputFile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" Maybe FilePath
argOutputFile, Maybe (UTCTime, UTCTime)
GeminiConfig
dateRange :: Maybe (UTCTime, UTCTime)
geminiCfg :: GeminiConfig
dateRange :: Maybe (UTCTime, UTCTime)
geminiCfg :: GeminiConfig
.. }
  where
    -- | Exit with error message if value is 'Nothing'
    errorIfNothing :: String -> Maybe a -> IO a
    errorIfNothing :: FilePath -> Maybe a -> IO a
errorIfNothing FilePath
msg = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO a
forall a. FilePath -> IO a
exitWithError FilePath
msg) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    -- | Given a year, build a tuple representing the span of a year in the
    -- user's timezone.
    buildDateRange :: Integer -> IO (UTCTime, UTCTime)
    buildDateRange :: Integer -> IO (UTCTime, UTCTime)
buildDateRange Integer
y = do
        let yearStart :: UTCTime
yearStart = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
1 Int
1) DiffTime
0
            yearEnd :: UTCTime
yearEnd   = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
12 Int
31)
                                ((DiffTime
23 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ (DiffTime
59 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
59 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
0.9999)
        (,) (UTCTime -> UTCTime -> (UTCTime, UTCTime))
-> IO UTCTime -> IO (UTCTime -> (UTCTime, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> IO UTCTime
mkZonedTime UTCTime
yearStart IO (UTCTime -> (UTCTime, UTCTime))
-> IO UTCTime -> IO (UTCTime, UTCTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> IO UTCTime
mkZonedTime UTCTime
yearEnd
    -- | Shift a time by the user's timezone - coercing it into a ZonedTime
    -- and converting that back into UTC.
    mkZonedTime :: UTCTime -> IO UTCTime
    mkZonedTime :: UTCTime -> IO UTCTime
mkZonedTime UTCTime
t = do
        TimeZone
tz <- UTCTime -> IO TimeZone
getTimeZone UTCTime
t
        let localTime :: LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime (UTCTime -> Day
utctDay UTCTime
t) (DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay) -> DiffTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime UTCTime
t)
            zonedTime :: ZonedTime
zonedTime = LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
localTime TimeZone
tz
        UTCTime -> IO UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
zonedTime


-- CONFIG FILE

-- | Optional configuration data parsed from a yaml file.
data ConfigFile = ConfigFile
    { ConfigFile -> Maybe Text
cfgApiKey    :: Maybe Text
    , ConfigFile -> Maybe Text
cfgApiSecret :: Maybe Text
    }
    deriving (Int -> ConfigFile -> FilePath -> FilePath
[ConfigFile] -> FilePath -> FilePath
ConfigFile -> FilePath
(Int -> ConfigFile -> FilePath -> FilePath)
-> (ConfigFile -> FilePath)
-> ([ConfigFile] -> FilePath -> FilePath)
-> Show ConfigFile
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ConfigFile] -> FilePath -> FilePath
$cshowList :: [ConfigFile] -> FilePath -> FilePath
show :: ConfigFile -> FilePath
$cshow :: ConfigFile -> FilePath
showsPrec :: Int -> ConfigFile -> FilePath -> FilePath
$cshowsPrec :: Int -> ConfigFile -> FilePath -> FilePath
Show, ReadPrec [ConfigFile]
ReadPrec ConfigFile
Int -> ReadS ConfigFile
ReadS [ConfigFile]
(Int -> ReadS ConfigFile)
-> ReadS [ConfigFile]
-> ReadPrec ConfigFile
-> ReadPrec [ConfigFile]
-> Read ConfigFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigFile]
$creadListPrec :: ReadPrec [ConfigFile]
readPrec :: ReadPrec ConfigFile
$creadPrec :: ReadPrec ConfigFile
readList :: ReadS [ConfigFile]
$creadList :: ReadS [ConfigFile]
readsPrec :: Int -> ReadS ConfigFile
$creadsPrec :: Int -> ReadS ConfigFile
Read, ConfigFile -> ConfigFile -> Bool
(ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool) -> Eq ConfigFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigFile -> ConfigFile -> Bool
$c/= :: ConfigFile -> ConfigFile -> Bool
== :: ConfigFile -> ConfigFile -> Bool
$c== :: ConfigFile -> ConfigFile -> Bool
Eq, Eq ConfigFile
Eq ConfigFile
-> (ConfigFile -> ConfigFile -> Ordering)
-> (ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> ConfigFile)
-> (ConfigFile -> ConfigFile -> ConfigFile)
-> Ord ConfigFile
ConfigFile -> ConfigFile -> Bool
ConfigFile -> ConfigFile -> Ordering
ConfigFile -> ConfigFile -> ConfigFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConfigFile -> ConfigFile -> ConfigFile
$cmin :: ConfigFile -> ConfigFile -> ConfigFile
max :: ConfigFile -> ConfigFile -> ConfigFile
$cmax :: ConfigFile -> ConfigFile -> ConfigFile
>= :: ConfigFile -> ConfigFile -> Bool
$c>= :: ConfigFile -> ConfigFile -> Bool
> :: ConfigFile -> ConfigFile -> Bool
$c> :: ConfigFile -> ConfigFile -> Bool
<= :: ConfigFile -> ConfigFile -> Bool
$c<= :: ConfigFile -> ConfigFile -> Bool
< :: ConfigFile -> ConfigFile -> Bool
$c< :: ConfigFile -> ConfigFile -> Bool
compare :: ConfigFile -> ConfigFile -> Ordering
$ccompare :: ConfigFile -> ConfigFile -> Ordering
$cp1Ord :: Eq ConfigFile
Ord)

instance FromJSON ConfigFile where
    parseJSON :: Value -> Parser ConfigFile
parseJSON = FilePath
-> (Object -> Parser ConfigFile) -> Value -> Parser ConfigFile
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"ConfigFile" ((Object -> Parser ConfigFile) -> Value -> Parser ConfigFile)
-> (Object -> Parser ConfigFile) -> Value -> Parser ConfigFile
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe Text
cfgApiKey    <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api-key"
        Maybe Text
cfgApiSecret <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api-secret"
        ConfigFile -> Parser ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile :: Maybe Text -> Maybe Text -> ConfigFile
ConfigFile { Maybe Text
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
.. }

-- | Attempt to read a 'ConfigFile' from
-- @$XDG_CONFIG_HOME\/gemini-exports\/config.yaml@. Print any parsing
-- errors to 'stderr'.
loadConfigFile :: IO ConfigFile
loadConfigFile :: IO ConfigFile
loadConfigFile = do
    FilePath
configPath   <- FilePath -> FilePath -> IO FilePath
getUserConfigFile FilePath
"gemini-exports" FilePath
"config.yaml"
    Bool
configExists <- FilePath -> IO Bool
doesFileExist FilePath
configPath
    if Bool
configExists
        then IO ConfigFile -> IO (Either ParseException ConfigFile)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try ([FilePath] -> [Value] -> EnvUsage -> IO ConfigFile
forall settings.
FromJSON settings =>
[FilePath] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [FilePath
configPath] [] EnvUsage
ignoreEnv) IO (Either ParseException ConfigFile)
-> (Either ParseException ConfigFile -> IO ConfigFile)
-> IO ConfigFile
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left (FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (ParseException -> FilePath) -> ParseException -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
prettyPrintParseException -> [FilePath]
errorMsgs) ->
                Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"[WARN] Invalid Configuration Format:"
                    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"\t" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>)) [FilePath]
errorMsgs
                    IO () -> IO ConfigFile -> IO ConfigFile
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
            Right ConfigFile
cfg -> ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
cfg
        else ConfigFile -> IO ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
  where
    defaultConfig :: ConfigFile
    defaultConfig :: ConfigFile
defaultConfig = Maybe Text -> Maybe Text -> ConfigFile
ConfigFile Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing


-- CLI ARGS

-- | CLI arguments supported by the executable.
data Args = Args
    { Args -> Maybe Text
argApiKey     :: Maybe Text
    , Args -> Maybe Text
argApiSecret  :: Maybe Text
    , Args -> Maybe FilePath
argOutputFile :: Maybe FilePath
    , Args -> Maybe Integer
argYear       :: Maybe Integer
    }
    deriving (Int -> Args -> FilePath -> FilePath
[Args] -> FilePath -> FilePath
Args -> FilePath
(Int -> Args -> FilePath -> FilePath)
-> (Args -> FilePath)
-> ([Args] -> FilePath -> FilePath)
-> Show Args
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Args] -> FilePath -> FilePath
$cshowList :: [Args] -> FilePath -> FilePath
show :: Args -> FilePath
$cshow :: Args -> FilePath
showsPrec :: Int -> Args -> FilePath -> FilePath
$cshowsPrec :: Int -> Args -> FilePath -> FilePath
Show, ReadPrec [Args]
ReadPrec Args
Int -> ReadS Args
ReadS [Args]
(Int -> ReadS Args)
-> ReadS [Args] -> ReadPrec Args -> ReadPrec [Args] -> Read Args
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Args]
$creadListPrec :: ReadPrec [Args]
readPrec :: ReadPrec Args
$creadPrec :: ReadPrec Args
readList :: ReadS [Args]
$creadList :: ReadS [Args]
readsPrec :: Int -> ReadS Args
$creadsPrec :: Int -> ReadS Args
Read, Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c== :: Args -> Args -> Bool
Eq, Typeable Args
DataType
Constr
Typeable Args
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Args -> c Args)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Args)
-> (Args -> Constr)
-> (Args -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Args))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args))
-> ((forall b. Data b => b -> b) -> Args -> Args)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r)
-> (forall u. (forall d. Data d => d -> u) -> Args -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Args -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args -> m Args)
-> Data Args
Args -> DataType
Args -> Constr
(forall b. Data b => b -> b) -> Args -> Args
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
forall u. (forall d. Data d => d -> u) -> Args -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Args -> m Args
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Args)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
$cArgs :: Constr
$tArgs :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapMp :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapM :: (forall d. Data d => d -> m d) -> Args -> m Args
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Args -> m Args
gmapQi :: Int -> (forall d. Data d => d -> u) -> Args -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
gmapQ :: (forall d. Data d => d -> u) -> Args -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Args -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r
gmapT :: (forall b. Data b => b -> b) -> Args -> Args
$cgmapT :: (forall b. Data b => b -> b) -> Args -> Args
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Args)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Args)
dataTypeOf :: Args -> DataType
$cdataTypeOf :: Args -> DataType
toConstr :: Args -> Constr
$ctoConstr :: Args -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Args
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args -> c Args
$cp1Data :: Typeable Args
Data, Typeable)


-- | Parse the CLI arguments with 'System.Console.CmdArgs'.
getArgs :: IO Args
getArgs :: IO Args
getArgs = Args -> IO Args
forall a. Data a => a -> IO a
cmdArgs Args
argSpec


-- | Defines & documents the CLI arguments.
argSpec :: Args
argSpec :: Args
argSpec =
    Args :: Maybe Text -> Maybe Text -> Maybe FilePath -> Maybe Integer -> Args
Args
            { argApiKey :: Maybe Text
argApiKey     = Maybe Text
forall a. Default a => a
def
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"api-key"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"k"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Gemini API Key"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"KEY"
            , argApiSecret :: Maybe Text
argApiSecret  = Maybe Text
forall a. Default a => a
def
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"api-secret"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"s"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Gemini API Secret"
                              Maybe Text -> Ann -> Maybe Text
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"SECRET"
            , argOutputFile :: Maybe FilePath
argOutputFile = Maybe FilePath
forall a. Maybe a
Nothing
                              Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"File to write export to. Default: stdout"
                              Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"o"
                              Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"output-file"
                              Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe FilePath -> Ann -> Maybe FilePath
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"FILE"
            , argYear :: Maybe Integer
argYear       = Maybe Integer
forall a. Maybe a
Nothing
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Limit transactions to given year."
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"y"
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
name FilePath
"year"
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= Ann
explicit
                              Maybe Integer -> Ann -> Maybe Integer
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
typ FilePath
"YYYY"
            }
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
summary
               (  FilePath
"gemini-exports v"
               FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
               FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", Pavan Rikhi 2022"
               )
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
program FilePath
"gemini-exports"
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= [Ann] -> Ann
helpArg [FilePath -> Ann
name FilePath
"h"]
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= FilePath -> Ann
help FilePath
"Generate CSV Exports of your Gemini Trades."
        Args -> Ann -> Args
forall val. Data val => val -> Ann -> val
&= [FilePath] -> Ann
details [FilePath]
programDetails


programDetails :: [String]
programDetails :: [FilePath]
programDetails = FilePath -> [FilePath]
lines [r|
gemini-exports generates a CSV export of your Gemini Trades, Earn
Transactions, & Transfers.


DESCRIPTION

By default, we will pull every single trade, transfer, and income you have
made on Gemini & print them out in chronological order with the following
fields:

   time,base-asset,quote-asset,type,description,price,quantity,total,fee,fee-currency,trade-id

Trades have blank descriptions.

Transfers have blank quote-assets, prices, & fees and potential blank
descriptions.

Earn transactions have blank descriptions & fees and potentially blank
quote-assets, price, & totals.


OUTPUT FILE

You can use the `-o` flag to set the file we will write the CSV data into.
By default, the export is simply printed to stdout.

Warning: the export file will always be overwritten. We do not support
appending to an existing file.


ENVIRONMENTAL VARIABLES

Instead of passing in your API credentials via the `-k` & `-s` CLI flags,
you can set the `$GEMINI_API_KEY` & `$GEMINI_API_SECRET` environmental
variables.


CONFIGURATION FILE

You can also set some program options in a YAML file. We attempt to parse
a configuration file at `$XDG_CONFIG_HOME/gemini-exports/config.yaml`. It
supports the following top-level keys:

    - `api-key`:        (string) Your Gemini API key
    - `api-secret`:     (string) Your Gemini API secret

Environmental variables will override any configuration options, and CLI
flags will override both environmental variables & configuration file
options.


USAGE EXAMPLES

Fetch all my trades, deposits, withdrawals, & earn transactions:
    gemini-exports -k <API_KEY> -s <API_SECRET>

Fetch my Gemini history from 2020:
    gemini-exports -y 2020

Fetch my history from 2022, write them to a file:
    gemini-exports -y 2022 -o 2022-gemini-history.csv
|]