feat(parse position): Parse avanza current possitions

app/Features/Positions/PositionsTable.hs

@@ -0,0 +1,104 @@
+module Features.Positions.PositionsTable
+  ( createPositionsTable,
+  )
+where
+
+import Calc
+  ( calcPositionCostBasis,
+    calcPositionReturnPct,
+    calcPositionUnrealizedProfit,
+  )
+import Data.Text (Text)
+import qualified Data.Text as T
+import PrettyPrint
+  ( createPrettyTable,
+    doubleToText,
+    moneyToText,
+  )
+import Text.Printf (printf)
+import Types.Money (Money (..))
+import Types.Position (Position (..))
+import Types.PrintableCell
+  ( FixedWidth (FixedWidth, l, s),
+    PrintableCell
+      ( textAlign,
+        width
+      ),
+    TextAlign
+      ( LeftAlign,
+        RightAlign
+      ),
+    createCellFromText,
+    createFilledCell,
+    createFixedCell,
+  )
+import Types.UiSize (UiSize)
+
+createPositionsTable :: UiSize -> Int -> [Position] -> Text
+createPositionsTable uiSize termWidth positions =
+  let header = positionsHeader
+      contentRows = map (positionRowToCells header) positions
+      content = contentRows ++ [totalsRow header positions]
+      spacing = map width header
+   in createPrettyTable uiSize termWidth header content spacing
+
+-- | Konto | Namn | Antal | GAV (kr) | Värde (kr) | Ansk. (kr) | Vinst (kr) | Avkastn. % |
+positionsHeader :: [PrintableCell]
+positionsHeader =
+  [ createFixedCell "Konto" FixedWidth {s = 12, l = Just 14} LeftAlign,
+    createFilledCell "Namn" LeftAlign,
+    createFixedCell "Antal" FixedWidth {s = 8, l = Just 10} RightAlign,
+    createFixedCell "GAV (kr)" FixedWidth {s = 10, l = Just 12} RightAlign,
+    createFixedCell "Värde (kr)" FixedWidth {s = 10, l = Just 13} RightAlign,
+    createFixedCell "Ansk. (kr)" FixedWidth {s = 10, l = Just 13} RightAlign,
+    createFixedCell "Vinst (kr)" FixedWidth {s = 10, l = Just 13} RightAlign,
+    createFixedCell "Avkastn. %" FixedWidth {s = 9, l = Just 11} RightAlign
+  ]
+
+positionRowToCells :: [PrintableCell] -> Position -> [PrintableCell]
+positionRowToCells header p =
+  rowToCells
+    header
+    [ account p,
+      name p,
+      doubleToText (volume p),
+      moneyToText (gavSek p),
+      moneyToText (marketValue p),
+      moneyToText (calcPositionCostBasis p),
+      moneyToText (calcPositionUnrealizedProfit p),
+      percentToText (calcPositionReturnPct p)
+    ]
+
+-- A summary line totalling market value, cost basis and unrealized profit across
+-- every holding, plus the overall return.
+totalsRow :: [PrintableCell] -> [Position] -> [PrintableCell]
+totalsRow header positions =
+  let totalValue = sum (map marketValue positions)
+      totalCost = sum (map calcPositionCostBasis positions)
+      totalProfit = totalValue - totalCost
+      totalPct =
+        if unMoney totalCost == 0
+          then Nothing
+          else Just (unMoney totalProfit / unMoney totalCost * 100)
+   in rowToCells
+        header
+        [ T.pack "Totalt",
+          T.empty,
+          T.empty,
+          T.empty,
+          moneyToText totalValue,
+          moneyToText totalCost,
+          moneyToText totalProfit,
+          percentToText totalPct
+        ]
+
+rowToCells :: [PrintableCell] -> [Text] -> [PrintableCell]
+rowToCells header texts =
+  zipWith
+    (\txt h -> createCellFromText txt (width h) (textAlign h))
+    texts
+    header
+
+percentToText :: Maybe Double -> Text
+percentToText Nothing = T.pack "-"
+percentToText (Just p) = T.pack (printf "%.2f%%" p)

app/Main.hs

@@ -40,10 +40,12 @@ import Features.GroupByCompany.GroupByCompanyArgParse (sortableColumnToStr)
 import qualified Features.GroupByCompany.GroupByCompanyArgParse as GbcArgParse
 import Features.GroupByCompany.GroupByCompanyTable (createGroupByCompanyTable)
 import qualified Features.GroupByCompany.GroupByCompanyTypes as GBC
-import Parse (parseCsvData)
+import Features.Positions.PositionsTable (createPositionsTable)
+import Parse (parseCsvData, parsePositionCsvData)
 import qualified PrettyPrint as PP
 import System.Environment (getArgs)
 import Types.CLITypes (CommandLineOption (..), FlagDoc (..))
+import Types.Position (Position)
 import Types.Transaction.GenericTransaction
   ( Transaction,
   )
@@ -87,7 +89,13 @@ mainCommands =
             flagDescriptionRows = ["Limit number of rows (must be > 1)"]
           }
       ]
-      printGroupByComany
+      printGroupByComany,
+    CommandLineOption
+      "positions"
+      "pos"
+      "Print current holdings with unrealized profit/loss"
+      []
+      printPositions
   ]
   where
     createGbcSortOpts xs = List.intercalate ", " (map sortableColumnToStr xs)
@@ -139,8 +147,26 @@ printGroupByComany cliFlags filePath = do
 
   T.putStr printContent
 
+printPositions :: [String] -> FilePath -> IO ()
+printPositions cliFlags filePath = do
+  positions <- readPositions filePath
+  termWidth <- getAdjustedTerminalWidth
+  let uiSize = calcUiSize termWidth
+  let printContent =
+        createPositionsTable
+          uiSize
+          (fromMaybe 0 termWidth)
+          positions
+
+  T.putStr printContent
+
 readCsv :: FilePath -> IO [Transaction]
 readCsv filePath = do
   csvData <- BSL.readFile filePath
   let rows = parseCsvData csvData
   return rows
+
+readPositions :: FilePath -> IO [Position]
+readPositions filePath = do
+  csvData <- BSL.readFile filePath
+  return (parsePositionCsvData csvData)

hava.cabal

@@ -28,13 +28,15 @@ library
       Features.GroupByCompany.GroupByCompanyArgParse
       Features.GroupByCompany.GroupByCompanyTable
       Features.GroupByCompany.GroupByCompanyTypes
+      Features.Positions.PositionsTable
       Main
       Calc
       CLIHelp
       Parse
       PrettyPrint
       Types.CLITypes
       Types.Money
+      Types.Position
       Types.PrintableCell
       Types.Table.SortOption
       Types.Transaction.GenericTransaction
@@ -77,6 +79,7 @@ executable hava-exe
       Features.GroupByCompany.GroupByCompanyArgParse
       Features.GroupByCompany.GroupByCompanyTable
       Features.GroupByCompany.GroupByCompanyTypes
+      Features.Positions.PositionsTable
       Paths_hava
   hs-source-dirs:
       app

src/Calc.hs

@@ -9,6 +9,9 @@ module Calc
     calcRemainingAmount,
     calcSellProfit,
     calcTotalDividendProfit,
+    calcPositionCostBasis,
+    calcPositionUnrealizedProfit,
+    calcPositionReturnPct,
   )
 where
 
@@ -31,6 +34,7 @@ import Debug.Trace
     traceShowId,
   )
 import Types.Money (Money (..))
+import Types.Position (Position (..))
 import Types.Transaction.GenericTransaction
   ( Transaction,
     getAction,
@@ -188,3 +192,23 @@ calcRemainingAmount = sum . map getQuantity'
 
 calcTotalDividendProfit :: [TransactionDividend] -> Money
 calcTotalDividendProfit = sum . map getAmount
+
+-- Position (current-holding) calculations.
+--
+-- Cost basis uses the SEK average cost ("GAV (SEK)") so it shares a currency
+-- with "Marknadsvärde" (also SEK); the plain "GAV" is in the instrument's own
+-- currency for foreign holdings and would mismatch.
+calcPositionCostBasis :: Position -> Money
+calcPositionCostBasis p = Money (volume p * unMoney (gavSek p))
+
+calcPositionUnrealizedProfit :: Position -> Money
+calcPositionUnrealizedProfit p = marketValue p - calcPositionCostBasis p
+
+-- 'Nothing' when the cost basis is zero (free shares, renamed company, …) so the
+-- caller can render it as "-" rather than dividing by zero.
+calcPositionReturnPct :: Position -> Maybe Double
+calcPositionReturnPct p =
+  let cost = unMoney (calcPositionCostBasis p)
+   in if cost == 0
+        then Nothing
+        else Just (unMoney (calcPositionUnrealizedProfit p) / cost * 100)

src/Parse.hs

@@ -4,6 +4,7 @@
 
 module Parse
   ( parseCsvData,
+    parsePositionCsvData,
   )
 where
 
@@ -32,13 +33,14 @@ import Data.Word (Word8)
 import System.Exit (die)
 -- Types
 import Types.Money (Money (..))
+import Types.Position (Position, expectedPositionHeaders)
 import Types.Transaction.GenericTransaction
   ( GenericTransaction (..),
     Transaction (..),
   )
 
-expectedHeaders :: [BSU.ByteString]
-expectedHeaders =
+expectedTransactionHeaders :: [BSU.ByteString]
+expectedTransactionHeaders =
   map
     BSU.fromString
     [ "Datum",
@@ -71,11 +73,21 @@ instance FromNamedRecord Transaction where
 -- Note: "resultat" avilable but not parsed at this time
 
 parseCsvData :: BSL.ByteString -> [Transaction]
-parseCsvData csvData =
+parseCsvData = parseCsvWith expectedTransactionHeaders
+
+parsePositionCsvData :: BSL.ByteString -> [Position]
+parsePositionCsvData = parseCsvWith expectedPositionHeaders
+
+-- | Decode a ';'-delimited Avanza CSV export into a list of records of any
+--   format with a 'FromNamedRecord' instance. Strips a leading UTF-8 BOM and
+--   validates the header against the format's expected columns before decoding.
+parseCsvWith ::
+  (FromNamedRecord a) => [BSU.ByteString] -> BSL.ByteString -> [a]
+parseCsvWith expectedHeaders csvData =
   let withoutBom = dropBOM csvData
       header = readHeader withoutBom
       decOptions = defaultDecodeOptions {decDelimiter = fromIntegral (ord ';')}
-   in case checkHeadersStrict header of
+   in case checkHeadersStrict expectedHeaders header of
         Just msg -> error msg
         Nothing -> case decodeByNameWith decOptions withoutBom of
           Left err -> error err
@@ -91,21 +103,21 @@ readHeader bs =
   let (hdr, _) = BSL.break (== nl) bs
    in BS.split semi (BSL.toStrict hdr)
 
-checkHeadersStrict :: [BS.ByteString] -> Maybe String
-checkHeadersStrict found =
-  if all (`elem` found) expectedHeaders
+checkHeadersStrict :: [BS.ByteString] -> [BS.ByteString] -> Maybe String
+checkHeadersStrict expected found =
+  if all (`elem` found) expected
     then Nothing
     else
-      let missing = filter (`notElem` found) expectedHeaders
-          extra = filter (`notElem` expectedHeaders) found
+      let missing = filter (`notElem` found) expected
+          extra = filter (`notElem` expected) found
           pretty = L.intercalate ", "
           s = map BSU.toString
        in Just $
             unlines
               [ "Unexpected CSV header.",
                 "Missing: " <> pretty (s missing),
                 "Extra:   " <> pretty (s extra),
-                "Expected headers:\n" <> unlines (map ("  " <>) (s expectedHeaders)),
+                "Expected headers:\n" <> unlines (map ("  " <>) (s expected)),
                 "Found headers:\n" <> unlines (map ("  " <>) (s found))
               ]
 

src/PrettyPrint.hs

@@ -6,6 +6,7 @@ module PrettyPrint
     createPrettyTable,
     intToText,
     moneyToText,
+    doubleToText,
   )
 where
 
@@ -117,6 +118,16 @@ intToText = T.pack . show
 moneyToText :: Money -> Text
 moneyToText = T.pack . printf "%.2f" . unMoney
 
+-- Render a Double for display: whole numbers print without decimals (e.g. a
+-- stock volume of 10 -> "10"), fractional values keep up to 4 decimals (e.g. a
+-- fund volume -> "12.3456").
+doubleToText :: Double -> Text
+doubleToText d
+  | d == fromIntegral r = T.pack (show r)
+  | otherwise = T.pack (printf "%.4f" d)
+  where
+    r = round d :: Integer
+
 -- General utility functions
 
 createTableRow :: UiSize -> [Int] -> [PrintableCell] -> Text