{-# LANGUAGE RecordWildCards #-}
{-| Types & functions for converting Gemini API responses into CSV exports.
-}
module Console.Gemini.Exports.Csv
    ( ExportData(..)
    , makeExportData
    , makeExportCsv
    , ExportLine(..)
    , getExportLineTimestamp
    ) where
import           Control.Applicative            ( (<|>) )
import           Control.Monad.IO.Class         ( MonadIO(..) )
import           Data.Csv                       ( (.=)
                                                , DefaultOrdered(..)
                                                , ToNamedRecord(..)
                                                , defaultEncodeOptions
                                                , encUseCrLf
                                                , encodeDefaultOrderedByNameWith
                                                , header
                                                , namedRecord
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Data.Scientific                ( FPFormat(Fixed)
                                                , Scientific
                                                , formatScientific
                                                )
import           Data.Text                      ( Text
                                                , empty
                                                , pack
                                                )
import           Data.Time                      ( TimeZone
                                                , defaultTimeLocale
                                                , formatTime
                                                , getTimeZone
                                                , utcToZonedTime
                                                )
import           Data.Time.Clock.POSIX          ( POSIXTime
                                                , posixSecondsToUTCTime
                                                )

import           Web.Gemini

import qualified Data.ByteString.Lazy.Char8    as LBS


-- | The data required for rendering a single CSV row.
data ExportData = ExportData
    { ExportData -> TimeZone
edTZ   :: TimeZone
    , ExportData -> ExportLine
edLine :: ExportLine
    }
    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)

instance DefaultOrdered ExportData where
    headerOrder :: ExportData -> Header
headerOrder ExportData
_ = [ByteString] -> Header
header
        [ ByteString
"time"
        , ByteString
"base-asset"
        , ByteString
"quote-asset"
        , ByteString
"type"
        , ByteString
"description"
        , ByteString
"price"
        , ByteString
"quantity"
        , ByteString
"total"
        , ByteString
"fee"
        , ByteString
"fee-currency"
        , ByteString
"trade-id"
        ]

instance ToNamedRecord ExportData where
    toNamedRecord :: ExportData -> NamedRecord
toNamedRecord (ExportData TimeZone
tz ExportLine
lineData) = [(ByteString, ByteString)] -> NamedRecord
namedRecord ([(ByteString, ByteString)] -> NamedRecord)
-> [(ByteString, ByteString)] -> NamedRecord
forall a b. (a -> b) -> a -> b
$ case ExportLine
lineData of
        TradeExport Trade {Bool
Integer
Scientific
Text
POSIXTime
tOrderId :: Trade -> Text
tTimestamp :: Trade -> POSIXTime
tIsAggressor :: Trade -> Bool
tIsBuy :: Trade -> Bool
tFeeAmount :: Trade -> Scientific
tFeeCurrency :: Trade -> Text
tAmount :: Trade -> Scientific
tPrice :: Trade -> Scientific
tSymbol :: Trade -> Text
tId :: Trade -> Integer
tOrderId :: Text
tTimestamp :: POSIXTime
tIsAggressor :: Bool
tIsBuy :: Bool
tFeeAmount :: Scientific
tFeeCurrency :: Text
tAmount :: Scientific
tPrice :: Scientific
tSymbol :: Text
tId :: Integer
..} SymbolDetails {Scientific
Text
sdQuotePrecision :: SymbolDetails -> Scientific
sdQuoteCurrency :: SymbolDetails -> Text
sdBasePrecision :: SymbolDetails -> Scientific
sdBaseCurrency :: SymbolDetails -> Text
sdSymbol :: SymbolDetails -> Text
sdQuotePrecision :: Scientific
sdQuoteCurrency :: Text
sdBasePrecision :: Scientific
sdBaseCurrency :: Text
sdSymbol :: Text
..} ->
            [ ByteString
"time" ByteString -> String -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= POSIXTime -> String
formatTimestamp POSIXTime
tTimestamp
            , ByteString
"base-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
sdBaseCurrency
            , ByteString
"quote-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
sdQuoteCurrency
            , ByteString
"type" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= if Bool
tIsBuy then Text
"Buy" else (Text
"Sell" :: Text)
            , ByteString
"description" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"price" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
tPrice
            , ByteString
"quantity" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
tAmount
            , ByteString
"total" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal (Scientific
tPrice Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
tAmount)
            , ByteString
"fee" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
tFeeAmount
            , ByteString
"fee-currency" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
tFeeCurrency
            , ByteString
"trade-id" ByteString -> Integer -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Integer
tId
            ]
        TransferExport Transfer {Integer
Maybe Text
Scientific
Text
POSIXTime
trTimestamp :: Transfer -> POSIXTime
trPurpose :: Transfer -> Maybe Text
trMethod :: Transfer -> Maybe Text
trAmount :: Transfer -> Scientific
trCurrency :: Transfer -> Text
trStatus :: Transfer -> Text
trType :: Transfer -> Text
trId :: Transfer -> Integer
trTimestamp :: POSIXTime
trPurpose :: Maybe Text
trMethod :: Maybe Text
trAmount :: Scientific
trCurrency :: Text
trStatus :: Text
trType :: Text
trId :: Integer
..} ->
            [ ByteString
"time" ByteString -> String -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= POSIXTime -> String
formatTimestamp POSIXTime
trTimestamp
            , ByteString
"base-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
trCurrency
            , ByteString
"quote-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"type" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
trType
            , ByteString
"description" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= (Maybe Text, Maybe Text) -> Text
toDescr (Maybe Text
trMethod, Maybe Text
trPurpose)
            , ByteString
"price" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"quantity" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
trAmount
            , ByteString
"total" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
trAmount
            , ByteString
"fee" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"fee-currency" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"trade-id" ByteString -> Integer -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Integer
trId
            ]
        EarnExport EarnTransaction {Maybe Scientific
Maybe Text
Scientific
Text
POSIXTime
etTimestamp :: EarnTransaction -> POSIXTime
etPrice :: EarnTransaction -> Maybe Scientific
etPriceCurrency :: EarnTransaction -> Maybe Text
etAmount :: EarnTransaction -> Scientific
etAmountCurrency :: EarnTransaction -> Text
etType :: EarnTransaction -> Text
etId :: EarnTransaction -> Text
etTimestamp :: POSIXTime
etPrice :: Maybe Scientific
etPriceCurrency :: Maybe Text
etAmount :: Scientific
etAmountCurrency :: Text
etType :: Text
etId :: Text
..} ->
            [ ByteString
"time" ByteString -> String -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= POSIXTime -> String
formatTimestamp POSIXTime
etTimestamp
            , ByteString
"base-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
etAmountCurrency
            , ByteString
"quote-asset" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
empty Maybe Text
etPriceCurrency
            , ByteString
"type" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= (Text
"Earn " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
etType)
            , ByteString
"description" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"price" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text -> (Scientific -> Text) -> Maybe Scientific -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
empty Scientific -> Text
formatDecimal Maybe Scientific
etPrice
            , ByteString
"quantity" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Scientific -> Text
formatDecimal Scientific
etAmount
            , ByteString
"total" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text -> (Scientific -> Text) -> Maybe Scientific -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
empty (Scientific -> Text
formatDecimal (Scientific -> Text)
-> (Scientific -> Scientific) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
etAmount)) Maybe Scientific
etPrice
            , ByteString
"fee" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"fee-currency" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
empty
            , ByteString
"trade-id" ByteString -> Text -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Text
etId
            ]
      where
        -- Render a transfer description by combining the optional method
        -- & purpose fields.
        toDescr :: (Maybe Text, Maybe Text) -> Text
        toDescr :: (Maybe Text, Maybe Text) -> Text
toDescr = \case
            (Just Text
m, Just Text
p) -> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
            (Maybe Text
m     , Maybe Text
p     ) -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
m Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
p
        -- Convert a timestamp into a localtime with the line's timezone
        -- & render it in `YYYY-MM-DD HH:MM:SS.nnnnnnnnn` format.`
        formatTimestamp :: POSIXTime -> String
        formatTimestamp :: POSIXTime -> String
formatTimestamp =
            TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q"
                (ZonedTime -> String)
-> (POSIXTime -> ZonedTime) -> POSIXTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz
                (UTCTime -> ZonedTime)
-> (POSIXTime -> UTCTime) -> POSIXTime -> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
        -- Render a decimal number with the minimum precision neccesary..
        formatDecimal :: Scientific -> Text
        formatDecimal :: Scientific -> Text
formatDecimal = String -> Text
pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing

-- | Determine the 'TimeZone' for the 'ExportLine' & return both as an
-- 'ExportData'.
makeExportData :: MonadIO m => ExportLine -> m ExportData
makeExportData :: ExportLine -> m ExportData
makeExportData ExportLine
lineData = do
    TimeZone
tz <- IO TimeZone -> m TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeZone -> m TimeZone)
-> (POSIXTime -> IO TimeZone) -> POSIXTime -> m TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> IO TimeZone
getTimeZone (UTCTime -> IO TimeZone)
-> (POSIXTime -> UTCTime) -> POSIXTime -> IO TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> m TimeZone) -> POSIXTime -> m TimeZone
forall a b. (a -> b) -> a -> b
$ ExportLine -> POSIXTime
getExportLineTimestamp
        ExportLine
lineData
    ExportData -> m ExportData
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportData -> m ExportData) -> ExportData -> m ExportData
forall a b. (a -> b) -> a -> b
$ TimeZone -> ExportLine -> ExportData
ExportData TimeZone
tz ExportLine
lineData

-- | Render the export data as a CSV with a header row.
makeExportCsv :: [ExportData] -> LBS.ByteString
makeExportCsv :: [ExportData] -> ByteString
makeExportCsv =
    EncodeOptions -> [ExportData] -> ByteString
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
EncodeOptions -> [a] -> ByteString
encodeDefaultOrderedByNameWith (EncodeOptions
defaultEncodeOptions { encUseCrLf :: Bool
encUseCrLf = Bool
False })


-- | Split out the data required for different export line types.
data ExportLine
    = TradeExport Trade SymbolDetails
    | TransferExport Transfer
    | EarnExport EarnTransaction
    deriving (Int -> ExportLine -> ShowS
[ExportLine] -> ShowS
ExportLine -> String
(Int -> ExportLine -> ShowS)
-> (ExportLine -> String)
-> ([ExportLine] -> ShowS)
-> Show ExportLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportLine] -> ShowS
$cshowList :: [ExportLine] -> ShowS
show :: ExportLine -> String
$cshow :: ExportLine -> String
showsPrec :: Int -> ExportLine -> ShowS
$cshowsPrec :: Int -> ExportLine -> ShowS
Show, ReadPrec [ExportLine]
ReadPrec ExportLine
Int -> ReadS ExportLine
ReadS [ExportLine]
(Int -> ReadS ExportLine)
-> ReadS [ExportLine]
-> ReadPrec ExportLine
-> ReadPrec [ExportLine]
-> Read ExportLine
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportLine]
$creadListPrec :: ReadPrec [ExportLine]
readPrec :: ReadPrec ExportLine
$creadPrec :: ReadPrec ExportLine
readList :: ReadS [ExportLine]
$creadList :: ReadS [ExportLine]
readsPrec :: Int -> ReadS ExportLine
$creadsPrec :: Int -> ReadS ExportLine
Read, ExportLine -> ExportLine -> Bool
(ExportLine -> ExportLine -> Bool)
-> (ExportLine -> ExportLine -> Bool) -> Eq ExportLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportLine -> ExportLine -> Bool
$c/= :: ExportLine -> ExportLine -> Bool
== :: ExportLine -> ExportLine -> Bool
$c== :: ExportLine -> ExportLine -> Bool
Eq, Eq ExportLine
Eq ExportLine
-> (ExportLine -> ExportLine -> Ordering)
-> (ExportLine -> ExportLine -> Bool)
-> (ExportLine -> ExportLine -> Bool)
-> (ExportLine -> ExportLine -> Bool)
-> (ExportLine -> ExportLine -> Bool)
-> (ExportLine -> ExportLine -> ExportLine)
-> (ExportLine -> ExportLine -> ExportLine)
-> Ord ExportLine
ExportLine -> ExportLine -> Bool
ExportLine -> ExportLine -> Ordering
ExportLine -> ExportLine -> ExportLine
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 :: ExportLine -> ExportLine -> ExportLine
$cmin :: ExportLine -> ExportLine -> ExportLine
max :: ExportLine -> ExportLine -> ExportLine
$cmax :: ExportLine -> ExportLine -> ExportLine
>= :: ExportLine -> ExportLine -> Bool
$c>= :: ExportLine -> ExportLine -> Bool
> :: ExportLine -> ExportLine -> Bool
$c> :: ExportLine -> ExportLine -> Bool
<= :: ExportLine -> ExportLine -> Bool
$c<= :: ExportLine -> ExportLine -> Bool
< :: ExportLine -> ExportLine -> Bool
$c< :: ExportLine -> ExportLine -> Bool
compare :: ExportLine -> ExportLine -> Ordering
$ccompare :: ExportLine -> ExportLine -> Ordering
$cp1Ord :: Eq ExportLine
Ord)

-- | Get the timestamp field of an 'ExportLine'.
getExportLineTimestamp :: ExportLine -> POSIXTime
getExportLineTimestamp :: ExportLine -> POSIXTime
getExportLineTimestamp = \case
    TradeExport Trade
t SymbolDetails
_  -> Trade -> POSIXTime
tTimestamp Trade
t
    TransferExport Transfer
t -> Transfer -> POSIXTime
trTimestamp Transfer
t
    EarnExport     EarnTransaction
t -> EarnTransaction -> POSIXTime
etTimestamp EarnTransaction
t