{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp  #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE RecordWildCards   #-}
{-|

The @roi@ command prints internal rate of return and time-weighted rate of return for and investment.

-}

module Hledger.Cli.Commands.Roi (
  roimode
  , roi
) where

import Control.Monad
import System.Exit
import Data.Time.Calendar
import Text.Printf
import Data.Bifunctor (second)
import Data.Either (fromLeft, fromRight, isLeft)
import Data.Function (on)
import Data.List
import Numeric.RootFinding
import Data.Decimal
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import System.Console.CmdArgs.Explicit as CmdArgs

import Text.Tabular.AsciiWide as Tab

import Hledger
import Hledger.Cli.CliOptions


roimode :: Mode RawOpts
roimode = [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Roi.txt")
  [forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"cashflow"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"cashflow") [Char]
"show all amounts that were used to compute returns"
  ,forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"investment"] (\[Char]
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"investment" [Char]
s RawOpts
opts) [Char]
"QUERY"
    [Char]
"query to select your investment transactions"
  ,forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"profit-loss",[Char]
"pnl"] (\[Char]
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"pnl" [Char]
s RawOpts
opts) [Char]
"QUERY"
    [Char]
"query to select profit-and-loss or appreciation/valuation transactions"
  ]
  [([Char], [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[QUERY]")

-- One reporting span,
data OneSpan = OneSpan
  Day -- start date, inclusive
  Day   -- end date, exclusive
  MixedAmount -- value of investment at the beginning of day on spanBegin_
  MixedAmount -- value of investment at the end of day on spanEnd_
  [(Day,MixedAmount)] -- all deposits and withdrawals (but not changes of value) in the DateSpan [spanBegin_,spanEnd_)
  [(Day,MixedAmount)] -- all PnL changes of the value of investment in the DateSpan [spanBegin_,spanEnd_)
 deriving (Int -> OneSpan -> ShowS
[OneSpan] -> ShowS
OneSpan -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OneSpan] -> ShowS
$cshowList :: [OneSpan] -> ShowS
show :: OneSpan -> [Char]
$cshow :: OneSpan -> [Char]
showsPrec :: Int -> OneSpan -> ShowS
$cshowsPrec :: Int -> OneSpan -> ShowS
Show)


roi ::  CliOpts -> Journal -> IO ()
roi :: CliOpts -> Journal -> IO ()
roi CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts{Bool
Int
[Text]
[Status]
Maybe Int
Maybe Text
Maybe ConversionOp
Maybe ValuationType
Maybe NormalSign
BalanceCalculation
BalanceAccumulation
AccountListMode
Layout
StringFormat
Period
Interval
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
conversionop_ :: ReportOpts -> Maybe ConversionOp
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
date2_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
average_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
txn_dates_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
budgetpat_ :: ReportOpts -> Maybe Text
accountlistmode_ :: ReportOpts -> AccountListMode
drop_ :: ReportOpts -> Int
declared_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
invert_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
color_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
layout_ :: Layout
transpose_ :: Bool
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
show_costs_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
declared_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
budgetpat_ :: Maybe Text
balanceaccum_ :: BalanceAccumulation
balancecalc_ :: BalanceCalculation
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
pretty_ :: Bool
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_prices_ :: Bool
value_ :: Maybe ValuationType
conversionop_ :: Maybe ConversionOp
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
..}}} Journal
j = do
  -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
  let
    today :: Day
today = ReportSpec -> Day
_rsDay ReportSpec
rspec
    priceOracle :: PriceOracle
priceOracle = Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer_prices_ Journal
j
    styles :: Map Text AmountStyle
styles = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j
    mixedAmountValue :: Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
periodlast Day
date =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceOracle Map Text AmountStyle
styles Day
periodlast Day
today Day
date) Maybe ValuationType
value_
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (Map Text AmountStyle -> ConversionOp -> MixedAmount -> MixedAmount
mixedAmountToCost Map Text AmountStyle
styles) Maybe ConversionOp
conversionop_

  let
    ropts :: ReportOpts
ropts = ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
    wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts
    showCashFlow :: Bool
showCashFlow = [Char] -> RawOpts -> Bool
boolopt [Char]
"cashflow" RawOpts
rawopts
    prettyTables :: Bool
prettyTables = Bool
pretty_
    makeQuery :: [Char] -> m Query
makeQuery [Char]
flag = do
        Query
q <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. [Char] -> a
usageError (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
today forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> [Char]
stringopt [Char]
flag RawOpts
rawopts
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags ReportOpts
ropts{period_ :: Period
period_=Period
PeriodAll}, Query
q]

  Query
investmentsQuery <- forall {m :: * -> *}. Monad m => [Char] -> m Query
makeQuery [Char]
"investment"
  Query
pnlQuery         <- forall {m :: * -> *}. Monad m => [Char] -> m Query
makeQuery [Char]
"pnl"

  let
    filteredj :: Journal
filteredj = Query -> Journal -> Journal
filterJournalTransactions Query
investmentsQuery Journal
j
    trans :: [Transaction]
trans = forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"investments" forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
filteredj

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
trans) forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO ()
putStrLn [Char]
"No relevant transactions found. Check your investments query"
    forall a. IO a
exitFailure

  let spans :: [DateSpan]
spans = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan Journal
filteredj ReportSpec
rspec

  let priceDirectiveDates :: [Day]
priceDirectiveDates = forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"priceDirectiveDates" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> Day
pddate forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j

  [[Text]]
tableBody <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DateSpan]
spans forall a b. (a -> b) -> a -> b
$ \spn :: DateSpan
spn@(DateSpan (Just Day
begin) (Just Day
end)) -> do
    -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
    let
      cashFlowApplyCostValue :: [(Day, MixedAmount)] -> [(Day, MixedAmount)]
cashFlowApplyCostValue = forall a b. (a -> b) -> [a] -> [b]
map (\(Day
d,MixedAmount
amt) -> (Day
d,Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
end Day
d MixedAmount
amt))

      valueBefore :: MixedAmount
valueBefore =
        Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
end Day
begin forall a b. (a -> b) -> a -> b
$ 
        [Transaction] -> Query -> MixedAmount
total [Transaction]
trans ([Query] -> Query
And [ Query
investmentsQuery
                         , DateSpan -> Query
Date (Maybe Day -> Maybe Day -> DateSpan
DateSpan forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Day
begin))])

      valueAfter :: MixedAmount
valueAfter  =
        Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
end Day
end forall a b. (a -> b) -> a -> b
$ 
        [Transaction] -> Query -> MixedAmount
total [Transaction]
trans ([Query] -> Query
And [Query
investmentsQuery
                         , DateSpan -> Query
Date (Maybe Day -> Maybe Day -> DateSpan
DateSpan forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Day
end))])

      priceDates :: [Day]
priceDates = forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"priceDates" forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
spn) [Day]
priceDirectiveDates
      cashFlow :: [(Day, MixedAmount)]
cashFlow =
        ((forall a b. (a -> b) -> [a] -> [b]
map (,MixedAmount
nullmixedamt) [Day]
priceDates)forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
        [(Day, MixedAmount)] -> [(Day, MixedAmount)]
cashFlowApplyCostValue forall a b. (a -> b) -> a -> b
$
        WhichDate -> [Transaction] -> Query -> [(Day, MixedAmount)]
calculateCashFlow WhichDate
wd [Transaction]
trans ([Query] -> Query
And [ Query -> Query
Not Query
investmentsQuery
                                        , Query -> Query
Not Query
pnlQuery
                                        , DateSpan -> Query
Date DateSpan
spn ] )


      pnl :: [(Day, MixedAmount)]
pnl =
        [(Day, MixedAmount)] -> [(Day, MixedAmount)]
cashFlowApplyCostValue forall a b. (a -> b) -> a -> b
$
        WhichDate -> [Transaction] -> Query -> [(Day, MixedAmount)]
calculateCashFlow WhichDate
wd [Transaction]
trans ([Query] -> Query
And [ Query -> Query
Not Query
investmentsQuery
                                        , Query
pnlQuery
                                        , DateSpan -> Query
Date DateSpan
spn ] )

      thisSpan :: OneSpan
thisSpan = forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"processing span" forall a b. (a -> b) -> a -> b
$
                 Day
-> Day
-> MixedAmount
-> MixedAmount
-> [(Day, MixedAmount)]
-> [(Day, MixedAmount)]
-> OneSpan
OneSpan Day
begin Day
end MixedAmount
valueBefore MixedAmount
valueAfter [(Day, MixedAmount)]
cashFlow [(Day, MixedAmount)]
pnl

    Double
irr <- Bool -> Bool -> OneSpan -> IO Double
internalRateOfReturn Bool
showCashFlow Bool
prettyTables OneSpan
thisSpan
    Double
twr <- Bool
-> Bool
-> Query
-> [Transaction]
-> (Day -> Day -> MixedAmount -> MixedAmount)
-> OneSpan
-> IO Double
timeWeightedReturn Bool
showCashFlow Bool
prettyTables Query
investmentsQuery [Transaction]
trans Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue OneSpan
thisSpan
    let cashFlowAmt :: MixedAmount
cashFlowAmt = MixedAmount -> MixedAmount
maNegate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Day, MixedAmount)]
cashFlow
    let smallIsZero :: a -> a
smallIsZero a
x = if forall a. Num a => a -> a
abs a
x forall a. Ord a => a -> a -> Bool
< a
0.01 then a
0.0 else a
x
    forall (m :: * -> *) a. Monad m => a -> m a
return [ Day -> Text
showDate Day
begin
           , Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
end)
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Char]
showMixedAmount MixedAmount
valueBefore
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Char]
showMixedAmount MixedAmount
cashFlowAmt
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Char]
showMixedAmount MixedAmount
valueAfter
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Char]
showMixedAmount (MixedAmount
valueAfter MixedAmount -> MixedAmount -> MixedAmount
`maMinus` (MixedAmount
valueBefore MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
cashFlowAmt))
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.2f%%" forall a b. (a -> b) -> a -> b
$ forall {a}. (Ord a, Fractional a) => a -> a
smallIsZero Double
irr
           , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.2f%%" forall a b. (a -> b) -> a -> b
$ forall {a}. (Ord a, Fractional a) => a -> a
smallIsZero Double
twr ]

  let table :: Table Text Text Text
table = forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
              (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine (forall a b. (a -> b) -> [a] -> [b]
map (forall h. h -> Header h
Header forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
tableBody) [Integer
1..])))
              (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.DoubleLine
               [ forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Header Text
"Begin", forall h. h -> Header h
Header Text
"End"]
               , forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Header Text
"Value (begin)", forall h. h -> Header h
Header Text
"Cashflow", forall h. h -> Header h
Header Text
"Value (end)", forall h. h -> Header h
Header Text
"PnL"]
               , forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Header Text
"IRR", forall h. h -> Header h
Header Text
"TWR"]])
              [[Text]]
tableBody

  Text -> IO ()
TL.putStrLn forall a b. (a -> b) -> a -> b
$ forall rh ch a.
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
Tab.render Bool
prettyTables forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id Table Text Text Text
table

timeWeightedReturn :: Bool
-> Bool
-> Query
-> [Transaction]
-> (Day -> Day -> MixedAmount -> MixedAmount)
-> OneSpan
-> IO Double
timeWeightedReturn Bool
showCashFlow Bool
prettyTables Query
investmentsQuery [Transaction]
trans Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue (OneSpan Day
begin Day
end MixedAmount
valueBeforeAmt MixedAmount
valueAfter [(Day, MixedAmount)]
cashFlow [(Day, MixedAmount)]
pnl) = do
  let valueBefore :: Decimal
valueBefore = MixedAmount -> Decimal
unMix MixedAmount
valueBeforeAmt
  let initialUnitPrice :: Decimal
initialUnitPrice = Decimal
100 :: Decimal
  let initialUnits :: Decimal
initialUnits = Decimal
valueBefore forall a. Fractional a => a -> a -> a
/ Decimal
initialUnitPrice
  let changes :: [(Day, Either MixedAmount MixedAmount)]
changes =
        -- If cash flow and PnL changes happen on the same day, this
        -- will sort PnL changes to come before cash flows (on any
        -- given day), so that we will have better unit price computed
        -- first for processing cash flow. This is why pnl changes are Left
        -- and cashflows are Right.
        -- However, if the very first date in the changes list has both
        -- PnL and CashFlow, we would not be able to apply pnl change to 0 unit,
        -- which would lead to an error. We make sure that we have at least one
        -- cashflow entry at the front, and we know that there would be at most
        -- one for the given date, by construction. Empty CashFlows added
        -- because of a begin date before the first transaction are not seen as
        -- a valid cashflow entry at the front.
        forall {a} {a}.
[(a, Either a MixedAmount)] -> [(a, Either a MixedAmount)]
zeroUnitsNeedsCashflowAtTheFront
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort
        forall a b. (a -> b) -> a -> b
$ forall {a}. [(Day, Either a MixedAmount)]
datedCashflows forall a. [a] -> [a] -> [a]
++ forall {b}. [(Day, Either MixedAmount b)]
datedPnls
        where
          zeroUnitsNeedsCashflowAtTheFront :: [(a, Either a MixedAmount)] -> [(a, Either a MixedAmount)]
zeroUnitsNeedsCashflowAtTheFront [(a, Either a MixedAmount)]
changes1 =
            if Decimal
initialUnits forall a. Ord a => a -> a -> Bool
> Decimal
0 then [(a, Either a MixedAmount)]
changes1
            else 
              let ([(a, Either a MixedAmount)]
leadingEmptyCashFlows, [(a, Either a MixedAmount)]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall {a} {a}. (a, Either a MixedAmount) -> Bool
isEmptyCashflow [(a, Either a MixedAmount)]
changes1
                  ([(a, Either a MixedAmount)]
leadingPnls, [(a, Either a MixedAmount)]
rest') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a b. Either a b -> Bool
isLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Either a MixedAmount)]
rest
                  ([(a, Either a MixedAmount)]
firstCashflow, [(a, Either a MixedAmount)]
rest'') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [(a, Either a MixedAmount)]
rest'
              in [(a, Either a MixedAmount)]
leadingEmptyCashFlows forall a. [a] -> [a] -> [a]
++ [(a, Either a MixedAmount)]
firstCashflow forall a. [a] -> [a] -> [a]
++ [(a, Either a MixedAmount)]
leadingPnls forall a. [a] -> [a] -> [a]
++ [(a, Either a MixedAmount)]
rest''

          isEmptyCashflow :: (a, Either a MixedAmount) -> Bool
isEmptyCashflow (a
_date, Either a MixedAmount
amt) = case Either a MixedAmount
amt of
            Right MixedAmount
amt' -> MixedAmount -> Bool
mixedAmountIsZero MixedAmount
amt'
            Left a
_     -> Bool
False

          datedPnls :: [(Day, Either MixedAmount b)]
datedPnls = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. a -> Either a b
Left) forall a b. (a -> b) -> a -> b
$ forall {b}. Ord b => [(b, MixedAmount)] -> [(b, MixedAmount)]
aggregateByDate [(Day, MixedAmount)]
pnl
 
          datedCashflows :: [(Day, Either a MixedAmount)]
datedCashflows = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. b -> Either a b
Right) forall a b. (a -> b) -> a -> b
$ forall {b}. Ord b => [(b, MixedAmount)] -> [(b, MixedAmount)]
aggregateByDate [(Day, MixedAmount)]
cashFlow

          aggregateByDate :: [(b, MixedAmount)] -> [(b, MixedAmount)]
aggregateByDate [(b, MixedAmount)]
datedAmounts = 
            -- Aggregate all entries for a single day, assuming that intraday interest is negligible
            forall a. Ord a => [a] -> [a]
sort
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[(b, MixedAmount)]
date_cash -> let ([b]
dates, [MixedAmount]
cash) = forall a b. [(a, b)] -> ([a], [b])
unzip [(b, MixedAmount)]
date_cash in (forall a. [a] -> a
head [b]
dates, forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
cash))
            forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
            forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second MixedAmount -> MixedAmount
maNegate)
            forall a b. (a -> b) -> a -> b
$ [(b, MixedAmount)]
datedAmounts

  let units :: [(Decimal, Decimal, Decimal, Decimal)]
units =
        forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$
        forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
          (\(Decimal
_, Decimal
_, Decimal
unitPrice, Decimal
unitBalance) (Day
date, Either MixedAmount MixedAmount
amt) ->
             let valueOnDate :: Decimal
valueOnDate = MixedAmount -> Decimal
unMix forall a b. (a -> b) -> a -> b
$ Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
end Day
date forall a b. (a -> b) -> a -> b
$ [Transaction] -> Query -> MixedAmount
total [Transaction]
trans ([Query] -> Query
And [Query
investmentsQuery, DateSpan -> Query
Date (Maybe Day -> Maybe Day -> DateSpan
DateSpan forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Day
date))])
             in
             case Either MixedAmount MixedAmount
amt of
               Right MixedAmount
amt' ->
                 -- we are buying or selling
                 let unitsBoughtOrSold :: Decimal
unitsBoughtOrSold = MixedAmount -> Decimal
unMix MixedAmount
amt' forall a. Fractional a => a -> a -> a
/ Decimal
unitPrice
                 in (Decimal
valueOnDate, Decimal
unitsBoughtOrSold, Decimal
unitPrice, Decimal
unitBalance forall a. Num a => a -> a -> a
+ Decimal
unitsBoughtOrSold)
               Left MixedAmount
pnl' ->
                 -- PnL change
                 let valueAfterDate :: Decimal
valueAfterDate = Decimal
valueOnDate forall a. Num a => a -> a -> a
+ MixedAmount -> Decimal
unMix MixedAmount
pnl'
                     unitPrice' :: Decimal
unitPrice' = Decimal
valueAfterDateforall a. Fractional a => a -> a -> a
/Decimal
unitBalance
                 in (Decimal
valueOnDate, Decimal
0, Decimal
unitPrice', Decimal
unitBalance))
          (Decimal
0, Decimal
0, Decimal
initialUnitPrice, Decimal
initialUnits)
          forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"changes" [(Day, Either MixedAmount MixedAmount)]
changes

  let finalUnitBalance :: Decimal
finalUnitBalance = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Decimal, Decimal, Decimal, Decimal)]
units then Decimal
initialUnits else let (Decimal
_,Decimal
_,Decimal
_,Decimal
u) = forall a. [a] -> a
last [(Decimal, Decimal, Decimal, Decimal)]
units in Decimal
u
      finalUnitPrice :: Decimal
finalUnitPrice = if Decimal
finalUnitBalance forall a. Eq a => a -> a -> Bool
== Decimal
0 then
                         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Decimal, Decimal, Decimal, Decimal)]
units then Decimal
initialUnitPrice
                         else let (Decimal
_,Decimal
_,Decimal
lastUnitPrice,Decimal
_) = forall a. [a] -> a
last [(Decimal, Decimal, Decimal, Decimal)]
units in Decimal
lastUnitPrice
                       else (MixedAmount -> Decimal
unMix MixedAmount
valueAfter) forall a. Fractional a => a -> a -> a
/ Decimal
finalUnitBalance
      -- Technically, totalTWR should be (100*(finalUnitPrice - initialUnitPrice) / initialUnitPrice), but initalUnitPrice is 100, so 100/100 == 1
      totalTWR :: Decimal
totalTWR = forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 forall a b. (a -> b) -> a -> b
$ (Decimal
finalUnitPrice forall a. Num a => a -> a -> a
- Decimal
initialUnitPrice)
      years :: Double
years = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Day -> Integer
diffDays Day
end Day
begin) forall a. Fractional a => a -> a -> a
/ Double
365 :: Double
      annualizedTWR :: Double
annualizedTWR = Double
100forall a. Num a => a -> a -> a
*((Double
1forall a. Num a => a -> a -> a
+(forall a b. (Real a, Fractional b) => a -> b
realToFrac Decimal
totalTWRforall a. Fractional a => a -> a -> a
/Double
100))forall a. Floating a => a -> a -> a
**(Double
1forall a. Fractional a => a -> a -> a
/Double
years)forall a. Num a => a -> a -> a
-Double
1) :: Double

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showCashFlow forall a b. (a -> b) -> a -> b
$ do
    forall r. PrintfType r => [Char] -> r
printf [Char]
"\nTWR cash flow for %s - %s\n" (Day -> Text
showDate Day
begin) (Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
end))
    let ([Day]
dates', [Either MixedAmount MixedAmount]
amts) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, Either MixedAmount MixedAmount)]
changes
        cashflows' :: [MixedAmount]
cashflows' = forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> Either a b -> b
fromRight MixedAmount
nullmixedamt) [Either MixedAmount MixedAmount]
amts
        pnls :: [MixedAmount]
pnls = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> Either a b -> a
fromLeft MixedAmount
nullmixedamt) [Either MixedAmount MixedAmount]
amts
        ([Decimal]
valuesOnDate,[Decimal]
unitsBoughtOrSold', [Decimal]
unitPrices', [Decimal]
unitBalances') = forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(Decimal, Decimal, Decimal, Decimal)]
units
        add :: a -> [a] -> [a]
add a
x [a]
lst = if Decimal
valueBeforeforall a. Eq a => a -> a -> Bool
/=Decimal
0 then a
xforall a. a -> [a] -> [a]
:[a]
lst else [a]
lst
        dates :: [Day]
dates = forall a. a -> [a] -> [a]
add Day
begin [Day]
dates'
        cashflows :: [MixedAmount]
cashflows = forall a. a -> [a] -> [a]
add MixedAmount
valueBeforeAmt [MixedAmount]
cashflows'
        unitsBoughtOrSold :: [Decimal]
unitsBoughtOrSold = forall a. a -> [a] -> [a]
add Decimal
initialUnits [Decimal]
unitsBoughtOrSold'
        unitPrices :: [Decimal]
unitPrices = forall a. a -> [a] -> [a]
add Decimal
initialUnitPrice [Decimal]
unitPrices'
        unitBalances :: [Decimal]
unitBalances = forall a. a -> [a] -> [a]
add Decimal
initialUnits [Decimal]
unitBalances'

    Text -> IO ()
TL.putStr forall a b. (a -> b) -> a -> b
$ forall rh ch a.
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
Tab.render Bool
prettyTables forall a. a -> a
id forall a. a -> a
id [Char] -> Text
T.pack
      (forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
       (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
NoLine (forall a b. (a -> b) -> [a] -> [b]
map (forall h. h -> Header h
Header forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate) [Day]
dates))
       (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
DoubleLine [ forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Tab.Header Text
"Portfolio value", forall h. h -> Header h
Tab.Header Text
"Unit balance"]
                         , forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Tab.Header Text
"Pnl", forall h. h -> Header h
Tab.Header Text
"Cashflow", forall h. h -> Header h
Tab.Header Text
"Unit price", forall h. h -> Header h
Tab.Header Text
"Units"]
                         , forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Tab.Header Text
"New Unit Balance"]])
       [ [[Char]
val, [Char]
oldBalance, [Char]
pnl', [Char]
cashflow, [Char]
prc, [Char]
udelta, [Char]
balance]
       | [Char]
val <- forall a b. (a -> b) -> [a] -> [b]
map Decimal -> [Char]
showDecimal [Decimal]
valuesOnDate
       | [Char]
oldBalance <- forall a b. (a -> b) -> [a] -> [b]
map Decimal -> [Char]
showDecimal (Decimal
0forall a. a -> [a] -> [a]
:[Decimal]
unitBalances)
       | [Char]
balance <- forall a b. (a -> b) -> [a] -> [b]
map Decimal -> [Char]
showDecimal [Decimal]
unitBalances
       | [Char]
pnl' <- forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> [Char]
showMixedAmount [MixedAmount]
pnls
       | [Char]
cashflow <- forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> [Char]
showMixedAmount [MixedAmount]
cashflows
       | [Char]
prc <- forall a b. (a -> b) -> [a] -> [b]
map Decimal -> [Char]
showDecimal [Decimal]
unitPrices
       | [Char]
udelta <- forall a b. (a -> b) -> [a] -> [b]
map Decimal -> [Char]
showDecimal [Decimal]
unitsBoughtOrSold ])

    forall r. PrintfType r => [Char] -> r
printf [Char]
"Final unit price: %s/%s units = %s\nTotal TWR: %s%%.\nPeriod: %.2f years.\nAnnualized TWR: %.2f%%\n\n"
      (MixedAmount -> [Char]
showMixedAmount MixedAmount
valueAfter) (Decimal -> [Char]
showDecimal Decimal
finalUnitBalance) (Decimal -> [Char]
showDecimal Decimal
finalUnitPrice) (Decimal -> [Char]
showDecimal Decimal
totalTWR) Double
years Double
annualizedTWR

  forall (m :: * -> *) a. Monad m => a -> m a
return Double
annualizedTWR

internalRateOfReturn :: Bool -> Bool -> OneSpan -> IO Double
internalRateOfReturn Bool
showCashFlow Bool
prettyTables (OneSpan Day
begin Day
end MixedAmount
valueBefore MixedAmount
valueAfter [(Day, MixedAmount)]
cashFlow [(Day, MixedAmount)]
_pnl) = do
  let prefix :: (Day, MixedAmount)
prefix = (Day
begin, MixedAmount -> MixedAmount
maNegate MixedAmount
valueBefore)

      postfix :: (Day, MixedAmount)
postfix = (Day
end, MixedAmount
valueAfter)

      totalCF :: [(Day, MixedAmount)]
totalCF = forall a. (a -> Bool) -> [a] -> [a]
filter (MixedAmount -> Bool
maIsNonZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ (Day, MixedAmount)
prefix forall a. a -> [a] -> [a]
: (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(Day, MixedAmount)]
cashFlow) forall a. [a] -> [a] -> [a]
++ [(Day, MixedAmount)
postfix]

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showCashFlow forall a b. (a -> b) -> a -> b
$ do
    forall r. PrintfType r => [Char] -> r
printf [Char]
"\nIRR cash flow for %s - %s\n" (Day -> Text
showDate Day
begin) (Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
end))
    let ([Day]
dates, [MixedAmount]
amts) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, MixedAmount)]
totalCF
    Text -> IO ()
TL.putStrLn forall a b. (a -> b) -> a -> b
$ forall rh ch a.
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
Tab.render Bool
prettyTables forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id
      (forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
       (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine (forall a b. (a -> b) -> [a] -> [b]
map (forall h. h -> Header h
Header forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate) [Day]
dates))
       (forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [forall h. h -> Header h
Header Text
"Amount"])
       (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Char]
showMixedAmount) [MixedAmount]
amts))

  -- 0% is always a solution, so require at least something here
  case [(Day, MixedAmount)]
totalCF of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Double
0
    [(Day, MixedAmount)]
_ -> case RiddersParam
-> (Double, Double) -> (Double -> Double) -> Root Double
ridders (Int -> Tolerance -> RiddersParam
RiddersParam Int
100 (Double -> Tolerance
AbsTol Double
0.00001))
                      (Double
0.000000000001,Double
10000)
                      (Day -> [(Day, MixedAmount)] -> Double -> Double
interestSum Day
end [(Day, MixedAmount)]
totalCF) of
        Root Double
rate    -> forall (m :: * -> *) a. Monad m => a -> m a
return ((Double
rateforall a. Num a => a -> a -> a
-Double
1)forall a. Num a => a -> a -> a
*Double
100)
        Root Double
NotBracketed -> forall a. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ [Char]
"Error (NotBracketed): No solution for Internal Rate of Return (IRR).\n"
                        forall a. [a] -> [a] -> [a]
++       [Char]
"  Possible causes: IRR is huge (>1000000%), balance of investment becomes negative at some point in time."
        Root Double
SearchFailed -> forall a. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ [Char]
"Error (SearchFailed): Failed to find solution for Internal Rate of Return (IRR).\n"
                        forall a. [a] -> [a] -> [a]
++       [Char]
"  Either search does not converge to a solution, or converges too slowly."

type CashFlow = [(Day, MixedAmount)]

interestSum :: Day -> CashFlow -> Double -> Double
interestSum :: Day -> [(Day, MixedAmount)] -> Double -> Double
interestSum Day
referenceDay [(Day, MixedAmount)]
cf Double
rate = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Day, MixedAmount) -> Double
go [(Day, MixedAmount)]
cf
  where go :: (Day, MixedAmount) -> Double
go (Day
t,MixedAmount
m) = forall a b. (Real a, Fractional b) => a -> b
realToFrac (MixedAmount -> Decimal
unMix MixedAmount
m) forall a. Num a => a -> a -> a
* Double
rate forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day
referenceDay Day -> Day -> Integer
`diffDays` Day
t) forall a. Fractional a => a -> a -> a
/ Double
365)


calculateCashFlow :: WhichDate -> [Transaction] -> Query -> CashFlow
calculateCashFlow :: WhichDate -> [Transaction] -> Query -> [(Day, MixedAmount)]
calculateCashFlow WhichDate
wd [Transaction]
trans Query
query =
  [ (WhichDate -> Posting -> Day
postingDateOrDate2 WhichDate
wd Posting
p, Posting -> MixedAmount
pamount Posting
p) | Posting
p <- forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
realPostings [Transaction]
trans), MixedAmount -> Bool
maIsNonZero (Posting -> MixedAmount
pamount Posting
p) ]

total :: [Transaction] -> Query -> MixedAmount
total :: [Transaction] -> Query -> MixedAmount
total [Transaction]
trans Query
query = [Posting] -> MixedAmount
sumPostings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
realPostings [Transaction]
trans

unMix :: MixedAmount -> Quantity
unMix :: MixedAmount -> Decimal
unMix MixedAmount
a =
  case (MixedAmount -> Maybe Amount
unifyMixedAmount forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
a) of
    Just Amount
a' -> Amount -> Decimal
aquantity Amount
a'
    Maybe Amount
Nothing -> forall a. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ [Char]
"Amounts could not be converted to a single cost basis: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. (a -> b) -> [a] -> [b]
map Amount -> [Char]
showAmount forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts MixedAmount
a) forall a. [a] -> [a] -> [a]
++
               [Char]
"\nConsider using --value to force all costs to be in a single commodity." forall a. [a] -> [a] -> [a]
++
               [Char]
"\nFor example, \"--cost --value=end,<commodity> --infer-market-prices\", where commodity is the one that was used to pay for the investment."

-- Show Decimal rounded to two decimal places, unless it has less places already. This ensures that "2" won't be shown as "2.00"
showDecimal :: Decimal -> String
showDecimal :: Decimal -> [Char]
showDecimal Decimal
d = if Decimal
d forall a. Eq a => a -> a -> Bool
== Decimal
rounded then forall a. Show a => a -> [Char]
show Decimal
d else forall a. Show a => a -> [Char]
show Decimal
rounded
  where
    rounded :: Decimal
rounded = forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Decimal
d