{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-| Types responsible for CSV generation.

-}
module Console.SolanaStaking.Csv
    ( makeCsvContents
    , ExportData(..)
    , toExportData
    ) where

import           Data.Csv                       ( (.=)
                                                , DefaultOrdered(..)
                                                , EncodeOptions(..)
                                                , ToNamedRecord(..)
                                                , defaultEncodeOptions
                                                , encodeDefaultOrderedByNameWith
                                                , namedRecord
                                                )
import           Data.Time                      ( defaultTimeLocale
                                                , formatTime
                                                )
import           Data.Time.Clock.POSIX          ( POSIXTime
                                                , posixSecondsToUTCTime
                                                )

import           Console.SolanaStaking.Api      ( StakeReward(..)
                                                , StakingAccount(..)
                                                , StakingPubKey(..)
                                                , renderLamports
                                                )

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


-- | Represents a single row of CSV data.
data ExportData = ExportData
    { ExportData -> Text
edTime         :: T.Text
    , ExportData -> Text
edAmount       :: T.Text
    , ExportData -> Text
edStakeAccount :: T.Text
    , ExportData -> Integer
edEpoch        :: Integer
    }
    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, ExportData -> ExportData -> Bool
(ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> Bool) -> Eq ExportData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportData -> ExportData -> Bool
$c/= :: ExportData -> ExportData -> Bool
== :: ExportData -> ExportData -> Bool
$c== :: ExportData -> ExportData -> Bool
Eq, Eq ExportData
Eq ExportData
-> (ExportData -> ExportData -> Ordering)
-> (ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> ExportData)
-> (ExportData -> ExportData -> ExportData)
-> Ord ExportData
ExportData -> ExportData -> Bool
ExportData -> ExportData -> Ordering
ExportData -> ExportData -> ExportData
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 :: ExportData -> ExportData -> ExportData
$cmin :: ExportData -> ExportData -> ExportData
max :: ExportData -> ExportData -> ExportData
$cmax :: ExportData -> ExportData -> ExportData
>= :: ExportData -> ExportData -> Bool
$c>= :: ExportData -> ExportData -> Bool
> :: ExportData -> ExportData -> Bool
$c> :: ExportData -> ExportData -> Bool
<= :: ExportData -> ExportData -> Bool
$c<= :: ExportData -> ExportData -> Bool
< :: ExportData -> ExportData -> Bool
$c< :: ExportData -> ExportData -> Bool
compare :: ExportData -> ExportData -> Ordering
$ccompare :: ExportData -> ExportData -> Ordering
$cp1Ord :: Eq ExportData
Ord)

-- | Remove the @ed@ prefixes from the field names.
instance ToNamedRecord ExportData where
    toNamedRecord :: ExportData -> NamedRecord
toNamedRecord ExportData {Integer
Text
edEpoch :: Integer
edStakeAccount :: Text
edAmount :: Text
edTime :: Text
edEpoch :: ExportData -> Integer
edStakeAccount :: ExportData -> Text
edAmount :: ExportData -> Text
edTime :: ExportData -> Text
..} = [(ByteString, ByteString)] -> NamedRecord
namedRecord
        [ ByteString
"time" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
edTime
        , ByteString
"amount" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
edAmount
        , ByteString
"stakeAccount" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
edStakeAccount
        , ByteString
"epoch" ByteString -> Integer -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Integer
edEpoch
        ]

-- | Column order is @time, amount, stakeAccount, epoch@.
instance DefaultOrdered ExportData where
    headerOrder :: ExportData -> Header
headerOrder ExportData
_ = [Item Header
"time", Item Header
"amount", Item Header
"stakeAccount", Item Header
"epoch"]

-- | Convert an Account & Reward into a CSV row.
toExportData :: (StakingAccount, StakeReward) -> ExportData
toExportData :: (StakingAccount, StakeReward) -> ExportData
toExportData (StakingAccount {Text
Lamports
StakingPubKey
saValidatorName :: StakingAccount -> Text
saLamports :: StakingAccount -> Lamports
saPubKey :: StakingAccount -> StakingPubKey
saValidatorName :: Text
saLamports :: Lamports
saPubKey :: StakingPubKey
..}, StakeReward {Integer
POSIXTime
Lamports
srTimestamp :: StakeReward -> POSIXTime
srAmount :: StakeReward -> Lamports
srSlot :: StakeReward -> Integer
srEpoch :: StakeReward -> Integer
srTimestamp :: POSIXTime
srAmount :: Lamports
srSlot :: Integer
srEpoch :: Integer
..}) = ExportData :: Text -> Text -> Text -> Integer -> ExportData
ExportData
    { edTime :: Text
edTime         = POSIXTime -> Text
formatTimestamp POSIXTime
srTimestamp
    , edAmount :: Text
edAmount       = Lamports -> Text
renderLamports Lamports
srAmount
    , edStakeAccount :: Text
edStakeAccount = StakingPubKey -> Text
fromStakingPubKey StakingPubKey
saPubKey
    , edEpoch :: Integer
edEpoch        = Integer
srEpoch
    }
  where
    formatTimestamp :: POSIXTime -> T.Text
    formatTimestamp :: POSIXTime -> Text
formatTimestamp =
        String -> Text
T.pack (String -> Text) -> (POSIXTime -> String) -> POSIXTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T%Z" (UTCTime -> String)
-> (POSIXTime -> UTCTime) -> POSIXTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime

-- | Build the CSV contents with a header row.
makeCsvContents :: [(StakingAccount, StakeReward)] -> LBS.ByteString
makeCsvContents :: [(StakingAccount, StakeReward)] -> ByteString
makeCsvContents =
    EncodeOptions -> [ExportData] -> ByteString
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
EncodeOptions -> [a] -> ByteString
encodeDefaultOrderedByNameWith EncodeOptions
defaultEncodeOptions { encUseCrLf :: Bool
encUseCrLf = Bool
False }
        ([ExportData] -> ByteString)
-> ([(StakingAccount, StakeReward)] -> [ExportData])
-> [(StakingAccount, StakeReward)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StakingAccount, StakeReward) -> ExportData)
-> [(StakingAccount, StakeReward)] -> [ExportData]
forall a b. (a -> b) -> [a] -> [b]
map (StakingAccount, StakeReward) -> ExportData
toExportData