{-# LANGUAGE RecordWildCards #-}
{- | CSV serialization of BNB Staking Rewards.
-}
module Console.BnbStaking.Csv
    ( makeCsvContents
    , ExportData(..)
    , convertReward
    , MyZonedTime(..)
    ) where

import           Data.Csv                       ( DefaultOrdered
                                                , ToField(..)
                                                , ToNamedRecord
                                                , encodeDefaultOrderedByName
                                                )
import           Data.Scientific                ( FPFormat(..)
                                                , formatScientific
                                                )
import           Data.Time                      ( ZonedTime(..)
                                                , defaultTimeLocale
                                                , formatTime
                                                , utcToLocalZonedTime
                                                )
import           GHC.Generics                   ( Generic )

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

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


-- | Build the CSV contents for the given rewards, including the header
-- row.
makeCsvContents :: [Reward] -> IO LBS.ByteString
makeCsvContents :: [Reward] -> IO ByteString
makeCsvContents = ([ExportData] -> ByteString) -> IO [ExportData] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ExportData] -> ByteString
forall a. (DefaultOrdered a, ToNamedRecord a) => [a] -> ByteString
encodeDefaultOrderedByName (IO [ExportData] -> IO ByteString)
-> ([Reward] -> IO [ExportData]) -> [Reward] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reward -> IO ExportData) -> [Reward] -> IO [ExportData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Reward -> IO ExportData
convertReward

-- | Datatype representing a single row in the CSV export.
data ExportData = ExportData
    { ExportData -> MyZonedTime
time             :: MyZonedTime
    -- ^ The time of the reward.
    , ExportData -> Text
amount           :: T.Text
    -- ^ The reward amount.
    , ExportData -> Text
currency         :: T.Text
    -- ^ Always @BNB@, but sometimes a useful column for CSV imports.
    , ExportData -> Text
delegator        :: T.Text
    -- ^ The address that was rewarded.
    , ExportData -> Text
validator        :: T.Text
    -- ^ The validator's name.
    , ExportData -> Text
validatorAddress :: T.Text
    -- ^ The address the delegator is validating to.
    , ExportData -> Integer
height           :: Integer
    -- ^ The height of the reward's block.
    }
    deriving (Int -> ExportData -> ShowS
[ExportData] -> ShowS
ExportData -> String
(Int -> ExportData -> ShowS)
-> (ExportData -> String)
-> ([ExportData] -> ShowS)
-> Show ExportData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportData] -> ShowS
$cshowList :: [ExportData] -> ShowS
show :: ExportData -> String
$cshow :: ExportData -> String
showsPrec :: Int -> ExportData -> ShowS
$cshowsPrec :: Int -> ExportData -> ShowS
Show, ReadPrec [ExportData]
ReadPrec ExportData
Int -> ReadS ExportData
ReadS [ExportData]
(Int -> ReadS ExportData)
-> ReadS [ExportData]
-> ReadPrec ExportData
-> ReadPrec [ExportData]
-> Read ExportData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportData]
$creadListPrec :: ReadPrec [ExportData]
readPrec :: ReadPrec ExportData
$creadPrec :: ReadPrec ExportData
readList :: ReadS [ExportData]
$creadList :: ReadS [ExportData]
readsPrec :: Int -> ReadS ExportData
$creadsPrec :: Int -> ReadS ExportData
Read, (forall x. ExportData -> Rep ExportData x)
-> (forall x. Rep ExportData x -> ExportData) -> Generic ExportData
forall x. Rep ExportData x -> ExportData
forall x. ExportData -> Rep ExportData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportData x -> ExportData
$cfrom :: forall x. ExportData -> Rep ExportData x
Generic)

instance ToNamedRecord ExportData
instance DefaultOrdered ExportData

-- | Render a 'Reward' into our target export data by converting to
-- localtime(respecting DST), & formatting the amount column to 8 decimal
-- places.
convertReward :: Reward -> IO ExportData
convertReward :: Reward -> IO ExportData
convertReward Reward {Integer
Scientific
UTCTime
Text
rRewardTime :: Reward -> UTCTime
rReward :: Reward -> Scientific
rHeight :: Reward -> Integer
rChainId :: Reward -> Text
rDelegator :: Reward -> Text
rValidatorAddress :: Reward -> Text
rValidatorName :: Reward -> Text
rRewardTime :: UTCTime
rReward :: Scientific
rHeight :: Integer
rChainId :: Text
rDelegator :: Text
rValidatorAddress :: Text
rValidatorName :: Text
..} = do
    ZonedTime
localRewardTime <- UTCTime -> IO ZonedTime
utcToLocalZonedTime UTCTime
rRewardTime
    ExportData -> IO ExportData
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportData -> IO ExportData) -> ExportData -> IO ExportData
forall a b. (a -> b) -> a -> b
$ ExportData :: MyZonedTime
-> Text -> Text -> Text -> Text -> Text -> Integer -> ExportData
ExportData
        { time :: MyZonedTime
time             = ZonedTime -> MyZonedTime
MyZonedTime ZonedTime
localRewardTime
        , amount :: Text
amount           = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Scientific
rReward
        , currency :: Text
currency         = Text
"BNB"
        , delegator :: Text
delegator        = Text
rDelegator
        , validator :: Text
validator        = Text
rValidatorName
        , validatorAddress :: Text
validatorAddress = Text
rValidatorAddress
        , height :: Integer
height           = Integer
rHeight
        }

-- | Wrapper type to support custom 'ToField' instance.
newtype MyZonedTime = MyZonedTime { MyZonedTime -> ZonedTime
fromMyZonedTime :: ZonedTime } deriving (Int -> MyZonedTime -> ShowS
[MyZonedTime] -> ShowS
MyZonedTime -> String
(Int -> MyZonedTime -> ShowS)
-> (MyZonedTime -> String)
-> ([MyZonedTime] -> ShowS)
-> Show MyZonedTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MyZonedTime] -> ShowS
$cshowList :: [MyZonedTime] -> ShowS
show :: MyZonedTime -> String
$cshow :: MyZonedTime -> String
showsPrec :: Int -> MyZonedTime -> ShowS
$cshowsPrec :: Int -> MyZonedTime -> ShowS
Show, ReadPrec [MyZonedTime]
ReadPrec MyZonedTime
Int -> ReadS MyZonedTime
ReadS [MyZonedTime]
(Int -> ReadS MyZonedTime)
-> ReadS [MyZonedTime]
-> ReadPrec MyZonedTime
-> ReadPrec [MyZonedTime]
-> Read MyZonedTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MyZonedTime]
$creadListPrec :: ReadPrec [MyZonedTime]
readPrec :: ReadPrec MyZonedTime
$creadPrec :: ReadPrec MyZonedTime
readList :: ReadS [MyZonedTime]
$creadList :: ReadS [MyZonedTime]
readsPrec :: Int -> ReadS MyZonedTime
$creadsPrec :: Int -> ReadS MyZonedTime
Read)

-- | Render with @%FT%T%Q%Ez@ formatting string.
instance ToField MyZonedTime where
    toField :: MyZonedTime -> Field
toField (MyZonedTime ZonedTime
zt) =
        String -> Field
forall a. ToField a => a -> Field
toField (String -> Field) -> String -> Field
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%T%Q%Ez" ZonedTime
zt