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

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 Data.Time.Calendar
import Text.Printf
import Data.Bifunctor (second)
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 Safe (headDef)
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")
  [[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
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"
  ,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"investment"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
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"
  ,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"profit-loss",[Char]
"pnl"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
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])]
cligeneralflagsgroups1
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
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 -> [Char] -> [Char]
[OneSpan] -> [Char] -> [Char]
OneSpan -> [Char]
(Int -> OneSpan -> [Char] -> [Char])
-> (OneSpan -> [Char])
-> ([OneSpan] -> [Char] -> [Char])
-> Show OneSpan
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> OneSpan -> [Char] -> [Char]
showsPrec :: Int -> OneSpan -> [Char] -> [Char]
$cshow :: OneSpan -> [Char]
show :: OneSpan -> [Char]
$cshowList :: [OneSpan] -> [Char] -> [Char]
showList :: [OneSpan] -> [Char] -> [Char]
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]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
layout_ :: ReportOpts -> Layout
transpose_ :: ReportOpts -> Bool
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
balancecalc_ :: ReportOpts -> BalanceCalculation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
pretty_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
..}}} Journal
j = do
  -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
  let
    -- lbl = lbl_ "roi"
    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 = Rounding -> Journal -> Map Text AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
    mixedAmountValue :: Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
periodlast Day
date =
        -- These calculations can generate very precise decimals. To avoid showing too many digits:
        -- If we have no style for the valuation commodity, generate one that will limit the precision ?
        -- But it's not easy to find out the valuation commodity (or commodities) here if it's implicit,
        -- as that information is buried in the price graph.
        -- Instead, do what we don't like to do: hard code a max precision, overriding commodity styles.
        Word8 -> MixedAmount -> MixedAmount
mixedAmountSetPrecisionMax Word8
defaultMaxPrecision
      (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> MixedAmount)
-> (ValuationType -> MixedAmount -> MixedAmount)
-> Maybe ValuationType
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
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_
      (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> MixedAmount)
-> (ConversionOp -> MixedAmount -> MixedAmount)
-> Maybe ConversionOp
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
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 <- ([Char] -> m Query)
-> ((Query, [QueryOpt]) -> m Query)
-> Either [Char] (Query, [QueryOpt])
-> m Query
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> m Query
forall a. [Char] -> a
usageError (Query -> m Query
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> m Query)
-> ((Query, [QueryOpt]) -> Query) -> (Query, [QueryOpt]) -> m Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst) (Either [Char] (Query, [QueryOpt]) -> m Query)
-> ([Char] -> Either [Char] (Query, [QueryOpt]))
-> [Char]
-> m Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQuery Day
today (Text -> Either [Char] (Query, [QueryOpt]))
-> ([Char] -> Text) -> [Char] -> Either [Char] (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> m Query) -> [Char] -> m Query
forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> [Char]
stringopt [Char]
flag RawOpts
rawopts
        Query -> m Query
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> m Query) -> (Query -> Query) -> Query -> m Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Query
simplifyQuery (Query -> m Query) -> Query -> m Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags ReportOpts
ropts{period_=PeriodAll}, Query
q]

  Query
investmentsQuery <- [Char] -> IO Query
forall {m :: * -> *}. Monad m => [Char] -> m Query
makeQuery [Char]
"investment"
  Query
pnlQuery         <- [Char] -> IO Query
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 = [Char] -> [Transaction] -> [Transaction]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"investments" ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
filteredj

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

  let (DateSpan
fullPeriod, [DateSpan]
spans) = Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan Journal
filteredj ReportSpec
rspec

  let processSpan :: DateSpan -> IO [Text]
processSpan (DateSpan Maybe EFDay
Nothing Maybe EFDay
_) = [Char] -> IO [Text]
forall a. [Char] -> a
error' [Char]
"Undefined start of the period - will be unable to compute the rates of return"
      processSpan (DateSpan Maybe EFDay
_ Maybe EFDay
Nothing) = [Char] -> IO [Text]
forall a. [Char] -> a
error' [Char]
"Undefined end of the period - will be unable to compute the rates of return"
      processSpan spn :: DateSpan
spn@(DateSpan (Just EFDay
begin) (Just EFDay
end)) = do
        -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
        let
          b :: Day
b = EFDay -> Day
fromEFDay EFDay
begin
          e :: Day
e = EFDay -> Day
fromEFDay EFDay
end
          cashFlowApplyCostValue :: [(Day, MixedAmount)] -> [(Day, MixedAmount)]
cashFlowApplyCostValue = ((Day, MixedAmount) -> (Day, MixedAmount))
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Day
d,MixedAmount
amt) -> (Day
d,Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
e Day
d MixedAmount
amt))

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

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

          cashFlow :: [(Day, MixedAmount)]
cashFlow = [Char] -> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"cashFlow" ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$
            [(Day, MixedAmount)] -> [(Day, MixedAmount)]
cashFlowApplyCostValue ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
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 ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
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 = [Char] -> OneSpan -> OneSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"processing span" (OneSpan -> OneSpan) -> OneSpan -> OneSpan
forall a b. (a -> b) -> a -> b
$
                     Day
-> Day
-> MixedAmount
-> MixedAmount
-> [(Day, MixedAmount)]
-> [(Day, MixedAmount)]
-> OneSpan
OneSpan Day
b Day
e MixedAmount
valueBefore MixedAmount
valueAfter [(Day, MixedAmount)]
cashFlow [(Day, MixedAmount)]
pnl

        Double
irr <- Map Text AmountStyle -> Bool -> Bool -> OneSpan -> IO Double
internalRateOfReturn Map Text AmountStyle
styles Bool
showCashFlow Bool
prettyTables OneSpan
thisSpan
        (Double
periodTwr, Double
annualizedTwr) <- Map Text AmountStyle
-> Bool
-> Bool
-> Query
-> [Transaction]
-> (Day -> Day -> MixedAmount -> MixedAmount)
-> OneSpan
-> IO (Double, Double)
forall {t :: * -> *} {p}.
Foldable t =>
p
-> Bool
-> Bool
-> Query
-> t Transaction
-> (Day -> Day -> MixedAmount -> MixedAmount)
-> OneSpan
-> IO (Double, Double)
timeWeightedReturn Map Text AmountStyle
styles Bool
showCashFlow Bool
prettyTables Query
investmentsQuery [Transaction]
trans Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue OneSpan
thisSpan
        let cashFlowAmt :: MixedAmount
cashFlowAmt = MixedAmount -> MixedAmount
maNegate (MixedAmount -> MixedAmount)
-> ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> MixedAmount)
-> [(Day, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (Day, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd [(Day, MixedAmount)]
cashFlow
        let smallIsZero :: a -> a
smallIsZero a
x = if a -> a
forall a. Num a => a -> a
abs a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.01 then a
0.0 else a
x
        [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Day -> Text
showDate Day
b
               , Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
e)
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
False (MixedAmount -> [Char]) -> MixedAmount -> [Char]
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
valueBefore
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
False (MixedAmount -> [Char]) -> MixedAmount -> [Char]
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
cashFlowAmt
               -- , T.pack $ showMixedAmount $
               --   -- dbg0With (lbl "cashflow after styling".showMixedAmountOneLine) $
               --   mapMixedAmount (amountSetFullPrecisionUpTo (Just defaultMaxPrecision)) $
               --   styleAmounts (styles
               --                 -- & dbg0With (lbl "styles".show))
               --   cashFlowAmt
               --   -- & dbg0With (lbl "cashflow before styling".showMixedAmountOneLine)
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
False (MixedAmount -> [Char]) -> MixedAmount -> [Char]
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
valueAfter
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
False (MixedAmount -> [Char]) -> MixedAmount -> [Char]
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (MixedAmount
valueAfter MixedAmount -> MixedAmount -> MixedAmount
`maMinus` (MixedAmount
valueBefore MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
cashFlowAmt))
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.2f%%" (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
smallIsZero Double
irr
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.2f%%" (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
smallIsZero Double
periodTwr
               , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.2f%%" (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
smallIsZero Double
annualizedTwr ]

  [[Text]]
periodRows <- [DateSpan] -> (DateSpan -> IO [Text]) -> IO [[Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DateSpan]
spans DateSpan -> IO [Text]
processSpan
  [Text]
totalRow <- case [[Text]]
periodRows of
    [[Text]
singleRow] -> [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
singleRow
    [[Text]]
_           -> DateSpan -> IO [Text]
processSpan DateSpan
fullPeriod

  let rowTitles :: Header Text
rowTitles = Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine ((Integer -> Header Text) -> [Integer] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Header Text
forall h. h -> Header h
Header (Text -> Header Text)
-> (Integer -> Text) -> Integer -> Header Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show) (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take ([[Text]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
periodRows) [Integer
1..]))

  let isSingleSpan :: Bool
isSingleSpan = [DateSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DateSpan]
spans Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

  let table :: Table Text Text Text
table = Header Text -> Header Text -> [[Text]] -> Table Text Text Text
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
              (if Bool
isSingleSpan
                then Header Text
rowTitles
                else Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine  [ Header Text
rowTitles, Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine [ Text -> Header Text
forall h. h -> Header h
Header Text
"Total" ]]
              )
              (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.DoubleLine
               [ Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Header Text
"Begin", Text -> Header Text
forall h. h -> Header h
Header Text
"End"]
               , Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Header Text
"Value (begin)", Text -> Header Text
forall h. h -> Header h
Header Text
"Cashflow", Text -> Header Text
forall h. h -> Header h
Header Text
"Value (end)", Text -> Header Text
forall h. h -> Header h
Header Text
"PnL"]
               , Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Header Text
"IRR"]
               , Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Header Text
"TWR/period", Text -> Header Text
forall h. h -> Header h
Header Text
"TWR/year"]])
              (if Bool
isSingleSpan then [[Text]]
periodRows else [[Text]]
periodRows [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++ [[Text]
totalRow])

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

-- Entry for TWR computation, capturing all cashflows that are potentially accompanied by pnl change on the same day (if not, it is zero)
data TwrPeriod = TwrPeriod { TwrPeriod -> Day
twrStartDate :: Day, TwrPeriod -> Day
twrEndDate :: Day, TwrPeriod -> Decimal
twrStartValue :: Decimal, TwrPeriod -> Decimal
twrValueBeforeCashflow :: Decimal, TwrPeriod -> Decimal
twrPnl :: Decimal, TwrPeriod -> Decimal
twrCashflow :: Decimal, TwrPeriod -> Decimal
twrValueAfterCashflow :: Decimal } deriving (TwrPeriod -> TwrPeriod -> Bool
(TwrPeriod -> TwrPeriod -> Bool)
-> (TwrPeriod -> TwrPeriod -> Bool) -> Eq TwrPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TwrPeriod -> TwrPeriod -> Bool
== :: TwrPeriod -> TwrPeriod -> Bool
$c/= :: TwrPeriod -> TwrPeriod -> Bool
/= :: TwrPeriod -> TwrPeriod -> Bool
Eq, Int -> TwrPeriod -> [Char] -> [Char]
[TwrPeriod] -> [Char] -> [Char]
TwrPeriod -> [Char]
(Int -> TwrPeriod -> [Char] -> [Char])
-> (TwrPeriod -> [Char])
-> ([TwrPeriod] -> [Char] -> [Char])
-> Show TwrPeriod
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> TwrPeriod -> [Char] -> [Char]
showsPrec :: Int -> TwrPeriod -> [Char] -> [Char]
$cshow :: TwrPeriod -> [Char]
show :: TwrPeriod -> [Char]
$cshowList :: [TwrPeriod] -> [Char] -> [Char]
showList :: [TwrPeriod] -> [Char] -> [Char]
Show)

timeWeightedReturn :: p
-> Bool
-> Bool
-> Query
-> t Transaction
-> (Day -> Day -> MixedAmount -> MixedAmount)
-> OneSpan
-> IO (Double, Double)
timeWeightedReturn p
_styles Bool
showCashFlow Bool
prettyTables Query
investmentsQuery t Transaction
trans Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue (OneSpan Day
begin Day
end MixedAmount
valueBeforeAmt MixedAmount
valueAfterAmt [(Day, MixedAmount)]
cashflows [(Day, MixedAmount)]
pnls) = do
  let datedCashflows :: [(Day, MixedAmount)]
datedCashflows =
        -- Aggregate all entries for a single day, assuming that intraday interest is negligible
        [Char] -> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"datedCashflows"
        ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. Ord a => [a] -> [a]
sort
        ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ([(Day, MixedAmount)] -> (Day, MixedAmount))
-> [[(Day, MixedAmount)]] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Day, MixedAmount)]
datecashes -> let ([Day]
dates, [MixedAmount]
cash) = [(Day, MixedAmount)] -> ([Day], [MixedAmount])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, MixedAmount)]
datecashes in (Day -> [Day] -> Day
forall a. a -> [a] -> a
headDef ([Char] -> Day
forall a. [Char] -> a
error' [Char]
"Roi.hs: datecashes was null, please report a bug") [Day]
dates, [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
cash))
        ([[(Day, MixedAmount)]] -> [(Day, MixedAmount)])
-> [[(Day, MixedAmount)]] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> (Day, MixedAmount) -> Bool)
-> [(Day, MixedAmount)] -> [[(Day, MixedAmount)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Day -> Day -> Bool)
-> ((Day, MixedAmount) -> Day)
-> (Day, MixedAmount)
-> (Day, MixedAmount)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Day, MixedAmount) -> Day
forall a b. (a, b) -> a
fst)
        ([(Day, MixedAmount)] -> [[(Day, MixedAmount)]])
-> [(Day, MixedAmount)] -> [[(Day, MixedAmount)]]
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> Day)
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Day, MixedAmount) -> Day
forall a b. (a, b) -> a
fst
        ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> (Day, MixedAmount))
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map ((MixedAmount -> MixedAmount)
-> (Day, MixedAmount) -> (Day, MixedAmount)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second MixedAmount -> MixedAmount
maNegate)
        ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(Day, MixedAmount)]
cashflows

      valueBefore :: Decimal
valueBefore = [Char] -> Decimal -> Decimal
forall a. Show a => [Char] -> a -> a
dbg3 ([Char]
"value at the start of the interval, "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
begin) (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Decimal
unMix MixedAmount
valueBeforeAmt
      valueAfter :: Decimal
valueAfter = [Char] -> Decimal -> Decimal
forall a. Show a => [Char] -> a -> a
dbg3 ([Char]
"value at the end of the interval, "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
end) (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Decimal
unMix MixedAmount
valueAfterAmt
      
      investmentPostings :: [Posting]
investmentPostings = (Transaction -> [Posting]) -> t Transaction -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
investmentsQuery) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
realPostings) t Transaction
trans

      totalInvestmentPostingsTill :: Day -> MixedAmount
totalInvestmentPostingsTill Day
date = [Posting] -> MixedAmount
sumPostings ([Posting] -> MixedAmount) -> [Posting] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting (DateSpan -> Query
Date (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
forall a. Maybe a
Nothing (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact Day
date)))) [Posting]
investmentPostings

      -- filter span is (-infinity, date+1), which gives us effectively (-infinity, date]
      valueAfterDate :: Day -> Decimal
valueAfterDate Day
date = MixedAmount -> Decimal
unMix (MixedAmount -> Decimal) -> MixedAmount -> Decimal
forall a b. (a -> b) -> a -> b
$ Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
end Day
date (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Day -> MixedAmount
totalInvestmentPostingsTill (Integer -> Day -> Day
addDays Integer
1 Day
date)

      pnlOn :: Day -> Decimal
pnlOn Day
date = MixedAmount -> Decimal
unMix (MixedAmount -> Decimal) -> MixedAmount -> Decimal
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
maNegate (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> MixedAmount)
-> [(Day, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (Day, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd ([(Day, MixedAmount)] -> [MixedAmount])
-> [(Day, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> Bool)
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
==Day
date)(Day -> Bool)
-> ((Day, MixedAmount) -> Day) -> (Day, MixedAmount) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Day, MixedAmount) -> Day
forall a b. (a, b) -> a
fst) [(Day, MixedAmount)]
pnls

  -- We are dividing the period [begin, end) into subperiods on each cashflow, and then compute
  -- the rate of return for each subperiod. For this we need to know the value of the investment
  -- at the beginning and end of each subperiod, adjusted for cashflow.
  -- 
  -- Subperiods are going to be [valueBefore ... (c_0,v_0)][... (c_1, v_1)][... (c_2,v_2)] ... [... (c_n,v_n)][... valueAfter]
  -- , where v_i is the value of investment computed immediately after cashflow c_i
  --
  -- Calculate interest for each subperiod, adjusting the value at the start of the period by the cashflow
  -- For subperiods [valueBefore ... (c_0,v_0)][... (c_1, v_1)][... (c_2,v_2)] ... [... (c_n,v_n)][... valueAfter], the computation is going to be
  -- 1 + twr = (v_0 - c_0)/valueBefore + (v_1 - c_1) / v_0 +  ... + valueAfter/v_n
  -- See https://en.wikipedia.org/wiki/Time-weighted_return#Time-weighted_return_compensating_for_external_flows
  let calculateSubPeriods :: (Day, Decimal) -> [(Day, MixedAmount)] -> [(Decimal, TwrPeriod)]
calculateSubPeriods (Day
startDate,Decimal
startValue) [] =
        let subPeriodReturn :: Decimal
subPeriodReturn =
              if Decimal
startValue Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0 Bool -> Bool -> Bool
|| Decimal
valueAfter Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0
              then Decimal
0
              else Decimal
valueAfterDecimal -> Decimal -> Decimal
forall a. Fractional a => a -> a -> a
/Decimal
startValue Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
- Decimal
1
        in
        [(Decimal
subPeriodReturn, Day
-> Day
-> Decimal
-> Decimal
-> Decimal
-> Decimal
-> Decimal
-> TwrPeriod
TwrPeriod Day
startDate Day
end Decimal
startValue Decimal
valueAfter Decimal
0 Decimal
0 Decimal
valueAfter)]
      calculateSubPeriods (Day
startDate,Decimal
startValue) ((Day
date,MixedAmount
cashflow):[(Day, MixedAmount)]
rest) =
        let (Decimal
valueBeforeCashflow, Decimal
valueAfterCashflow, Decimal
pnl) =
              let valueAfterPrevDay :: Decimal
valueAfterPrevDay = Day -> Decimal
valueAfterDate (Integer -> Day -> Day
addDays (-Integer
1) Day
date)
                  pnlOnDay :: Decimal
pnlOnDay = Day -> Decimal
pnlOn Day
date
              in
                -- If value was zero at the start of the period, then any PnL on cashflow date would accrue after it, not before.
                -- If there was some value already, we can assume that PnL contributes to this period's rate
                if Decimal
startValue Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0
                then (Decimal
valueAfterPrevDay, Day -> Decimal
valueAfterDate Day
date Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
- Decimal
pnlOnDay, Decimal
0)
                else (Decimal
valueAfterPrevDay Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+ Decimal
pnl, Day -> Decimal
valueAfterDate Day
date, Decimal
pnlOnDay)
            subPeriodReturn :: Decimal
subPeriodReturn =
              if Decimal
valueBeforeCashflow Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0 Bool -> Bool -> Bool
|| Decimal
startValue Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0
              then Decimal
0
              else (Decimal
valueBeforeCashflow Decimal -> Decimal -> Decimal
forall a. Fractional a => a -> a -> a
/ Decimal
startValue) Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
- Decimal
1
        in
        (Decimal
subPeriodReturn, (Day
-> Day
-> Decimal
-> Decimal
-> Decimal
-> Decimal
-> Decimal
-> TwrPeriod
TwrPeriod Day
startDate Day
date Decimal
startValue Decimal
valueBeforeCashflow Decimal
pnl (MixedAmount -> Decimal
unMix MixedAmount
cashflow) Decimal
valueAfterCashflow)) (Decimal, TwrPeriod)
-> [(Decimal, TwrPeriod)] -> [(Decimal, TwrPeriod)]
forall a. a -> [a] -> [a]
: (Day, Decimal) -> [(Day, MixedAmount)] -> [(Decimal, TwrPeriod)]
calculateSubPeriods (Day
date,Decimal
valueAfterCashflow) [(Day, MixedAmount)]
rest

  let subPeriods :: [(Decimal, TwrPeriod)]
subPeriods = [Char] -> [(Decimal, TwrPeriod)] -> [(Decimal, TwrPeriod)]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"subPeriods" ([(Decimal, TwrPeriod)] -> [(Decimal, TwrPeriod)])
-> [(Decimal, TwrPeriod)] -> [(Decimal, TwrPeriod)]
forall a b. (a -> b) -> a -> b
$ (Day, Decimal) -> [(Day, MixedAmount)] -> [(Decimal, TwrPeriod)]
calculateSubPeriods (Day
begin,Decimal
valueBefore) [(Day, MixedAmount)]
datedCashflows

  -- Compute overall time-weighted rate of return
  let twr :: Decimal
twr =
        [Char] -> Decimal -> Decimal
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"twr" (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$
        if [(Decimal, TwrPeriod)]
subPeriods [(Decimal, TwrPeriod)] -> [(Decimal, TwrPeriod)] -> Bool
forall a. Eq a => a -> a -> Bool
== []
        then if Decimal
valueBefore Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
0 then Decimal
0 else (Decimal
valueAfter Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
- Decimal
valueBefore)Decimal -> Decimal -> Decimal
forall a. Fractional a => a -> a -> a
/Decimal
valueBefore
        else (Decimal -> Decimal -> Decimal) -> Decimal -> [Decimal] -> Decimal
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Decimal
acc Decimal
periodRate -> (Decimal
1Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+Decimal
acc)Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
*(Decimal
1Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+Decimal
periodRate)Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
-Decimal
1) Decimal
0 (((Decimal, TwrPeriod) -> Decimal)
-> [(Decimal, TwrPeriod)] -> [Decimal]
forall a b. (a -> b) -> [a] -> [b]
map (Decimal, TwrPeriod) -> Decimal
forall a b. (a, b) -> a
fst [(Decimal, TwrPeriod)]
subPeriods)
      (Integer
startYear, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
begin
      years :: Double
years = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Day -> Integer
diffDays Day
end Day
begin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (if Integer -> Bool
isLeapYear Integer
startYear then Double
366 else Double
365) :: Double
      periodTWR :: Decimal
periodTWR = Word8 -> Decimal -> Decimal
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$ Decimal
100 Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
* Decimal
twr
      annualizedTWR :: Double
annualizedTWR = Double
100Double -> Double -> Double
forall a. Num a => a -> a -> a
*((Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
+(Decimal -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Decimal
twr))Double -> Double -> Double
forall a. Floating a => a -> a -> a
**(Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
years)Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) :: Double

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showCashFlow (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Text -> Text -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"\nTWR cash flow entries and subperiod rates for period %s - %s\n" (Day -> Text
showDate Day
begin) (Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
end))
    let showDecimalT :: Decimal -> Text
showDecimalT = [Char] -> Text
T.pack ([Char] -> Text) -> (Decimal -> [Char]) -> Decimal -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> [Char]
showDecimal
    Text -> IO ()
TL.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> ([Char] -> Text)
-> (Text -> Text)
-> (Text -> Text)
-> Table [Char] Text Text
-> Text
forall a rh ch.
Show a =>
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
Tab.render Bool
prettyTables [Char] -> Text
T.pack Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id
      (Header [Char] -> Header Text -> [[Text]] -> Table [Char] Text Text
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
       (Properties -> [Header [Char]] -> Header [Char]
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine [ [Char] -> Header [Char]
forall h. h -> Header h
Header (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) | Int
n <-[Int
1..[(Decimal, TwrPeriod)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Decimal, TwrPeriod)]
subPeriods]])
       (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
DoubleLine [ Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Subperiod start", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Cashflow date"]
                             , Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Value at start", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Value before cashflow (inc PnL)", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"PnL on day", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Cashflow",  Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Value after cashflow"]
                             , Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Subperiod rate, %"]])
       [ [ Day -> Text
showDate (TwrPeriod -> Day
twrStartDate TwrPeriod
sp), Day -> Text
showDate (TwrPeriod -> Day
twrEndDate TwrPeriod
sp)
         , Decimal -> Text
showDecimalT (TwrPeriod -> Decimal
twrStartValue TwrPeriod
sp), Decimal -> Text
showDecimalT (TwrPeriod -> Decimal
twrValueBeforeCashflow TwrPeriod
sp), Decimal -> Text
showDecimalT (TwrPeriod -> Decimal
twrPnl TwrPeriod
sp), Decimal -> Text
showDecimalT (TwrPeriod -> Decimal
twrCashflow TwrPeriod
sp), Decimal -> Text
showDecimalT (TwrPeriod -> Decimal
twrValueAfterCashflow TwrPeriod
sp)
         , Decimal -> Text
showDecimalT (Word8 -> Decimal -> Decimal
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 (Decimal
100Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
*Decimal
rate)) ]
       | (Decimal
rate, TwrPeriod
sp) <-  [(Decimal, TwrPeriod)]
subPeriods
       ])

    [Char] -> [Char] -> Double -> Double -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"Total period TWR: %s%%.\nPeriod: %.2f years.\nAnnualized TWR: %.2f%%\n\n"
      (Decimal -> [Char]
showDecimal Decimal
periodTWR) Double
years Double
annualizedTWR

  (Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Decimal -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Decimal
periodTWR) :: Double, Double
annualizedTWR)

internalRateOfReturn :: Map Text AmountStyle -> Bool -> Bool -> OneSpan -> IO Double
internalRateOfReturn Map Text AmountStyle
styles 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 = ((Day, MixedAmount) -> Bool)
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter (MixedAmount -> Bool
maIsNonZero (MixedAmount -> Bool)
-> ((Day, MixedAmount) -> MixedAmount)
-> (Day, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd) ([(Day, MixedAmount)] -> [(Day, MixedAmount)])
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ (Day, MixedAmount)
prefix (Day, MixedAmount) -> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. a -> [a] -> [a]
: (((Day, MixedAmount) -> Day)
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Day, MixedAmount) -> Day
forall a b. (a, b) -> a
fst [(Day, MixedAmount)]
cashFlow) [(Day, MixedAmount)]
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. [a] -> [a] -> [a]
++ [(Day, MixedAmount)
postfix]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showCashFlow (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Text -> Text -> IO ()
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) = [(Day, MixedAmount)] -> ([Day], [MixedAmount])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, MixedAmount)]
totalCF
    Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (Text -> Text)
-> (Text -> Text)
-> (Text -> Text)
-> Table Text Text Text
-> Text
forall a rh ch.
Show a =>
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
Tab.render Bool
prettyTables Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id
      (Header Text -> Header Text -> [[Text]] -> Table Text Text Text
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
       (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.NoLine ((Day -> Header Text) -> [Day] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Header Text
forall h. h -> Header h
Header (Text -> Header Text) -> (Day -> Text) -> Day -> Header Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate) [Day]
dates))
       (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Tab.Group Properties
Tab.SingleLine [Text -> Header Text
forall h. h -> Header h
Header Text
"Amount"])
       ((MixedAmount -> [Text]) -> [MixedAmount] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> (MixedAmount -> Text) -> MixedAmount -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (MixedAmount -> [Char]) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> MixedAmount -> [Char]
showMixedAmountOneLineWithoutCost Bool
False (MixedAmount -> [Char])
-> (MixedAmount -> MixedAmount) -> MixedAmount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles) [MixedAmount]
amts))

  -- 0% is always a solution, so require at least something here
  case [(Day, MixedAmount)]
totalCF of
    [] -> Double -> IO Double
forall a. a -> IO a
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    -> Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Double
rateDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
100)
        Root Double
NotBracketed -> [Char] -> IO Double
forall a. [Char] -> a
error' ([Char] -> IO Double) -> [Char] -> IO Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Error (NotBracketed): No solution for Internal Rate of Return (IRR).\n"
                        [Char] -> [Char] -> [Char]
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 -> [Char] -> IO Double
forall a. [Char] -> a
error' ([Char] -> IO Double) -> [Char] -> IO Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Error (SearchFailed): Failed to find solution for Internal Rate of Return (IRR).\n"
                        [Char] -> [Char] -> [Char]
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 = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((Day, MixedAmount) -> Double) -> [(Day, MixedAmount)] -> [Double]
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) = Decimal -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (MixedAmount -> Decimal
unMix MixedAmount
m) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rate Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day
referenceDay Day -> Day -> Integer
`diffDays` Day
t) Double -> Double -> Double
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 <- (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ((Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
realPostings) [Transaction]
trans)

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

-- 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 Decimal -> Decimal -> Bool
forall a. Eq a => a -> a -> Bool
== Decimal
rounded then Decimal -> [Char]
forall a. Show a => a -> [Char]
show Decimal
d else Decimal -> [Char]
forall a. Show a => a -> [Char]
show Decimal
rounded
  where
    rounded :: Decimal
rounded = Word8 -> Decimal -> Decimal
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Decimal
d