{-# LANGUAGE RecordWildCards #-}

-- | Generate & write/print CoinTracking Bulk Import files.
module Console.BnbStaking.CoinTracking
    ( makeCoinTrackingImport
    , writeOrPrintImportData
    , makeImportData
    , bnb
    ) where

import Control.Monad ((>=>))
import Data.Time (utcToLocalZonedTime)
import Web.CoinTracking.Imports
    ( Amount (..)
    , CTImportData (..)
    , CTTransactionType (Staking)
    , Currency (..)
    , coinTrackingCsvImport
    , writeImportDataToFile
    )

import Console.BnbStaking.Api (Reward (..))

import Data.ByteString.Lazy.Char8 qualified as LBC
import Data.Text qualified as T


-- | Generate the Bulk Import file for CoinTracking & write to destination
-- or print to stdout if destinatin is @"-"@.
makeCoinTrackingImport
    :: FilePath
    -- ^ Destination. @xls@ or @xlsx@ extensions generate the Excel import,
    -- any other extension will generate the CSV import.
    -> String
    -- ^ Account's PubKey
    -> [Reward]
    -> IO ()
makeCoinTrackingImport :: FilePath -> FilePath -> [Reward] -> IO ()
makeCoinTrackingImport FilePath
dest FilePath
pubkey =
    FilePath -> [Reward] -> IO [CTImportData]
makeImportData FilePath
pubkey ([Reward] -> IO [CTImportData])
-> ([CTImportData] -> IO ()) -> [Reward] -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FilePath -> [CTImportData] -> IO ()
writeOrPrintImportData FilePath
dest


-- | Write or print the generated import data.
writeOrPrintImportData :: FilePath -> [CTImportData] -> IO ()
writeOrPrintImportData :: FilePath -> [CTImportData] -> IO ()
writeOrPrintImportData FilePath
dest [CTImportData]
importData =
    if FilePath
dest FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-"
        then ByteString -> IO ()
LBC.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [CTImportData] -> ByteString
coinTrackingCsvImport [CTImportData]
importData
        else FilePath -> [CTImportData] -> IO ()
writeImportDataToFile FilePath
dest [CTImportData]
importData


-- | Turn an account pubkey & reward into a 'CTImportData', localizing the
-- reward time.
makeImportData :: String -> [Reward] -> IO [CTImportData]
makeImportData :: FilePath -> [Reward] -> IO [CTImportData]
makeImportData FilePath
pubkey = (Reward -> IO CTImportData) -> [Reward] -> IO [CTImportData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Reward -> IO CTImportData) -> [Reward] -> IO [CTImportData])
-> (Reward -> IO CTImportData) -> [Reward] -> IO [CTImportData]
forall a b. (a -> b) -> a -> b
$ \Reward {Integer
Text
Scientific
UTCTime
rValidatorName :: Text
rValidatorAddress :: Text
rDelegator :: Text
rChainId :: Text
rHeight :: Integer
rReward :: Scientific
rRewardTime :: UTCTime
rValidatorName :: Reward -> Text
rValidatorAddress :: Reward -> Text
rDelegator :: Reward -> Text
rChainId :: Reward -> Text
rHeight :: Reward -> Integer
rReward :: Reward -> Scientific
rRewardTime :: Reward -> UTCTime
..} -> do
    ZonedTime
zonedTime <- UTCTime -> IO ZonedTime
utcToLocalZonedTime UTCTime
rRewardTime
    CTImportData -> IO CTImportData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        CTImportData
            { ctidType :: CTTransactionType
ctidType = CTTransactionType
Staking
            , ctidBuy :: Maybe Amount
ctidBuy = Amount -> Maybe Amount
forall a. a -> Maybe a
Just (Amount -> Maybe Amount) -> Amount -> Maybe Amount
forall a b. (a -> b) -> a -> b
$ Scientific -> Currency -> Amount
Amount Scientific
rReward Currency
bnb
            , ctidSell :: Maybe Amount
ctidSell = Maybe Amount
forall a. Maybe a
Nothing
            , ctidFee :: Maybe Amount
ctidFee = Maybe Amount
forall a. Maybe a
Nothing
            , ctidExchange :: Text
ctidExchange = Text
"BNB Wallet"
            , ctidGroup :: Text
ctidGroup = Text
"Staking"
            , ctidComment :: Text
ctidComment = Text
"Imported From bnb-staking-csvs"
            , ctidDate :: ZonedTime
ctidDate = ZonedTime
zonedTime
            , ctidTradeId :: Text
ctidTradeId =
                Text
"BNB-STAKE-"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pubkey
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rValidatorAddress
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
rHeight)
            , ctidBuyValue :: Maybe Amount
ctidBuyValue = Maybe Amount
forall a. Maybe a
Nothing
            , ctidSellValue :: Maybe Amount
ctidSellValue = Maybe Amount
forall a. Maybe a
Nothing
            }


-- | Binance Coin currency with the @BNB@ ticker & 8 decimals of precision.
bnb :: Currency
bnb :: Currency
bnb = Int -> Text -> Currency
Currency Int
8 Text
"BNB"