{-# LANGUAGE RecordWildCards #-}
module Web.CoinTracking.Imports
( writeImportDataToFile
, module Web.CoinTracking.Imports.Types
, coinTrackingCsvImport
, headerRow
, csvEncodingOptions
, coinTrackingXlsxImport
, writeXlsxHeader
, writeXlsxRow
) where
import Codec.Xlsx ( CellValue(..)
, DateBase(DateBase1900)
, Worksheet
, atSheet
, cellValueAt
, dateToNumber
, def
, fromXlsx
)
import Control.Lens ( (.~)
, (?~)
)
import Data.Char ( toLower )
import Data.Csv ( EncodeOptions(..)
, defaultEncodeOptions
, encodeWith
)
import Data.Foldable ( foldl' )
import Data.Function ( (&) )
import Data.Scientific ( toRealFloat )
import Data.Time ( zonedTimeToUTC )
import Data.Time.Clock.POSIX ( POSIXTime
, getPOSIXTime
)
import System.FilePath ( takeExtension )
import Web.CoinTracking.Imports.Types
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBC
import qualified Data.Text as T
writeImportDataToFile :: FilePath -> [CTImportData] -> IO ()
writeImportDataToFile :: FilePath -> [CTImportData] -> IO ()
writeImportDataToFile FilePath
file [CTImportData]
xs = do
POSIXTime
currentTime <- IO POSIXTime
getPOSIXTime
let extension :: FilePath
extension = FilePath -> FilePath
takeExtension FilePath
file
output :: ByteString
output = if forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
extension forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".xlsx", FilePath
".xls"]
then POSIXTime -> [CTImportData] -> ByteString
coinTrackingXlsxImport POSIXTime
currentTime [CTImportData]
xs
else [CTImportData] -> ByteString
coinTrackingCsvImport [CTImportData]
xs
FilePath -> ByteString -> IO ()
LBC.writeFile FilePath
file ByteString
output
coinTrackingCsvImport :: [CTImportData] -> LBS.ByteString
coinTrackingCsvImport :: [CTImportData] -> ByteString
coinTrackingCsvImport =
(ByteString
headerRow forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
LBC.init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRecord a => EncodeOptions -> [a] -> ByteString
encodeWith EncodeOptions
csvEncodingOptions
headerRow :: LBS.ByteString
= forall a. ToRecord a => EncodeOptions -> [a] -> ByteString
encodeWith
EncodeOptions
csvEncodingOptions
[ [ Text
"Type" :: T.Text
, Text
"Buy"
, Text
"Cur."
, Text
"Sell"
, Text
"Cur."
, Text
"Fee"
, Text
"Cur."
, Text
"Exchange"
, Text
"Trade-Group"
, Text
"Comment"
, Text
"Date"
, Text
"Tx-ID"
, Text
"Buy Value in your Account Currency"
, Text
"Sell Value in your Account Currency"
]
]
csvEncodingOptions :: EncodeOptions
csvEncodingOptions :: EncodeOptions
csvEncodingOptions = EncodeOptions
defaultEncodeOptions { encUseCrLf :: Bool
encUseCrLf = Bool
False }
coinTrackingXlsxImport
:: POSIXTime
-> [CTImportData]
-> LBS.ByteString
coinTrackingXlsxImport :: POSIXTime -> [CTImportData] -> ByteString
coinTrackingXlsxImport POSIXTime
createdTime [CTImportData]
rows =
let sheet :: Worksheet
sheet = forall b a. (b -> RowIndex -> a -> b) -> b -> [a] -> b
ixFoldl
(\Worksheet
sheet_ RowIndex
rowNum CTImportData
row -> Worksheet -> RowIndex -> CTImportData -> Worksheet
writeXlsxRow Worksheet
sheet_ (RowIndex
rowNum forall a. Num a => a -> a -> a
+ RowIndex
3) CTImportData
row)
(Worksheet -> Worksheet
writeXlsxHeader forall a. Default a => a
def)
[CTImportData]
rows
book :: Xlsx
book = forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& Text -> Lens' Xlsx (Maybe Worksheet)
atSheet Text
"Sheet1" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Worksheet
sheet
in POSIXTime -> Xlsx -> ByteString
fromXlsx POSIXTime
createdTime Xlsx
book
where
ixFoldl :: (b -> RowIndex -> a -> b) -> b -> [a] -> b
ixFoldl :: forall b a. (b -> RowIndex -> a -> b) -> b -> [a] -> b
ixFoldl b -> RowIndex -> a -> b
f b
initial =
forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(b
b, RowIndex
i) a
a -> (b -> RowIndex -> a -> b
f b
b RowIndex
i a
a, RowIndex
i forall a. Num a => a -> a -> a
+ RowIndex
1)) (b
initial, RowIndex
0)
writeXlsxHeader :: Worksheet -> Worksheet
Worksheet
sheet =
Worksheet
sheet
forall a b. a -> (a -> b) -> b
& (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
1, ColumnIndex
1)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText
Text
"CoinTracking Excel Import data (see docs: https://cointracking.info/import/import_xls/)"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
1 Text
"Type"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
2 Text
"Buy Amount"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
3 Text
"Buy Cur."
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
4 Text
"Sell Amount"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
5 Text
"Sell Cur."
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
6 Text
"Feel Amount"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
7 Text
"Fee Cur."
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
8 Text
"Exchange"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
9 Text
"Trade Group"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
10 Text
"Comment"
forall a b. a -> (a -> b) -> b
& ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
11 Text
"Date"
where
writeColumn :: ColumnIndex -> T.Text -> Worksheet -> Worksheet
writeColumn :: ColumnIndex -> Text -> Worksheet -> Worksheet
writeColumn ColumnIndex
c Text
t Worksheet
s = Worksheet
s forall a b. a -> (a -> b) -> b
& (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
2, ColumnIndex
c) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText Text
t
writeXlsxRow :: Worksheet -> RowIndex -> CTImportData -> Worksheet
writeXlsxRow :: Worksheet -> RowIndex -> CTImportData -> Worksheet
writeXlsxRow Worksheet
sheet RowIndex
row CTImportData {Maybe Amount
Text
ZonedTime
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
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
..} =
Worksheet
sheet
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
1) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText (forall a. IsString a => CTTransactionType -> a
renderTransactionType CTTransactionType
ctidType))
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
2) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderAmount Maybe Amount
ctidBuy)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
3) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderCurrency Maybe Amount
ctidBuy)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
4) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderAmount Maybe Amount
ctidSell)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
5) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderCurrency Maybe Amount
ctidSell)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
6) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderAmount Maybe Amount
ctidFee)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
7) forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Amount -> Maybe CellValue
renderCurrency Maybe Amount
ctidFee)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
8) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText Text
ctidExchange)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
9) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText Text
ctidGroup)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
10) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> CellValue
CellText Text
ctidComment)
forall a b. a -> (a -> b) -> b
& ((RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue)
cellValueAt (RowIndex
row, ColumnIndex
11) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CellValue
renderedDate)
where
renderAmount :: Maybe Amount -> Maybe CellValue
renderAmount :: Maybe Amount -> Maybe CellValue
renderAmount = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> CellValue
CellDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Scientific -> a
toRealFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Scientific
aAmount)
renderCurrency :: Maybe Amount -> Maybe CellValue
renderCurrency :: Maybe Amount -> Maybe CellValue
renderCurrency = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> CellValue
CellText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Currency -> Text
cTicker forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Currency
aCurrency)
renderedDate :: CellValue
renderedDate :: CellValue
renderedDate =
Double -> CellValue
CellDouble forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => DateBase -> UTCTime -> a
dateToNumber DateBase
DateBase1900 forall a b. (a -> b) -> a -> b
$ ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
ctidDate