{-| Type definitions, instances, & utility functions for CoinTracking
imports.

-}
{-# LANGUAGE RecordWildCards #-}
module Web.CoinTracking.Imports.Types
    ( CTImportData(..)
    , CTTransactionType(..)
    , renderTransactionType
    , Amount(..)
    , Currency(..)
    ) where

import           Data.Csv                       ( Field
                                                , ToField(..)
                                                , ToRecord(..)
                                                , record
                                                )
import           Data.Scientific                ( FPFormat(Fixed)
                                                , Scientific
                                                , formatScientific
                                                )
import           Data.String                    ( IsString )
import           Data.Time                      ( ZonedTime
                                                , defaultTimeLocale
                                                , formatTime
                                                )
import           GHC.Generics                   ( Generic )

import qualified Data.Text                     as T

-- | Represents a single row in an export.
data CTImportData = CTImportData
    { CTImportData -> CTTransactionType
ctidType      :: CTTransactionType
    , CTImportData -> Maybe Amount
ctidBuy       :: Maybe Amount
    , CTImportData -> Maybe Amount
ctidSell      :: Maybe Amount
    , CTImportData -> Maybe Amount
ctidFee       :: Maybe Amount
    , CTImportData -> Text
ctidExchange  :: T.Text
    , CTImportData -> Text
ctidGroup     :: T.Text
    , CTImportData -> Text
ctidComment   :: T.Text
    , CTImportData -> ZonedTime
ctidDate      :: ZonedTime
    , CTImportData -> Text
ctidTradeId   :: T.Text
    , CTImportData -> Maybe Amount
ctidBuyValue  :: Maybe Amount
    , CTImportData -> Maybe Amount
ctidSellValue :: Maybe Amount
    }
    deriving (Int -> CTImportData -> ShowS
[CTImportData] -> ShowS
CTImportData -> String
(Int -> CTImportData -> ShowS)
-> (CTImportData -> String)
-> ([CTImportData] -> ShowS)
-> Show CTImportData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTImportData] -> ShowS
$cshowList :: [CTImportData] -> ShowS
show :: CTImportData -> String
$cshow :: CTImportData -> String
showsPrec :: Int -> CTImportData -> ShowS
$cshowsPrec :: Int -> CTImportData -> ShowS
Show, ReadPrec [CTImportData]
ReadPrec CTImportData
Int -> ReadS CTImportData
ReadS [CTImportData]
(Int -> ReadS CTImportData)
-> ReadS [CTImportData]
-> ReadPrec CTImportData
-> ReadPrec [CTImportData]
-> Read CTImportData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CTImportData]
$creadListPrec :: ReadPrec [CTImportData]
readPrec :: ReadPrec CTImportData
$creadPrec :: ReadPrec CTImportData
readList :: ReadS [CTImportData]
$creadList :: ReadS [CTImportData]
readsPrec :: Int -> ReadS CTImportData
$creadsPrec :: Int -> ReadS CTImportData
Read, (forall x. CTImportData -> Rep CTImportData x)
-> (forall x. Rep CTImportData x -> CTImportData)
-> Generic CTImportData
forall x. Rep CTImportData x -> CTImportData
forall x. CTImportData -> Rep CTImportData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CTImportData x -> CTImportData
$cfrom :: forall x. CTImportData -> Rep CTImportData x
Generic)

instance ToRecord CTImportData where
    toRecord :: CTImportData -> Record
toRecord CTImportData {Maybe Amount
Text
ZonedTime
CTTransactionType
ctidSellValue :: Maybe Amount
ctidBuyValue :: Maybe Amount
ctidTradeId :: Text
ctidDate :: ZonedTime
ctidComment :: Text
ctidGroup :: Text
ctidExchange :: Text
ctidFee :: Maybe Amount
ctidSell :: Maybe Amount
ctidBuy :: Maybe Amount
ctidType :: CTTransactionType
ctidSellValue :: CTImportData -> Maybe Amount
ctidBuyValue :: CTImportData -> Maybe Amount
ctidTradeId :: CTImportData -> Text
ctidDate :: CTImportData -> ZonedTime
ctidComment :: CTImportData -> Text
ctidGroup :: CTImportData -> Text
ctidExchange :: CTImportData -> Text
ctidFee :: CTImportData -> Maybe Amount
ctidSell :: CTImportData -> Maybe Amount
ctidBuy :: CTImportData -> Maybe Amount
ctidType :: CTImportData -> CTTransactionType
..} = [ByteString] -> Record
record
        [ CTTransactionType -> ByteString
forall a. ToField a => a -> ByteString
toField CTTransactionType
ctidType
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderAmount   Maybe Amount
ctidBuy
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderCurrency Maybe Amount
ctidBuy
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderAmount   Maybe Amount
ctidSell
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderCurrency Maybe Amount
ctidSell
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderAmount   Maybe Amount
ctidFee
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderCurrency Maybe Amount
ctidFee
        , Text -> ByteString
forall a. ToField a => a -> ByteString
toField Text
ctidExchange
        , Text -> ByteString
forall a. ToField a => a -> ByteString
toField Text
ctidGroup
        , Text -> ByteString
forall a. ToField a => a -> ByteString
toField Text
ctidComment
        , String -> ByteString
forall a. ToField a => a -> ByteString
toField (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T" ZonedTime
ctidDate
        , Text -> ByteString
forall a. ToField a => a -> ByteString
toField Text
ctidTradeId
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderAmount Maybe Amount
ctidBuyValue
        , (Amount -> ByteString) -> Maybe Amount -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
orBlank Amount -> ByteString
renderAmount Maybe Amount
ctidSellValue
        ]
      where
        orBlank :: (a -> Field) -> Maybe a -> Field
        orBlank :: (a -> ByteString) -> Maybe a -> ByteString
orBlank = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
""
        renderAmount :: Amount -> Field
        renderAmount :: Amount -> ByteString
renderAmount Amount { aCurrency :: Amount -> Currency
aCurrency = Currency {Int
Text
cTicker :: Currency -> Text
cPrecision :: Currency -> Int
cTicker :: Text
cPrecision :: Int
..}, Scientific
aAmount :: Amount -> Scientific
aAmount :: Scientific
..} =
            String -> ByteString
forall a. ToField a => a -> ByteString
toField (String -> ByteString) -> String -> ByteString
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
cPrecision) Scientific
aAmount
        renderCurrency :: Amount -> Field
        renderCurrency :: Amount -> ByteString
renderCurrency = Text -> ByteString
forall a. ToField a => a -> ByteString
toField (Text -> ByteString) -> (Amount -> Text) -> Amount -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Currency -> Text
cTicker (Currency -> Text) -> (Amount -> Currency) -> Amount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Currency
aCurrency


-- | An amount & currency specification.
data Amount = Amount
    { Amount -> Scientific
aAmount   :: Scientific
    -- ^ The total amount.
    , Amount -> Currency
aCurrency :: Currency
    -- ^ The currency symbol & decimal-precision.
    }
    deriving (Int -> Amount -> ShowS
[Amount] -> ShowS
Amount -> String
(Int -> Amount -> ShowS)
-> (Amount -> String) -> ([Amount] -> ShowS) -> Show Amount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Amount] -> ShowS
$cshowList :: [Amount] -> ShowS
show :: Amount -> String
$cshow :: Amount -> String
showsPrec :: Int -> Amount -> ShowS
$cshowsPrec :: Int -> Amount -> ShowS
Show, ReadPrec [Amount]
ReadPrec Amount
Int -> ReadS Amount
ReadS [Amount]
(Int -> ReadS Amount)
-> ReadS [Amount]
-> ReadPrec Amount
-> ReadPrec [Amount]
-> Read Amount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Amount]
$creadListPrec :: ReadPrec [Amount]
readPrec :: ReadPrec Amount
$creadPrec :: ReadPrec Amount
readList :: ReadS [Amount]
$creadList :: ReadS [Amount]
readsPrec :: Int -> ReadS Amount
$creadsPrec :: Int -> ReadS Amount
Read, Amount -> Amount -> Bool
(Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool) -> Eq Amount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Amount -> Amount -> Bool
$c/= :: Amount -> Amount -> Bool
== :: Amount -> Amount -> Bool
$c== :: Amount -> Amount -> Bool
Eq)

-- | A pair containing a currency symbol & an amount.
data Currency = Currency
    { Currency -> Int
cPrecision :: Int
    -- ^ The number of decimals places of precision.
    , Currency -> Text
cTicker    :: T.Text
    -- ^ The ticker symbol
    }
    deriving (Int -> Currency -> ShowS
[Currency] -> ShowS
Currency -> String
(Int -> Currency -> ShowS)
-> (Currency -> String) -> ([Currency] -> ShowS) -> Show Currency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Currency] -> ShowS
$cshowList :: [Currency] -> ShowS
show :: Currency -> String
$cshow :: Currency -> String
showsPrec :: Int -> Currency -> ShowS
$cshowsPrec :: Int -> Currency -> ShowS
Show, ReadPrec [Currency]
ReadPrec Currency
Int -> ReadS Currency
ReadS [Currency]
(Int -> ReadS Currency)
-> ReadS [Currency]
-> ReadPrec Currency
-> ReadPrec [Currency]
-> Read Currency
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Currency]
$creadListPrec :: ReadPrec [Currency]
readPrec :: ReadPrec Currency
$creadPrec :: ReadPrec Currency
readList :: ReadS [Currency]
$creadList :: ReadS [Currency]
readsPrec :: Int -> ReadS Currency
$creadsPrec :: Int -> ReadS Currency
Read, Currency -> Currency -> Bool
(Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool) -> Eq Currency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Currency -> Currency -> Bool
$c/= :: Currency -> Currency -> Bool
== :: Currency -> Currency -> Bool
$c== :: Currency -> Currency -> Bool
Eq, (forall x. Currency -> Rep Currency x)
-> (forall x. Rep Currency x -> Currency) -> Generic Currency
forall x. Rep Currency x -> Currency
forall x. Currency -> Rep Currency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Currency x -> Currency
$cfrom :: forall x. Currency -> Rep Currency x
Generic)


-- | Possible types for an imported transaction.
data CTTransactionType
    = Trade
    | Deposit
    | Withdrawal
    | Income
    | Mining
    | GiftTipIn
    | Spend
    | Donation
    | GiftOut
    | Stolen
    | Lost
    | Airdrop
    | Staking
    | Masternode
    | Minting
    | DividendsIncome
    | LendingIncome
    | InterestIncome
    | RewardBonus
    | MiningCommercial
    | MarginProfit
    | DerivativesFuturesProfit
    | OtherIncome
    | IncomeNonTaxable
    | OtherIncomeNonTaxable
    | MarginLoss
    | MarginFee
    | BorrowingFee
    | SettlementFee
    | DerivativesFuturesLoss
    | OtherFee
    | OtherExpense
    | ExpenseNonTaxable
    | MarginTrade
    | DerivativesFuturesTrade
    deriving (Int -> CTTransactionType -> ShowS
[CTTransactionType] -> ShowS
CTTransactionType -> String
(Int -> CTTransactionType -> ShowS)
-> (CTTransactionType -> String)
-> ([CTTransactionType] -> ShowS)
-> Show CTTransactionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTTransactionType] -> ShowS
$cshowList :: [CTTransactionType] -> ShowS
show :: CTTransactionType -> String
$cshow :: CTTransactionType -> String
showsPrec :: Int -> CTTransactionType -> ShowS
$cshowsPrec :: Int -> CTTransactionType -> ShowS
Show, ReadPrec [CTTransactionType]
ReadPrec CTTransactionType
Int -> ReadS CTTransactionType
ReadS [CTTransactionType]
(Int -> ReadS CTTransactionType)
-> ReadS [CTTransactionType]
-> ReadPrec CTTransactionType
-> ReadPrec [CTTransactionType]
-> Read CTTransactionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CTTransactionType]
$creadListPrec :: ReadPrec [CTTransactionType]
readPrec :: ReadPrec CTTransactionType
$creadPrec :: ReadPrec CTTransactionType
readList :: ReadS [CTTransactionType]
$creadList :: ReadS [CTTransactionType]
readsPrec :: Int -> ReadS CTTransactionType
$creadsPrec :: Int -> ReadS CTTransactionType
Read, CTTransactionType -> CTTransactionType -> Bool
(CTTransactionType -> CTTransactionType -> Bool)
-> (CTTransactionType -> CTTransactionType -> Bool)
-> Eq CTTransactionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTTransactionType -> CTTransactionType -> Bool
$c/= :: CTTransactionType -> CTTransactionType -> Bool
== :: CTTransactionType -> CTTransactionType -> Bool
$c== :: CTTransactionType -> CTTransactionType -> Bool
Eq, Eq CTTransactionType
Eq CTTransactionType
-> (CTTransactionType -> CTTransactionType -> Ordering)
-> (CTTransactionType -> CTTransactionType -> Bool)
-> (CTTransactionType -> CTTransactionType -> Bool)
-> (CTTransactionType -> CTTransactionType -> Bool)
-> (CTTransactionType -> CTTransactionType -> Bool)
-> (CTTransactionType -> CTTransactionType -> CTTransactionType)
-> (CTTransactionType -> CTTransactionType -> CTTransactionType)
-> Ord CTTransactionType
CTTransactionType -> CTTransactionType -> Bool
CTTransactionType -> CTTransactionType -> Ordering
CTTransactionType -> CTTransactionType -> CTTransactionType
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 :: CTTransactionType -> CTTransactionType -> CTTransactionType
$cmin :: CTTransactionType -> CTTransactionType -> CTTransactionType
max :: CTTransactionType -> CTTransactionType -> CTTransactionType
$cmax :: CTTransactionType -> CTTransactionType -> CTTransactionType
>= :: CTTransactionType -> CTTransactionType -> Bool
$c>= :: CTTransactionType -> CTTransactionType -> Bool
> :: CTTransactionType -> CTTransactionType -> Bool
$c> :: CTTransactionType -> CTTransactionType -> Bool
<= :: CTTransactionType -> CTTransactionType -> Bool
$c<= :: CTTransactionType -> CTTransactionType -> Bool
< :: CTTransactionType -> CTTransactionType -> Bool
$c< :: CTTransactionType -> CTTransactionType -> Bool
compare :: CTTransactionType -> CTTransactionType -> Ordering
$ccompare :: CTTransactionType -> CTTransactionType -> Ordering
$cp1Ord :: Eq CTTransactionType
Ord, CTTransactionType
CTTransactionType -> CTTransactionType -> Bounded CTTransactionType
forall a. a -> a -> Bounded a
maxBound :: CTTransactionType
$cmaxBound :: CTTransactionType
minBound :: CTTransactionType
$cminBound :: CTTransactionType
Bounded, Int -> CTTransactionType
CTTransactionType -> Int
CTTransactionType -> [CTTransactionType]
CTTransactionType -> CTTransactionType
CTTransactionType -> CTTransactionType -> [CTTransactionType]
CTTransactionType
-> CTTransactionType -> CTTransactionType -> [CTTransactionType]
(CTTransactionType -> CTTransactionType)
-> (CTTransactionType -> CTTransactionType)
-> (Int -> CTTransactionType)
-> (CTTransactionType -> Int)
-> (CTTransactionType -> [CTTransactionType])
-> (CTTransactionType -> CTTransactionType -> [CTTransactionType])
-> (CTTransactionType -> CTTransactionType -> [CTTransactionType])
-> (CTTransactionType
    -> CTTransactionType -> CTTransactionType -> [CTTransactionType])
-> Enum CTTransactionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CTTransactionType
-> CTTransactionType -> CTTransactionType -> [CTTransactionType]
$cenumFromThenTo :: CTTransactionType
-> CTTransactionType -> CTTransactionType -> [CTTransactionType]
enumFromTo :: CTTransactionType -> CTTransactionType -> [CTTransactionType]
$cenumFromTo :: CTTransactionType -> CTTransactionType -> [CTTransactionType]
enumFromThen :: CTTransactionType -> CTTransactionType -> [CTTransactionType]
$cenumFromThen :: CTTransactionType -> CTTransactionType -> [CTTransactionType]
enumFrom :: CTTransactionType -> [CTTransactionType]
$cenumFrom :: CTTransactionType -> [CTTransactionType]
fromEnum :: CTTransactionType -> Int
$cfromEnum :: CTTransactionType -> Int
toEnum :: Int -> CTTransactionType
$ctoEnum :: Int -> CTTransactionType
pred :: CTTransactionType -> CTTransactionType
$cpred :: CTTransactionType -> CTTransactionType
succ :: CTTransactionType -> CTTransactionType
$csucc :: CTTransactionType -> CTTransactionType
Enum, (forall x. CTTransactionType -> Rep CTTransactionType x)
-> (forall x. Rep CTTransactionType x -> CTTransactionType)
-> Generic CTTransactionType
forall x. Rep CTTransactionType x -> CTTransactionType
forall x. CTTransactionType -> Rep CTTransactionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CTTransactionType x -> CTTransactionType
$cfrom :: forall x. CTTransactionType -> Rep CTTransactionType x
Generic)

instance ToField CTTransactionType where
    toField :: CTTransactionType -> ByteString
toField = CTTransactionType -> ByteString
forall a. IsString a => CTTransactionType -> a
renderTransactionType

-- | Render the 'CTTransactionType' as CoinTracking displays/expects it.
renderTransactionType :: (IsString a) => CTTransactionType -> a
renderTransactionType :: CTTransactionType -> a
renderTransactionType = \case
    CTTransactionType
Trade                    -> a
"Trade"
    CTTransactionType
Deposit                  -> a
"Deposit"
    CTTransactionType
Withdrawal               -> a
"Withdrawal"
    CTTransactionType
Income                   -> a
"Income"
    CTTransactionType
Mining                   -> a
"Mining"
    CTTransactionType
GiftTipIn                -> a
"Gift/Tip(In)"
    CTTransactionType
Spend                    -> a
"Spend"
    CTTransactionType
Donation                 -> a
"Donation"
    CTTransactionType
GiftOut                  -> a
"Gift(Out)"
    CTTransactionType
Stolen                   -> a
"Stolen"
    CTTransactionType
Lost                     -> a
"Lost"
    CTTransactionType
Airdrop                  -> a
"Airdrop"
    CTTransactionType
Staking                  -> a
"Staking"
    CTTransactionType
Masternode               -> a
"Masternode"
    CTTransactionType
Minting                  -> a
"Minting"
    CTTransactionType
DividendsIncome          -> a
"Dividends Income"
    CTTransactionType
LendingIncome            -> a
"Lending Income"
    CTTransactionType
InterestIncome           -> a
"Interest Income"
    CTTransactionType
RewardBonus              -> a
"Reward / Bonus"
    CTTransactionType
MiningCommercial         -> a
"Mining (commercial)"
    CTTransactionType
MarginProfit             -> a
"Margin Profit"
    CTTransactionType
DerivativesFuturesProfit -> a
"Derivatives / Futures Profit"
    CTTransactionType
OtherIncome              -> a
"Other Income"
    CTTransactionType
IncomeNonTaxable         -> a
"Income (non taxable)"
    CTTransactionType
OtherIncomeNonTaxable    -> a
"Other Income (non taxable)"
    CTTransactionType
MarginLoss               -> a
"Margin Loss"
    CTTransactionType
MarginFee                -> a
"Margin Fee"
    CTTransactionType
BorrowingFee             -> a
"Borrowing Fee"
    CTTransactionType
SettlementFee            -> a
"Settlement Fee"
    CTTransactionType
DerivativesFuturesLoss   -> a
"Derivatives / Futures Loss"
    CTTransactionType
OtherFee                 -> a
"Other Fee"
    CTTransactionType
OtherExpense             -> a
"Other Expense"
    CTTransactionType
ExpenseNonTaxable        -> a
"Expense (non taxable)"
    CTTransactionType
MarginTrade              -> a
"Margin Trade"
    CTTransactionType
DerivativesFuturesTrade  -> a
"Derivatives / Futures Trade"