packages feed

robin-hood-profit (empty) → 0.0.2

raw patch · 22 files changed

+1107/−0 lines, 22 filesdep +Decimaldep +attoparsec-isotropicdep +base

Dependencies added: Decimal, attoparsec-isotropic, base, bytestring, containers, directory, exceptions, filepath, generic-lens, lens, mtl, optparse-applicative, relude, robin-hood-profit, semigroups, tasty, tasty-discover, tasty-hunit, tasty-quickcheck, template-haskell, text, time, trace-embrace

Files

+ changelog.md view
@@ -0,0 +1,13 @@+# robin-hood-profit changelog++## Version 0.0.2 2025-09-16++  * support breaking changes in CSV format:+    - negative values are encoded with parentheses instead of minus character+    - recognize GMPC fee+  * static build+  * upgrade to GHC 9.12.2+  * GitHub CI++## Version 0.0.1 2025-04-18+  * init
+ exe/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import RobinHood.Cmd+import RobinHood.Run+++main :: IO ()+main = parseCmdArgs >>= runRhProfit
+ robin-hood-profit.cabal view
@@ -0,0 +1,139 @@+cabal-version: 3.0+name:          robin-hood-profit+version:       0.0.2+synopsis:      Calculate per instrument profit from Robin-Hood activity report+description:+  The tool has a command line interface. It generates quarter profit+  reports out of Robin-Hood activity reports+  available in the CSV format. Quatities from such reports are important+  for estimating quarter prepayment to IRS during+  current tax year.  According to IRS guidline if you postope pay till+  next tax year (i.e Jan-Apr) and amount you owe is greater than $1k+  you may have to pay a penalty.++  In general any quarter report requires sequential processing of all+  history (shares might be bought at one year and sold a decade later)+  since a Robin-Hood account establishment preceding the target+  quater. This data aspect accents algorithm implementation on memory+  efficiency and throughput.++  See Readme file for details.++homepage:      http://github.com/yaitskov/RobinHood-pr0fit+license:       BSD-3-Clause+author:        Daniil Iaitskov+maintainer:    dyaitskov@gmail.com+copyright:     Daniil Iaitkov 2025+category:      System+build-type:    Simple+bug-reports:   https://github.com/yaitskov/RobinHood-pr0fit/issues+extra-doc-files:+  changelog.md+tested-with:+        GHC == { 9.10.1, 9.12.2 }++source-repository head+  type:+    git+  location:+    https://github.com/yaitskov/RobinHood-pr0fit.git++common base+  default-language: Haskell2010+  ghc-options: -Wall+  build-depends:+    , attoparsec-isotropic < 1+    , base >=4.21 && <5+    , relude < 2+  default-extensions:+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveGeneric+    FlexibleContexts+    FlexibleInstances+    LambdaCase+    MultiParamTypeClasses+    NoImplicitPrelude+    NoMonomorphismRestriction+    NumericUnderscores+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings+    ImportQualifiedPost+    ScopedTypeVariables+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeOperators+    TypeSynonymInstances++library+  import: base+  hs-source-dirs: src+  exposed-modules:+    RobinHood.AppState+    RobinHood.CellParser+    RobinHood.Char8+    RobinHood.Cmd+    RobinHood.Compactable+    RobinHood.CsvParser+    RobinHood.Date+    RobinHood.Instrument+    RobinHood.Money+    RobinHood.Prelude+    RobinHood.Profit+    RobinHood.Report+    RobinHood.RobinRow+    RobinHood.Run+    RobinHood.TargetPeriod++  build-depends:+    , Decimal < 0.6+    , bytestring < 0.13+    , containers < 0.9+    , directory < 1.4+    , exceptions < 0.11+    , filepath < 1.6+    , generic-lens < 3+    , lens < 6+    , mtl < 3+    , optparse-applicative < 1+    , semigroups < 0.22+    , template-haskell < 2.24+    , text < 3+    , time < 2+    , trace-embrace < 2++test-suite test+  import: base+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+    Discovery+    RobinHood.Test.Money+    RobinHood.Test.TargetPeriod+  hs-source-dirs: test+  ghc-options: -Wall -rtsopts -threaded -main-is Driver+  build-depends:+    , robin-hood-profit+    , tasty+    , tasty-discover+    , tasty-hunit+    , tasty-quickcheck+    , text++executable rhprofit+  main-is: Main.hs+  other-modules:+    Paths_robin_hood_profit+  autogen-modules:+    Paths_robin_hood_profit+  hs-source-dirs:+    exe+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base+    , robin-hood-profit+  default-language: GHC2021
+ src/RobinHood/AppState.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module RobinHood.AppState where++import RobinHood.Cmd+import RobinHood.Instrument+import RobinHood.Money+import RobinHood.Date+import RobinHood.Prelude+import RobinHood.TargetPeriod (TargetPeriod)++newtype BlockId = BlockId { unBlockId :: Integer } deriving (Show, Eq, Num, Ord)+++data RhProfit+  = RhProfit+  { currentBlock :: !BlockId+  , instruments :: !(Map RhInstrumentName RhInstrument)+  , interest :: !(Map TargetPeriod Money)+  , balance :: !Money+  , lastRowDate :: !(Maybe Date)+  } deriving (Show, Generic)++type ProfitM a = StateT RhProfit (ReaderT CmdArgs IO) a
+ src/RobinHood/CellParser.hs view
@@ -0,0 +1,6 @@+module RobinHood.CellParser (module RobinHood.CellParser, module X) where++import Data.Attoparsec.ByteString as X+import Data.Attoparsec.ByteString.Char8 as X (decimal)++type CellParser a = Parser a
+ src/RobinHood/Char8.hs view
@@ -0,0 +1,20 @@+module RobinHood.Char8 (module RobinHood.Char8, module X) where++import Data.Attoparsec.ByteString.Char8 as X (char8)+import RobinHood.Prelude++comma :: Word8+comma = fromIntegral $ ord ','++zero :: Word8+zero = fromIntegral $ ord '0'++slash :: Word8+slash = fromIntegral $ ord '/'++nine :: Word8+nine = fromIntegral $ ord '9'++digitStep :: Num a => a -> Word8 -> a+digitStep a w = a * 10 + fromIntegral (w - zero)+{-# INLINE digitStep #-}
+ src/RobinHood/Cmd.hs view
@@ -0,0 +1,88 @@+module RobinHood.Cmd where++import Data.Attoparsec.Text qualified as A+import Data.ByteString.Char8 qualified as C8+import Data.Text qualified as T+import Data.String qualified as S+import Options.Applicative+import Options.Applicative.Help (vsep)+import RobinHood.Money+import RobinHood.Prelude+import RobinHood.TargetPeriod+import System.Directory++attoparsecReader :: A.Parser a -> ReadM a+attoparsecReader p = eitherReader (A.parseOnly (p <* A.endOfInput) . T.pack)+++data CmdArgs+  = CmdArgs+    { targetPeriod :: Set TargetPeriod -- ^ by default last year and last complete quater (for estimate prepayment)+    , codesToSkip :: Set ByteString -- ^ trans codes to skip+    , blockSize :: Int+    , initBalance :: Money+    , taxBraket :: Double+    -- argument+    , csvInputDir :: FilePath -- ^ dir with CSV files from RobinHood+    } deriving (Show, Eq, Generic)+++cmdArgsParser :: Set TargetPeriod -> Parser CmdArgs+cmdArgsParser defaultTargetPeriods =+  CmdArgs+    <$> option (fromList <$> (attoparsecReader (A.many1' (A.skipSpace >> targetPeriodParser))))+        (  long "target-period"+        <> short 'p'+        <> value defaultTargetPeriods+        <> helpDoc (pure $ vsep [ "Tax year or quarter (eg '* 2025 Q2/2026')."+                                , "Multiple values are supported separated with a space."+                                , "By default max year, quater and \"star\"."+                                ]))+    <*> option (fromList <$> (maybeReader (pure . fmap C8.pack . S.words)))+        (  long "skip-codes"+        <> short 'c'+        <> value mempty+        <> help "Rows to be skipped with values in Trans Code column")+    <*> option (auto >>= validateBlockSize)+        (  long "block-size"+        <> help "Size of CSV chunk in bytes loaded in RAM"+        <> value 32)+     <*> option (attoparsecReader (Money . fromInteger <$> A.decimal))+                (  long "init-balance"+                  <> short 'b'+                  <> value 0+                  <> showDefault+                  <> help "account balance by the time of first row in the activity report"+                )+    <*> option auto+        (  long "tax"+        <> short 't'+        <> help "Tax percent"+        <> showDefault+        <> value 0.24)+    <*> strArgument+        (  help "Path to directory with RobinHood activity reports (CSV files)"+        <> showDefault+        <> metavar "CSVDIR"+        <> value ".")+  where+    validateBlockSize i+      | i < 16    = fail $ "Block size is less than 16 bytes: " <> show i+      | otherwise = pure i+++parseCmdArgs :: IO CmdArgs+parseCmdArgs = do+  defTargets <- fromList . defaultTargetPeriodsFor . utctDay <$> getCurrentTime+  a <- execParser $ opts defTargets+  whenM (not <$> doesDirectoryExist a.csvInputDir) $+    fail $ "Directory " <> show a.csvInputDir <> " does not exist"+  pure a+  where+    opts defTargets =+      info+        (cmdArgsParser defTargets <**> helper)+        (  fullDesc+        <> progDesc "Calc year and quarter profit based on RobinHood activity reports in CSV format"+        <> header "header"+        )
+ src/RobinHood/Compactable.hs view
@@ -0,0 +1,30 @@+module RobinHood.Compactable where++import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import RobinHood.Prelude++class Compactable k where+  compact :: k -> k++instance Compactable String where+  compact = id+  {-# INLINE compact #-}+instance Compactable Int where+  compact = id+  {-# INLINE compact #-}+instance Compactable BS.ByteString where+  compact = BS.copy+  {-# INLINE compact #-}+instance Compactable LBS.ByteString where+  compact = LBS.copy+  {-# INLINE compact #-}++merge :: (Ord k, Compactable k) => k -> v -> (v -> v) -> Map k v -> Map k v+merge k newV mergeV m =+  case lookup k m of+    Nothing ->+      insert (compact k) newV m+    Just e ->+      insert k (mergeV e) m+{-# INLINE merge #-}
+ src/RobinHood/CsvParser.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedLabels #-}++module RobinHood.CsvParser where++import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 hiding (takeWhile1)+import Data.ByteString.Char8 (hGet)+import Data.Char qualified as C+import GHC.IO.Handle (HandlePosn(HandlePosn))+import RobinHood.Prelude+import RobinHood.Char8+import RobinHood.AppState+import RobinHood.RobinRow+import System.IO hiding (char8, putStrLn)+++parseUnquotedCell :: BackParser ByteString+parseUnquotedCell = takeWhile1 p <|> pure ""+  where+    p c = c /= comma && c /= 10 && c /= 13++parseDoubleQuotedCell :: BackParser ByteString+parseDoubleQuotedCell =+  char8 '"' *> (takeWhile1 (/= dQuote) <|> pure "") <*  char8 '"'+  where+    dQuote = fromIntegral (C.ord '"')++parseCell :: BackParser ByteString+parseCell = parseDoubleQuotedCell <|> parseUnquotedCell++parseRow :: BackParser [ByteString]+parseRow = do+  skipSpace+  (endOfInput >> pure []) <|> go+  where+    go = do+      cells <- many' (parseCell <* char8 ',')+      firstCell <- parseCell+      pure $ firstCell : cells++readBlock :: Handle -> ProfitM ByteString+readBlock h = do+  iBlock <- gets currentBlock+  if iBlock < 0+    then pure mempty+    else do+      bs <- asks (^. #blockSize)+      r <- liftIO $ do+        hSeek h AbsoluteSeek $ unBlockId iBlock * fromIntegral bs+        hGet h bs+      modify (#currentBlock .~ iBlock - 1)+      pure r++findLastBlock :: MonadIO m => Int -> Handle -> m BlockId+findLastBlock blockSize' h = liftIO $ do+  hSeek h SeekFromEnd 0+  HandlePosn _ hSize <- hGetPosn h+  let bs = fromIntegral blockSize'+  pure . BlockId .  max 0 $ (hSize `div` bs) - if hSize `mod` bs == 0 then 1 else 0++consumeFile :: Handle -> (RobinRow -> ProfitM ()) -> ProfitM ()+consumeFile h handleRow = do+  input <- readBlock h+  go Nothing input+  where+    go !loopDetector input = do+      iBlock <- gets (^. #currentBlock)+      if iBlock < 0 && input == mempty+        then pure ()+        else do+          parseBackWith (readBlock h) parseRow input >>= \case+            Fail _unconsumed ctx er -> do+              erpos <- liftIO $ hTell h+              fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: "+                <> show er <> "; context: " <> show ctx+            Partial _ -> fail "CSV file is partial"+            Done (unconsumed :: ByteString) (rawRow :: [ByteString]) -> do+              iBlock' <- gets (^. #currentBlock)+              if loopDetector == Just (unconsumed, iBlock')+                then+                  fail $ "Loop detected. Unconsumed input: " <> show unconsumed+                else do+                  trashCodes <- asks (^. #codesToSkip)+                  case parseRobinRow trashCodes rawRow of+                    Left e -> fail e+                    Right row -> do+                      forM_ row handleRow+                      go (Just (unconsumed, iBlock')) unconsumed+++consumeFileUntil :: Handle -> ProfitM (Maybe RobinRow)+consumeFileUntil h  = do+  input <- readBlock h+  go Nothing input+  where+    go !loopDetector input = do+      iBlock <- gets (^. #currentBlock)+      if iBlock < 0 && input == mempty+        then pure $ Nothing+        else do+          parseBackWith (readBlock h) parseRow input >>= \case+            Fail _unconsumed ctx er -> do+              erpos <- liftIO $ hTell h+              fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: "+                <> show er <> "; context: " <> show ctx+            Partial _ -> fail "CSV file is partial"+            Done (unconsumed :: ByteString) (rawRow :: [ByteString]) -> do+              iBlock' <- gets (^. #currentBlock)+              if loopDetector == Just (unconsumed, iBlock')+                then+                  fail $ "Loop detected. Unconsumed input: " <> show unconsumed+                else do+                  trashCodes <- asks (^. #codesToSkip)+                  case parseRobinRow trashCodes rawRow of+                    Left e -> fail e+                    Right mayRow ->+                      case mayRow of+                        Nothing -> go (Just (unconsumed, iBlock')) unconsumed+                        Just justRow -> pure $ (Just justRow)
+ src/RobinHood/Date.hs view
@@ -0,0 +1,38 @@+module RobinHood.Date where++import RobinHood.CellParser+import RobinHood.Char8+import RobinHood.Prelude+++newtype Date = Date Day deriving (Show, Eq, Ord)++-- > 2/10/2025+parseDate :: CellParser Date+parseDate = go <?> "date"+  where+    go = do+      month <- decimal+      void (word8 slash)+      day <- decimal+      void (word8 slash)+      year <- decimal+      endOfInput+      case fromGregorianValid year month day of+        Nothing -> fail $ "Wrong Date " <> show month <> "/" <> show day <> "/" <> show year+        Just d -> pure $ Date d++instance PrintfArg Date where+  formatArg (Date d) ff =+    case ff.fmtWidth of+      Nothing -> (show d <>)+      Just w ->+        let s :: String = show d in+          ((replicate (w - length s) ' ' <> s) <>)++instance PrintfArg (Maybe (Min Date)) where+  formatArg Nothing ff =+    case ff.fmtWidth of+      Nothing -> ("" <>)+      Just w -> ((replicate w ' ') <>)+  formatArg (Just (Min d)) ff = formatArg d ff
+ src/RobinHood/Instrument.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingStrategies #-}+module RobinHood.Instrument where++import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as C8+import Data.Semigroup.Generic+import RobinHood.Compactable (Compactable)+import RobinHood.Date+import RobinHood.Money+import RobinHood.Prelude+import RobinHood.TargetPeriod++newtype RhInstrumentName = RhInstrumentName ByteString+  deriving newtype (Show, Eq, Ord, Compactable)++instance PrintfArg RhInstrumentName where+  formatArg (RhInstrumentName n) ff =+    case ff.fmtWidth of+      Nothing -> (C8.unpack n <>)+      Just w ->+        ((replicate (w - B.length n) ' ' <> C8.unpack n) <>)++parseInstrumentName :: ByteString -> Either String RhInstrumentName+parseInstrumentName "" = fail "Empty Instrument name"+parseInstrumentName o = pure $ RhInstrumentName o++data InstrumentProfit+  = InstrumentProfit+    { capitalGain :: !Money+    , oversell :: !(Maybe (Min Date))+    , dividend :: !Money+    , fee :: !Money+    , tax :: !Money+    } deriving (Show, Generic)++instance Semigroup InstrumentProfit where+  (<>) = gmappend++instance Monoid InstrumentProfit where+  mempty = InstrumentProfit 0 mempty 0 0 0++data RhInstrument+  = RhInstrument+  { name :: !RhInstrumentName+  , cumQuantity :: !Int+  , avgCost :: ![(Int, Money)]+  , previousDay :: !Date+  , profit :: !(Map TargetPeriod InstrumentProfit)+  } deriving (Show, Generic)
+ src/RobinHood/Money.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module RobinHood.Money where++import Data.ByteString qualified as B8+import Data.Decimal qualified as D+import RobinHood.CellParser+import RobinHood.Char8+import RobinHood.Prelude++newtype Money+  = Money+  { unMoney :: D.Decimal }+  deriving newtype (Show, Eq, Ord, Num)+  deriving stock (Generic)++instance Semigroup Money where+  Money a <> Money b = Money $ a + b++divide :: Money -> Int -> [(Int, Money)]+divide (Money d) n = (_2 %~ Money) <$> d `D.divide` n++totalSum :: [(Int, Money)] -> Money+totalSum = sum . fmap (\(a, b) -> fromIntegral a * b)++partSum :: Int -> [(Int, Money)] -> (Money, [(Int, Money)])+partSum nToTake = go nToTake 0+  where+    go 0 !finalSum restShares =+      (finalSum, restShares)+    go !nLeft !interSum ((shares, price):t)+      | nLeft < shares = (interSum + fromIntegral nLeft * price, (shares - nLeft, price):t)+      | otherwise = go (nLeft - shares) (interSum + fromIntegral shares * price) t+    go _ !finalSum [] = (finalSum, [])++-- parseBracket ::+parseBracket :: (b -> b) -> CellParser a -> CellParser b -> CellParser c -> CellParser b+parseBracket flipSign openPar inPar closePar =+  (void openPar >* (flipSign <$> inPar <?> "enParented") *< void closePar) <|> inPar++parseEnParent :: (a -> a) -> CellParser a -> CellParser a+parseEnParent flipSign inPar = parseBracket flipSign (char8 '(') inPar (char8 ')')++-- > -$38,877.00+parseMoney :: CellParser Money+parseMoney = parseEnParent (* (-1)) (bareMoney <?> "bareMoney")+  where+    bareMoney = do+      sign <- (void (char8 '-') >> pure (-1)) <|> pure 1+      void (char8 '$' <?> "dollar sign")+      n <- B8.foldl' step 0 <$> takeWhile1 isDigitOrComma+      void (char8 '.' <?> "comma")+      fraq  <- takeWhile1 isDigit+      let l = B8.length fraq+      if l > 22+        then fail $ "Too many digits after comma" <> show n <> "." <> show fraq+        else pure . Money . D.Decimal (fromIntegral l) $ sign * B8.foldl' step n fraq+    step a w+      | isDigit w = digitStep a w+      | w == comma = a+      | otherwise = error $ "Dead code when w = "  <> show w++    isDigit w = w >= zero && w <= nine+    isDigitOrComma w = isDigit w || w == comma
+ src/RobinHood/Prelude.hs view
@@ -0,0 +1,13 @@+module RobinHood.Prelude (module X) where++import Control.Lens as X (Lens', (.~), (^?), (^.), (%~), (^..), preview, traverseMax, at, ix)+import Control.Lens.Tuple as X+import Data.Char as X (toLower)+import Data.List as X (isSuffixOf)+import Data.Map.Strict as X (insert, lookup, elems, unionsWith, toAscList)+import Data.Semigroup as X (Min (..), Max (..))+import Data.Time as X+import Debug.TraceEmbrace as X hiding (a)+import GHC.Generics as X+import Relude as X+import Text.Printf as X
+ src/RobinHood/Profit.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+module RobinHood.Profit where+++import RobinHood.AppState+import RobinHood.Compactable+import RobinHood.Money+import RobinHood.TargetPeriod+import RobinHood.Instrument+import RobinHood.Prelude+import RobinHood.RobinRow+++aggRow :: RobinRow -> ProfitM ()+aggRow = \case+  rtr@RobinTradeRow{} -> do+    tps <- targetPeriodsFor rtr.date+    modify' ( updateBalance rtr.date (rtr.amount +)+             . (#instruments %~ merge rtr.instrument+                 (newInstrumentByTrade rtr) (tradeUpdate tps rtr))+            )+  RobinBonusRow dt a ->+    modify' (updateBalance dt (a +))+  RobinFeeRow dt a ->+    modify' (updateBalance dt (a +))+  RobinAgencyFeeRow ins dt a ->+    updateProfitField #fee ins dt a+  RobinForeignTaxRow ins dt a ->+    updateProfitField #tax ins dt a+  RobinDividendRow ins dt a ->+    updateProfitField #dividend ins dt a+  RobinInterestRow dt a -> do+    tps <- targetPeriodsFor dt+    modify' ( updateBalance dt (a +)+              . (#interest %~ flip (foldl' (\p' tp -> merge tp a (a +) p')) tps)+            )++  RobinMoneyMoveRow dt a ->+    modify' (updateBalance dt (a +))+  RobinHeaderRow -> pure ()+  where+    updateProfitField (fieldLens :: Lens' InstrumentProfit Money) ins dt a = do+      tps <- targetPeriodsFor dt+      modify' ( updateBalance dt (a +)+              . (#instruments %~ merge ins+                                  (newInstrumentByNoTrade fieldLens a tps ins dt)+                                  (#profit %~ mergeInstProfitField fieldLens a tps)+                )+              )++    targetPeriodsFor dt = targetPeriodsByDate dt <$> asks (^. #targetPeriod)+    newInstrumentByNoTrade (fieldLens :: Lens' InstrumentProfit Money) dv tps insName dt =+      RhInstrument+      { name = insName+      , cumQuantity = 0+      , avgCost = []+      , previousDay = dt+      , profit = mergeInstProfitField fieldLens dv tps mempty+      }++    newInstrumentByTrade :: RobinRow -> RhInstrument+    newInstrumentByTrade rtr =+      RhInstrument+      { name = rtr.instrument+      , cumQuantity = rtr.quantity+      , avgCost = [(rtr.quantity, rtr.price)]+      , previousDay = rtr.date+      , profit = mempty+      }++    updateBalance dt df =+      (#balance %~ \cb ->+                     let nb = df cb in+                       if nb < 0+                       then error $+                            "Negative balance - history must be too short.\n" <>+                            "Hint: set init balance via -b option if history is not complete."+                       else nb)+      . (#lastRowDate %~ \case+            Nothing -> Just dt+            Just odt+              | odt > dt -> error $ "Unordered row " <> show odt <> " > " <> show dt+              | otherwise -> Just dt)++    mergeInstProfitField (fieldLens :: Lens' InstrumentProfit Money)  dv tps p =+      foldl' (\p' tp -> merge tp (mempty & (fieldLens .~ dv)) (fieldLens %~ (dv +)) p') p tps++    tradeUpdate tps rtr (ins :: RhInstrument)+      | ins.previousDay > rtr.date =+          error $ "Rows of " <> show ins.name <> " out of order"+      | rtr.amount < 0  =+          ins -- buy+          & #previousDay .~ rtr.date+          & #avgCost .~ (abs rtr.amount + totalSum ins.avgCost) `divide` (rtr.quantity + ins.cumQuantity)+          & #cumQuantity %~ (rtr.quantity +)+      | ins.cumQuantity < rtr.quantity = -- over sell+          ins+          & #profit %~ (mergeInstProfitFieldF #oversell rtr.date)+          & #cumQuantity .~ 0+          & #avgCost .~ []+          & #previousDay .~ rtr.date+      | otherwise =+          let (cost', avgCost') = partSum rtr.quantity ins.avgCost+              dGain = rtr.price * fromIntegral rtr.quantity - cost'+          in+            ins -- sell - avg cost does not change+            & #previousDay .~ rtr.date+            & #avgCost .~ avgCost'+            & #profit %~ mergeInstProfitField #capitalGain dGain tps+            & #cumQuantity %~ (-rtr.quantity +)+      where+        mergeInstProfitFieldF fieldLens d p =+          foldl' (\p' tp -> merge tp (mempty & (fieldLens .~ Just (Min d)))+                            (fieldLens %~ (Just (Min d) <>)) p')+          p tps
+ src/RobinHood/Report.hs view
@@ -0,0 +1,51 @@+module RobinHood.Report where++import Data.Map qualified as M+import RobinHood.AppState+import RobinHood.Money+import RobinHood.Prelude+import RobinHood.Instrument+++printReport :: ProfitM ()+printReport = do+  st <- get+  case preview traverseMax ((^. #previousDay) <$> st.instruments) of+    Nothing -> fail "No trades"+    Just _lastTradeDay -> do+      printPerInstrument st+      putStrLn "--------------------------------------------------------------"+      printAggByPeriod st+      putStrLn "--------------------------------------------------------------"+      putStrLn $ "Balance: " <> show ((round $ unMoney st.balance) :: Integer)++  where+    printAggByPeriod st = do+      tax' <- asks (^. #taxBraket)+      putStrLn " Period|      Gain|  Interest|  Dividend|    Profit|Tax Prepay|  Oversell"+      forM_ (toAscList . unionsWith (<>) . fmap (^. #profit) $ elems st.instruments) $ \(p, ip) -> do+        let inter = fromMaybe 0 $ st.interest ^. at p+            profit' = m2s $ ip.capitalGain + inter + ip.dividend - ip.tax+          in+          putStrLn $+            printf "%7s|%10d|%10d|%10d|%10d|%10.2f|%10s"+             p+             (m2s ip.capitalGain) (m2s inter) (m2s ip.dividend)+             profit'+             (tax' * fromIntegral profit')+             ip.oversell++    printPerInstrument st = do+      putStrLn "Instrument| Period|      Gain|  Dividend|    Profit|  Oversell"+      forM_ (elems st.instruments) $ \i -> do+        forM_ (M.toList i.profit) $ \(p, ip) -> do+          putStrLn $+            printf "%10s|%7s|%10d|%10d|%10d|%10s"+             i.name+             p+             (m2s ip.capitalGain) (m2s ip.dividend)+             (m2s $ ip.capitalGain + ip.dividend - ip.tax)+             ip.oversell++    m2s :: Money -> Int+    m2s (Money d) = round d
+ src/RobinHood/RobinRow.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+module RobinHood.RobinRow where++import Data.Set+import RobinHood.CellParser+import RobinHood.Date+import RobinHood.Instrument+import RobinHood.Money+import RobinHood.Prelude+++data RobinRow+  = RobinTradeRow -- change balance ande capital gain+    { date :: Date+    , instrument :: RhInstrumentName+    , quantity:: Int+    , price:: Money+    , amount :: Money+    }+  | RobinFeeRow -- change balance but not capital gain+    { date :: Date+    , amount :: Money+    }+  | RobinAgencyFeeRow -- change balance but not capital gain+    { instrument :: RhInstrumentName+    , date :: Date+    , amount :: Money+    }+  | RobinForeignTaxRow -- change balance and capital gain+    { instrument :: RhInstrumentName+    , date :: Date+    , amount :: Money+    }+  | RobinDividendRow -- change balance count and dividen+    { instrument :: RhInstrumentName+    , date :: Date+    , amount :: Money+    }+  | RobinInterestRow -- change balance and interest+    { date :: Date+    , amount :: Money+    }+  | RobinBonusRow -- change balance+    { date :: Date+    , amount :: Money+    }+  | RobinMoneyMoveRow -- change balance+    { date :: Date+    , amount :: Money+    }+  | RobinHeaderRow -- signal end of file+  deriving (Show, Eq, Generic)++parseRobinRow :: Set ByteString -> [ByteString] -> Either String (Maybe RobinRow)+parseRobinRow codesToIgnore rowCells =+  case rowCells of+   [_activityDate, rawProcessDate, _settleDate, rawInstrument, _description,+    rawTransCode, rawQuantity, rawPrice, rawAmount, ""] ->+     processRow rawProcessDate rawInstrument rawTransCode rawQuantity rawPrice rawAmount+   [_activityDate, rawProcessDate, _settleDate, rawInstrument, _description,+    rawTransCode, rawQuantity, rawPrice, rawAmount] ->+     processRow rawProcessDate rawInstrument rawTransCode rawQuantity rawPrice rawAmount+   [ "", "", "", "", "", "", "", "", "",+     _dataProvidedIsForInformationPurposeOnlyBlablabla] ->+     pure Nothing+   [ "" ] -> pure Nothing -- Skip a row with a single empty cell+   o -> fail $ "Wrong number of columns in " <> show o+  where+    processRow rawProcessDate rawInstrument rawTransCode rawQuantity rawPrice rawAmount =+      case rawTransCode of+        "Trans Code" -> pure $ Just RobinHeaderRow+        "ACH" ->  parseDateMoney RobinMoneyMoveRow rawProcessDate rawAmount+        "GOLD" -> parseDateMoney RobinFeeRow rawProcessDate rawAmount+        "GMPC" -> parseDateMoney RobinFeeRow rawProcessDate rawAmount+        "GDBP" -> parseDateMoney RobinBonusRow rawProcessDate rawAmount+        "DFEE" -> parseInstrDateMoney RobinAgencyFeeRow rawInstrument rawProcessDate rawAmount+        "AFEE" -> parseInstrDateMoney RobinAgencyFeeRow rawInstrument rawProcessDate rawAmount+        "DTAX" -> parseInstrDateMoney RobinForeignTaxRow rawInstrument rawProcessDate rawAmount+        "INT" ->  parseDateMoney RobinInterestRow rawProcessDate rawAmount+        "CDIV" -> parseInstrDateMoney RobinDividendRow rawInstrument rawProcessDate rawAmount+        "Sell" -> parseTrade rawProcessDate rawInstrument rawQuantity rawPrice rawAmount+        "Buy" ->  parseTrade rawProcessDate rawInstrument rawQuantity rawPrice rawAmount+        "SPL" ->  pure Nothing -- ?+        "SPR" ->  pure Nothing -- ?+        "" ->     pure Nothing+        oCode | oCode `member` codesToIgnore -> pure Nothing+              | otherwise -> fail $ "Unknown Trans Code: " <> show oCode++    parseCell :: (CellParser a) -> ByteString -> Either String a+    parseCell p bs =+      case parseOnly p bs of+         Left e -> fail $ e <> "\nOn the row " <> show rowCells+         Right v -> pure v+    parseInstrDateMoney dc ins dt am =+      Just <$> (dc <$> parseInstrumentName ins+                 <*> parseCell parseDate dt+                 <*> parseCell parseMoney am)+    parseDateMoney dc dt am =+      Just <$> (dc <$> parseCell parseDate dt <*> parseCell parseMoney am)+    parseTrade rawProcessDate rawInstrumentName rawQuantity rawPrice rawAmount =+      Just <$> (RobinTradeRow+        <$> parseCell parseDate rawProcessDate+        <*> parseInstrumentName rawInstrumentName+        <*> parseCell decimal rawQuantity+        <*> parseCell parseMoney rawPrice+        <*> parseCell parseMoney rawAmount)
+ src/RobinHood/Run.hs view
@@ -0,0 +1,69 @@+module RobinHood.Run where++import Control.Monad.Catch+import RobinHood.AppState+import RobinHood.Cmd+import RobinHood.CsvParser+import RobinHood.Date+import RobinHood.Prelude+import RobinHood.Profit+import RobinHood.Report+import RobinHood.RobinRow+import System.Directory+import System.FilePath ((</>))+import System.IO hiding (char8, putStrLn)+++sortedCsvFilesInTheDir :: FilePath -> ProfitM [FilePath]+sortedCsvFilesInTheDir d = do+  allFiles <- liftIO $ listDirectory d+  datedFiles <- mapM go (filter (isSuffixOf ".csv" . fmap toLower) allFiles)+  pure $ (fmap snd $ sort datedFiles)+ where+   go f =+     let fp = d </> f in+       (,fp) <$> readLastRowDate fp++readLastRowDate :: FilePath -> ProfitM Date+readLastRowDate csv = do+  bracket (liftIO (openFile csv ReadMode))+          (\h -> liftIO (hClose h)) $ \h -> do+    blkSz <- asks (^. #blockSize)+    lastBlock <- findLastBlock blkSz h+    modify' (#currentBlock .~ lastBlock)+    consumeFileUntil h >>= \case+      Nothing -> fail $ "File [" <> csv <> "] is empty"+      Just RobinHeaderRow -> fail $ "File [" <> csv <> "] is empty"+      Just row -> pure row.date++runRhProfit :: CmdArgs -> IO ()+runRhProfit args = void $ runReaderT (execStateT go st0) args+  where+    st0 = RhProfit 0 mempty mempty (args.initBalance) Nothing+    go = do+      sortedCsvFilesInTheDir args.csvInputDir >>= \case+        [] -> fail $ "Directory " <> show args.csvInputDir <> " does not have CSV files"+        ordCsvs ->+          goInM ordCsvs >> printReport++    goInM :: [FilePath] -> ProfitM ()+    goInM ordCsvs =+      forM_ ordCsvs $ \csv ->+        bracket (liftIO (openFile csv ReadMode))+                (\h -> liftIO (hClose h)) $ \h -> do+          blkSz <- asks (^. #blockSize)+          lastBlock <- findLastBlock blkSz h+          lastRowDate' <- gets (^. #lastRowDate)+          modify' (#currentBlock .~ lastBlock)+          let+            checkFileOrder = do+              lastRowDate'' <- gets (^. #lastRowDate)+              case (lastRowDate', lastRowDate'') of+                (Just j', Just j'')+                  | j' < j'' -> pure ()+                  | otherwise ->+                      error $ "Previous file and current file have overlapping dates in range: [" <>+                             show j'' <> ", " <> show j' <> "]"+                _ -> pure ()+          consumeFile h (\row -> aggRow row >> checkFileOrder)+      where
+ src/RobinHood/TargetPeriod.hs view
@@ -0,0 +1,78 @@+module RobinHood.TargetPeriod where++import Data.Attoparsec.Text qualified as A+import RobinHood.Compactable+import RobinHood.Prelude+import RobinHood.Date++newtype Quarter = Quarter Int deriving (Show, Eq, Ord)++data TargetPeriod+  = QuarterPeriod Year Quarter+  | YearPeriod Year+  | StarPeriod+  deriving (Show, Eq, Ord)++instance PrintfArg TargetPeriod where+  formatArg StarPeriod ff =+    case ff.fmtWidth of+      Nothing -> ("*" <>)+      Just w -> ((replicate (w - 1) ' ' <> "*") <>)+  formatArg (YearPeriod y) ff =+    let sy :: String = show y in+      case ff.fmtWidth of+        Nothing -> (sy <>)+        Just w -> ((replicate (w - length sy) ' ' <> sy) <>)+  formatArg (QuarterPeriod y (Quarter q)) ff =+    let sy :: String = show y+        sq :: String = show q+        s = "Q" <> sq <> "/" <> sy+    in+      case ff.fmtWidth of+        Nothing -> (s <>)+        Just w -> ((replicate (w - length s) ' ' <> s) <>)++instance Compactable TargetPeriod where+  compact = id+  {-# INLINE compact #-}++monthToQuater :: Int -> Quarter+monthToQuater m+  | m > 0 && m < 13 = Quarter $ (m `div` 4)  + 1+  | otherwise = error $ "Month out of range: " <> show m++targetPeriodsByDate :: Date -> Set TargetPeriod -> [TargetPeriod]+targetPeriodsByDate (Date dt) tps = filter p $ toList tps+  where+    (dtY, dtM, _d) = toGregorian dt+    p = \case+      StarPeriod -> True+      YearPeriod y -> y == dtY+      QuarterPeriod y q -> y == dtY && q == monthToQuater dtM++targetPeriodParser :: A.Parser TargetPeriod+targetPeriodParser = do+  qPeriod <|> yPeriod <|> star+  where+    yPeriod = YearPeriod <$> A.decimal+    star = A.char '*' >> pure StarPeriod+    qPeriod = do+      q <- (A.char 'q' <|> A.char 'Q') >> A.decimal+      y <- A.char '/' >> A.decimal+      if q > 0 && q < 5+        then pure $ QuarterPeriod y (Quarter q)+        else fail $ "Quater out of range: [" <> show q <> "]"++defaultTargetPeriodsFor :: Day -> [TargetPeriod]+defaultTargetPeriodsFor now = [StarPeriod, YearPeriod yPeriod, qPeriod]+  where+    (y, moy, dom) = toGregorian now+    qPeriod+      | (moy, dom) < (January, 15) = QuarterPeriod (y - 1) $ Quarter 4+      | (moy, dom) < (April, 15) = QuarterPeriod y $ Quarter 1+      | (moy, dom) < (July, 15) = QuarterPeriod y $ Quarter 2+      | (moy, dom) < (October, 15) = QuarterPeriod y $ Quarter 3+      | otherwise = QuarterPeriod y $ Quarter 4+    yPeriod+      | (moy, dom) < (April, 15) = y - 1+      | otherwise = y
+ test/Discovery.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=Discovery #-}
+ test/Driver.hs view
@@ -0,0 +1,13 @@+module Driver where++import qualified Discovery+import Relude+import Test.Tasty++main :: IO ()+main = defaultMain =<< testTree+  where+    testTree :: IO TestTree+    testTree = do+      tests <- Discovery.tests+      pure $ testGroup "bytestring-lazy" [ tests ]
+ test/RobinHood/Test/Money.hs view
@@ -0,0 +1,40 @@+module RobinHood.Test.Money where++import Data.Attoparsec.ByteString (parseOnly)+import Data.Text.Encoding as DTE+import RobinHood.Money+import RobinHood.Prelude+import Test.Tasty.QuickCheck++prop_parseMoney_showed_positive_int :: Positive Int -> Bool+prop_parseMoney_showed_positive_int (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ "$" <> show n <> ".00") == pure (Money $ fromIntegral n)++prop_parseMoney_showed_negative_int :: Positive Int -> Bool+prop_parseMoney_showed_negative_int (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ "-$" <> show n <> ".00") == pure (Money $ fromIntegral (-n))++prop_parseMoney_zero :: Bool+prop_parseMoney_zero =+  parseOnly parseMoney "$0.00" == pure 0++prop_parseMoney_showed_positive_cents :: Positive Int -> Bool+prop_parseMoney_showed_positive_cents (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ toText centsStr) == pure (Money $ fromIntegral n / 100)+  where+    cents = n `mod` 100+    centsStr :: String = printf "$0.%02d" cents++prop_parseMoney_thousands :: Positive Int -> Bool+prop_parseMoney_thousands (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ "$" <> show n <> ",000.00") == pure (Money $ fromIntegral n * 1_000)++-- new report uses parentheses for encoding negative values+-- lol+prop_parseMoney_parentheses :: Positive Int -> Bool+prop_parseMoney_parentheses (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ "($" <> show n <> ".00)") == pure (Money $ fromIntegral n * (-1))++prop_parseMoney_parentheses_negative :: Positive Int -> Bool+prop_parseMoney_parentheses_negative (Positive n) =+  parseOnly parseMoney (DTE.encodeUtf8 $ "(-$" <> show n <> ".00)") == pure (Money $ fromIntegral n)
+ test/RobinHood/Test/TargetPeriod.hs view
@@ -0,0 +1,20 @@+module RobinHood.Test.TargetPeriod where++import Data.Attoparsec.Text (parseOnly)+import RobinHood.TargetPeriod+import RobinHood.Prelude+import Test.Tasty.QuickCheck++prop_monthToQuarter_less_4 :: Positive Int -> Bool+prop_monthToQuarter_less_4 (Positive n) = monthToQuater ((n `mod` 12) + 1) < Quarter 5++prop_monthToQuarter_positive :: Positive Int -> Bool+prop_monthToQuarter_positive (Positive n) = monthToQuater ((n `mod` 12) + 1) > Quarter 0++prop_targetPeriodParser_q_year :: Positive Int -> Positive Int -> Bool+prop_targetPeriodParser_q_year (Positive q) (Positive y) = got == pure expected+  where+    got = parseOnly targetPeriodParser ("Q" <> show q' <> "/202" <> show y')+    expected = QuarterPeriod (fromIntegral $ 2020 + y') (Quarter q')+    q' = q `mod` 4 + 1+    y' = y `mod` 10