{-# 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 Data.ByteString.Lazy qualified as LBS
import Data.Text qualified 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
$cshowsPrec :: Int -> ExportData -> ShowS
showsPrec :: Int -> ExportData -> ShowS
$cshow :: ExportData -> String
show :: ExportData -> String
$cshowList :: [ExportData] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS ExportData
readsPrec :: Int -> ReadS ExportData
$creadList :: ReadS [ExportData]
readList :: ReadS [ExportData]
$creadPrec :: ReadPrec ExportData
readPrec :: ReadPrec ExportData
$creadListPrec :: ReadPrec [ExportData]
readListPrec :: ReadPrec [ExportData]
Read, ExportData -> ExportData -> Bool
(ExportData -> ExportData -> Bool)
-> (ExportData -> ExportData -> Bool) -> Eq ExportData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportData -> ExportData -> Bool
== :: ExportData -> ExportData -> Bool
$c/= :: ExportData -> ExportData -> Bool
/= :: 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
$ccompare :: ExportData -> ExportData -> Ordering
compare :: ExportData -> ExportData -> Ordering
$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
>= :: ExportData -> ExportData -> Bool
$cmax :: ExportData -> ExportData -> ExportData
max :: ExportData -> ExportData -> ExportData
$cmin :: ExportData -> ExportData -> ExportData
min :: ExportData -> ExportData -> ExportData
Ord)


-- | Remove the @ed@ prefixes from the field names.
instance ToNamedRecord ExportData where
    toNamedRecord :: ExportData -> NamedRecord
toNamedRecord ExportData {Integer
Text
edTime :: ExportData -> Text
edAmount :: ExportData -> Text
edStakeAccount :: ExportData -> Text
edEpoch :: ExportData -> Integer
edTime :: Text
edAmount :: Text
edStakeAccount :: Text
edEpoch :: Integer
..} =
        [(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
_ = [ByteString
Item Header
"time", ByteString
Item Header
"amount", ByteString
Item Header
"stakeAccount", ByteString
Item Header
"epoch"]


-- | Convert an Account & Reward into a CSV row.
toExportData :: (StakingAccount, StakeReward) -> ExportData
toExportData :: (StakingAccount, StakeReward) -> ExportData
toExportData (StakingAccount {Text
Lamports
StakingPubKey
saPubKey :: StakingPubKey
saLamports :: Lamports
saValidatorName :: Text
saPubKey :: StakingAccount -> StakingPubKey
saLamports :: StakingAccount -> Lamports
saValidatorName :: StakingAccount -> Text
..}, StakeReward {Integer
POSIXTime
Lamports
srEpoch :: Integer
srSlot :: Integer
srAmount :: Lamports
srTimestamp :: POSIXTime
srEpoch :: StakeReward -> Integer
srSlot :: StakeReward -> Integer
srAmount :: StakeReward -> Lamports
srTimestamp :: StakeReward -> POSIXTime
..}) =
    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 = 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