{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{- | CLI application harness.
-}
module Console.Binance.Exports.Main
    ( run
    , getArgs
    , Args(..)
    , loadConfigFile
    , ConfigFile(..)
    ) where

import           Control.Applicative            ( (<|>) )
import           Control.Exception.Safe         ( try )
import           Control.Monad                  ( (<=<) )
import           Control.Monad.IO.Class         ( liftIO )
import           Data.Aeson                     ( (.:?)
                                                , FromJSON(..)
                                                , withObject
                                                )
import           Data.List                      ( sortOn )
import           Data.Maybe                     ( fromMaybe )
import           Data.Ord                       ( Down(..) )
import           Data.Time                      ( UTCTime(..)
                                                , toGregorian
                                                )
import           Data.Time.Clock.POSIX          ( posixSecondsToUTCTime )
import           Data.Version                   ( showVersion )
import           Data.Yaml                      ( prettyPrintParseException )
import           Data.Yaml.Config               ( ignoreEnv
                                                , loadYamlSettings
                                                )
import           System.Console.CmdArgs         ( (&=)
                                                , Data
                                                , Typeable
                                                , args
                                                , 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.Binance.Exports.Csv
import           Paths_binance_exports          ( version )
import           Web.Binance

import qualified Data.ByteString.Lazy.Char8    as LBS
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T


-- | Generate & print a trade export based on the executable arguments.
run :: ConfigFile -> Args -> IO ()
run :: ConfigFile -> Args -> IO ()
run ConfigFile
cfg Args
cfgArgs = do
    AppConfig {[Text]
Maybe Integer
Maybe FilePath
BinanceConfig
outputFile :: AppConfig -> Maybe FilePath
year :: AppConfig -> Maybe Integer
symbols :: AppConfig -> [Text]
binanceCfg :: AppConfig -> BinanceConfig
outputFile :: Maybe FilePath
year :: Maybe Integer
symbols :: [Text]
binanceCfg :: BinanceConfig
..} <- ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs ConfigFile
cfg Args
cfgArgs
    [TradeExportData]
results        <- forall a. BinanceConfig -> BinanceApiM a -> IO a
runApi BinanceConfig
binanceCfg forall a b. (a -> b) -> a -> b
$ do
        [SymbolDetails]
symbolDetails <-
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExchangeInfo -> [SymbolDetails]
eiSymbols forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadHttp m, MonadCatch m) =>
[Text] -> m (Either BinanceError ExchangeInfo)
getExchangeInfo [Text]
symbols forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Either BinanceError a -> BinanceApiM a
handleBinanceError
        [TradeExportData]
rawExportData <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SymbolDetails -> BinanceApiM [TradeExportData]
getTradesForSymbol [SymbolDetails]
symbolDetails
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Integer -> [TradeExportData] -> [TradeExportData]
filterYear Maybe Integer
year forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trade -> POSIXTime
tTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. TradeExportData -> Trade
tedTrade)
                                          [TradeExportData]
rawExportData
    -- Write CSV to file or stdout
    let outputFileOrStdout :: FilePath
outputFileOrStdout = forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" Maybe FilePath
outputFile
    let output :: ByteString
output             = [TradeExportData] -> ByteString
buildTradeExport [TradeExportData]
results
    if FilePath
outputFileOrStdout forall a. Eq a => a -> a -> Bool
== FilePath
"-"
        then ByteString -> IO ()
LBS.putStr ByteString
output
        else FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
outputFileOrStdout ByteString
output
  where
    -- | If an error is present, print the code & message to stderr, then
    -- exit with an error status code.
    handleBinanceError :: Either BinanceError a -> BinanceApiM a
    handleBinanceError :: forall a. Either BinanceError a -> BinanceApiM a
handleBinanceError = \case
        Left BinanceError
e ->
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall a b. (a -> b) -> a -> b
$  forall a. Text -> IO a
exitWithErr
                forall a b. (a -> b) -> a -> b
$  Text
"Binance API Error Code "
                forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ BinanceError -> Int
beCode BinanceError
e)
                forall a. Semigroup a => a -> a -> a
<> Text
": "
                forall a. Semigroup a => a -> a -> a
<> BinanceError -> Text
beMsg BinanceError
e
        Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    -- | Get all trades for the given symbol & convert them into the export
    -- format.
    getTradesForSymbol :: SymbolDetails -> BinanceApiM [TradeExportData]
    getTradesForSymbol :: SymbolDetails -> BinanceApiM [TradeExportData]
getTradesForSymbol SymbolDetails
s =
        forall a b. (a -> b) -> [a] -> [b]
map (SymbolDetails -> Trade -> TradeExportData
TradeExportData SymbolDetails
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadHttp m, MonadReader BinanceConfig m) =>
Text -> Maybe UTCTime -> Maybe UTCTime -> m [Trade]
getTradeHistory (SymbolDetails -> Text
sdSymbol SymbolDetails
s) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    -- | Filter the trades if a 'year' argument has been passed.
    filterYear :: Maybe Integer -> [TradeExportData] -> [TradeExportData]
    filterYear :: Maybe Integer -> [TradeExportData] -> [TradeExportData]
filterYear = \case
        Maybe Integer
Nothing -> forall a. a -> a
id
        Just Integer
y ->
            forall a. (a -> Bool) -> [a] -> [a]
filter
                forall a b. (a -> b) -> a -> b
$ (\(Integer
y_, Int
_, Int
_) -> Integer
y forall a. Eq a => a -> a -> Bool
== Integer
y_)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trade -> POSIXTime
tTime
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. TradeExportData -> Trade
tedTrade

-- | Print some error text to 'stderr', then exit with a failure code.
exitWithErr :: T.Text -> IO a
exitWithErr :: forall a. Text -> IO a
exitWithErr = forall a b. a -> b -> a
const forall a. IO a
exitFailure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"[ERROR] " forall a. Semigroup a => a -> a -> a
<>)


-- CONFIGURATION

data AppConfig = AppConfig
    { AppConfig -> BinanceConfig
binanceCfg :: BinanceConfig
    , AppConfig -> [Text]
symbols    :: [T.Text]
    , AppConfig -> Maybe Integer
year       :: Maybe Integer
    , AppConfig -> Maybe FilePath
outputFile :: Maybe FilePath
    }
    deriving (Int -> AppConfig -> ShowS
[AppConfig] -> ShowS
AppConfig -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AppConfig] -> ShowS
$cshowList :: [AppConfig] -> ShowS
show :: AppConfig -> FilePath
$cshow :: AppConfig -> FilePath
showsPrec :: Int -> AppConfig -> ShowS
$cshowsPrec :: Int -> AppConfig -> ShowS
Show, AppConfig -> AppConfig -> Bool
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)

-- | Given a parsed configuration file & CLI arguments, check for
-- environmental variables and either build an AppConfig or log an error
-- & exit if no API credentials or symbols have been passed.
mergeCfgEnvArgs :: ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs :: ConfigFile -> Args -> IO AppConfig
mergeCfgEnvArgs ConfigFile {Maybe [Text]
Maybe Text
cfgSymbols :: ConfigFile -> Maybe [Text]
cfgApiSecret :: ConfigFile -> Maybe Text
cfgApiKey :: ConfigFile -> Maybe Text
cfgSymbols :: Maybe [Text]
cfgApiSecret :: Maybe Text
cfgApiKey :: Maybe Text
..} Args {[Text]
Maybe Integer
Maybe FilePath
Maybe Text
argOutputFile :: Args -> Maybe FilePath
argYear :: Args -> Maybe Integer
argSymbols :: Args -> [Text]
argApiSecret :: Args -> Maybe Text
argApiKey :: Args -> Maybe Text
argOutputFile :: Maybe FilePath
argYear :: Maybe Integer
argSymbols :: [Text]
argApiSecret :: Maybe Text
argApiKey :: Maybe Text
..} = do
    Maybe Text
envApiKey    <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"BINANCE_API_KEY"
    Maybe Text
envApiSecret <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"BINANCE_API_SECRET"
    Text
apiKey       <-
        forall a. Text -> Maybe a -> IO a
requiredValue Text
"Pass a Binance API Key with `-k` or $BINANCE_API_KEY."
        forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiKey
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiKey
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiKey
    Text
apiSecret <-
        forall a. Text -> Maybe a -> IO a
requiredValue
            Text
"Pass a Binance API Secret with `-s` or $BINANCE_API_SECRET."
        forall a b. (a -> b) -> a -> b
$   Maybe Text
argApiSecret
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envApiSecret
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
cfgApiSecret
    let binanceCfg :: BinanceConfig
binanceCfg =
            BinanceConfig { bcApiKey :: Text
bcApiKey = Text
apiKey, bcApiSecret :: Text
bcApiSecret = Text
apiSecret }
    [Text]
symbols <- case ([Text]
argSymbols, forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
cfgSymbols) of
        ([], []) -> forall a. Text -> IO a
exitWithErr Text
"Pass at least one symbol."
        ([], [Text]
s ) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
s
        ([Text]
s , [Text]
_ ) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
s
    forall (m :: * -> *) a. Monad m => a -> m a
return AppConfig { year :: Maybe Integer
year = Maybe Integer
argYear, outputFile :: Maybe FilePath
outputFile = Maybe FilePath
argOutputFile, [Text]
BinanceConfig
symbols :: [Text]
binanceCfg :: BinanceConfig
symbols :: [Text]
binanceCfg :: BinanceConfig
.. }
  where
    requiredValue :: T.Text -> Maybe a -> IO a
    requiredValue :: forall a. Text -> Maybe a -> IO a
requiredValue Text
errMsg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Text -> IO a
exitWithErr Text
errMsg) forall (m :: * -> *) a. Monad m => a -> m a
return


-- CONFIG FILE

-- | Optional configuration data parsed from the config file.
data ConfigFile = ConfigFile
    { ConfigFile -> Maybe Text
cfgApiKey    :: Maybe T.Text
    , ConfigFile -> Maybe Text
cfgApiSecret :: Maybe T.Text
    , ConfigFile -> Maybe [Text]
cfgSymbols   :: Maybe [T.Text]
    }
    deriving (Int -> ConfigFile -> ShowS
[ConfigFile] -> ShowS
ConfigFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigFile] -> ShowS
$cshowList :: [ConfigFile] -> ShowS
show :: ConfigFile -> FilePath
$cshow :: ConfigFile -> FilePath
showsPrec :: Int -> ConfigFile -> ShowS
$cshowsPrec :: Int -> ConfigFile -> ShowS
Show, ConfigFile -> ConfigFile -> Bool
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)

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

-- | Attempt to read a 'ConfigFile' from
-- @$XDG_CONFIG_HOME\/binance-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
"binance-exports" FilePath
"config.yaml"
    Bool
configExists <- FilePath -> IO Bool
doesFileExist FilePath
configPath
    if Bool
configExists
        then forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (forall settings.
FromJSON settings =>
[FilePath] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [FilePath
configPath] [] EnvUsage
ignoreEnv) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left (FilePath -> [FilePath]
lines 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:"
                    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"\t" forall a. Semigroup a => a -> a -> a
<>)) [FilePath]
errorMsgs
                    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
            Right ConfigFile
cfg -> forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
cfg
        else forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile
defaultConfig
  where
    defaultConfig :: ConfigFile
    defaultConfig :: ConfigFile
defaultConfig = Maybe Text -> Maybe Text -> Maybe [Text] -> ConfigFile
ConfigFile forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing


-- CLI ARGS

-- | CLI arguments supported by the executable.
data Args = Args
    { Args -> Maybe Text
argApiKey     :: Maybe T.Text
    , Args -> Maybe Text
argApiSecret  :: Maybe T.Text
    , Args -> [Text]
argSymbols    :: [T.Text]
    , Args -> Maybe Integer
argYear       :: Maybe Integer
    , Args -> Maybe FilePath
argOutputFile :: Maybe FilePath
    }
    deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> FilePath
$cshow :: Args -> FilePath
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show, ReadPrec [Args]
ReadPrec Args
Int -> ReadS Args
ReadS [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
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
Args -> DataType
Args -> Constr
(forall b. Data b => b -> b) -> Args -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Args -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Args -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Args -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable)


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


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


programDetails :: [String]
programDetails :: [FilePath]
programDetails = FilePath -> [FilePath]
lines [r|
binance-exports generates a CSV export of your Binances Trade History. It
is intended to replace Binance's (removed) Trade History export.


DESCRIPTION

By default, we will pull every single trade you have made for the passed
symbols & print them out in reverse-chronological order with the following
fields:

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

This closely matches Binance's Trade History export, except we've split the
`symbol` column into `base-asset` & `quote-asset` columns and include the
`trade-id`.


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 `$BINANCE_API_KEY` & `$BINANCE_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/binance-exports/config.yaml`. It
supports the following top-level keys:

    - `api-key`:        (string) Your Binance API key
    - `api-secret`:     (string) Your Binance API secret
    - `symbols`:        (list of strings) The trade symbols to fetch

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


USAGE EXAMPLES

Fetch all my BNB trades:
    binance-exports BNBUSD

Fetch my BTC trades from 2020:
    binance-exports -y 2020 BTCUSD

Fetch my BNB & BTC trades from 2022, write them to a file:
    binance-exports -y 2022 -o 2022-binance-trades.csv BNBUSD BTCUSD
|]