{-# 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 = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Roi.txt")
  [[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"cashflow"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"cashflow") CommandDoc
"show all amounts that were used to compute returns"
  ,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"investment"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"investment" CommandDoc
s RawOpts
opts) CommandDoc
"QUERY"
    CommandDoc
"query to select your investment transactions"
  ,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"profit-loss",CommandDoc
"pnl"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"pnl" CommandDoc
s RawOpts
opts) CommandDoc
"QUERY"
    CommandDoc
"query to select profit-and-loss or appreciation/valuation transactions"
  ]
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [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
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[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 -> CommandDoc -> CommandDoc
[OneSpan] -> CommandDoc -> CommandDoc
OneSpan -> CommandDoc
(Int -> OneSpan -> CommandDoc -> CommandDoc)
-> (OneSpan -> CommandDoc)
-> ([OneSpan] -> CommandDoc -> CommandDoc)
-> Show OneSpan
forall a.
(Int -> a -> CommandDoc -> CommandDoc)
-> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
showList :: [OneSpan] -> CommandDoc -> CommandDoc
$cshowList :: [OneSpan] -> CommandDoc -> CommandDoc
show :: OneSpan -> CommandDoc
$cshow :: OneSpan -> CommandDoc
showsPrec :: Int -> OneSpan -> CommandDoc -> CommandDoc
$cshowsPrec :: Int -> OneSpan -> CommandDoc -> CommandDoc
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 ValuationType
Maybe NormalSign
BalanceCalculation
BalanceAccumulation
AccountListMode
CommodityLayout
Costing
StringFormat
Period
Interval
period_ :: ReportOpts -> Period
interval_ :: ReportOpts -> Interval
statuses_ :: ReportOpts -> [Status]
cost_ :: ReportOpts -> Costing
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
commodity_layout_ :: ReportOpts -> CommodityLayout
commodity_layout_ :: CommodityLayout
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
cost_ :: Costing
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 =
        (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
. Costing -> Map Text AmountStyle -> MixedAmount -> MixedAmount
mixedAmountToCost Costing
cost_ Map Text AmountStyle
styles

  let
    ropts :: ReportOpts
ropts = ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
    wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts
    showCashFlow :: Bool
showCashFlow = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"cashflow" RawOpts
rawopts
    prettyTables :: Bool
prettyTables = Bool
pretty_
    makeQuery :: CommandDoc -> m Query
makeQuery CommandDoc
flag = do
        Query
q <- (CommandDoc -> m Query)
-> ((Query, [QueryOpt]) -> m Query)
-> Either CommandDoc (Query, [QueryOpt])
-> m Query
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> m Query
forall a. CommandDoc -> a
usageError (Query -> m Query
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 CommandDoc (Query, [QueryOpt]) -> m Query)
-> (CommandDoc -> Either CommandDoc (Query, [QueryOpt]))
-> CommandDoc
-> m Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either CommandDoc (Query, [QueryOpt])
parseQuery Day
today (Text -> Either CommandDoc (Query, [QueryOpt]))
-> (CommandDoc -> Text)
-> CommandDoc
-> Either CommandDoc (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Text
T.pack (CommandDoc -> m Query) -> CommandDoc -> m Query
forall a b. (a -> b) -> a -> b
$ CommandDoc -> RawOpts -> CommandDoc
stringopt CommandDoc
flag RawOpts
rawopts
        Query -> m Query
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_ :: Period
period_=Period
PeriodAll}, Query
q]

  Query
investmentsQuery <- CommandDoc -> IO Query
forall (m :: * -> *). Monad m => CommandDoc -> m Query
makeQuery CommandDoc
"investment"
  Query
pnlQuery         <- CommandDoc -> IO Query
forall (m :: * -> *). Monad m => CommandDoc -> m Query
makeQuery CommandDoc
"pnl"

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

    journalSpan :: DateSpan
journalSpan =
        let dates :: [Day]
dates = (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (WhichDate -> Transaction -> Day
transactionDateOrDate2 WhichDate
wd) [Transaction]
trans in
        Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Day]
dates) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Day]
dates)

    requestedSpan :: DateSpan
requestedSpan = Period -> DateSpan
periodAsDateSpan Period
period_
    requestedInterval :: Interval
requestedInterval = Interval
interval_

    wholeSpan :: DateSpan
wholeSpan = CommandDoc -> DateSpan -> DateSpan
forall a. Show a => CommandDoc -> a -> a
dbg3 CommandDoc
"wholeSpan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan -> DateSpan -> DateSpan
spanDefaultsFrom DateSpan
requestedSpan DateSpan
journalSpan

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

  let spans :: [DateSpan]
spans = case Interval
requestedInterval of
        Interval
NoInterval -> [DateSpan
wholeSpan]
        Interval
interval ->
            Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval DateSpan
wholeSpan

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

  [[Text]]
tableBody <- [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]) -> IO [[Text]])
-> (DateSpan -> IO [Text]) -> IO [[Text]]
forall a b. (a -> b) -> a -> b
$ \span :: DateSpan
span@(DateSpan (Just Day
spanBegin) (Just Day
spanEnd)) -> do
    -- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in
    let
      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
spanEnd Day
d MixedAmount
amt))

      valueBefore :: MixedAmount
valueBefore =
        Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
spanEnd Day
spanBegin (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 Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
spanBegin))])

      valueAfter :: MixedAmount
valueAfter  =
        Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
spanEnd Day
spanEnd (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 Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
spanEnd))])

      priceDates :: [Day]
priceDates = CommandDoc -> [Day] -> [Day]
forall a. Show a => CommandDoc -> a -> a
dbg3 CommandDoc
"priceDates" ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ [Day] -> [Day]
forall a. Eq a => [a] -> [a]
nub ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
span) [Day]
priceDirectiveDates
      cashFlow :: [(Day, MixedAmount)]
cashFlow =
        (((Day -> (Day, MixedAmount)) -> [Day] -> [(Day, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (,MixedAmount
nullmixedamt) [Day]
priceDates)[(Day, MixedAmount)]
-> [(Day, MixedAmount)] -> [(Day, MixedAmount)]
forall a. [a] -> [a] -> [a]
++) ([(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
span ] )


      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
span ] )

      thisSpan :: OneSpan
thisSpan = CommandDoc -> OneSpan -> OneSpan
forall a. Show a => CommandDoc -> a -> a
dbg3 CommandDoc
"processing span" (OneSpan -> OneSpan) -> OneSpan -> OneSpan
forall a b. (a -> b) -> a -> b
$
                 Day
-> Day
-> MixedAmount
-> MixedAmount
-> [(Day, MixedAmount)]
-> [(Day, MixedAmount)]
-> OneSpan
OneSpan Day
spanBegin Day
spanEnd 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 (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 :: p -> p
smallIsZero p
x = if p -> p
forall a. Num a => a -> a
abs p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
0.01 then p
0.0 else p
x
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Day -> Text
showDate Day
spanBegin
           , Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
spanEnd)
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ MixedAmount -> CommandDoc
showMixedAmount MixedAmount
valueBefore
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ MixedAmount -> CommandDoc
showMixedAmount MixedAmount
cashFlowAmt
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ MixedAmount -> CommandDoc
showMixedAmount MixedAmount
valueAfter
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ MixedAmount -> CommandDoc
showMixedAmount (MixedAmount
valueAfter MixedAmount -> MixedAmount -> MixedAmount
`maMinus` (MixedAmount
valueBefore MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
cashFlowAmt))
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%0.2f%%" (Double -> CommandDoc) -> Double -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall p. (Ord p, Fractional p) => p -> p
smallIsZero Double
irr
           , CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%0.2f%%" (Double -> CommandDoc) -> Double -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall p. (Ord p, Fractional p) => p -> p
smallIsZero Double
twr ]

  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
              (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
. CommandDoc -> Text
T.pack (CommandDoc -> Text) -> (Integer -> CommandDoc) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show) (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take ([[Text]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
tableBody) [Integer
1..])))
              (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", Text -> Header Text
forall h. h -> Header h
Header Text
"TWR"]])
              [[Text]]
tableBody

  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 rh ch 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

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
spanBegin Day
spanEnd MixedAmount
valueBeforeAmt MixedAmount
valueAfter [(Day, MixedAmount)]
cashFlow [(Day, MixedAmount)]
pnl) = do
  let valueBefore :: Quantity
valueBefore = MixedAmount -> Quantity
unMix MixedAmount
valueBeforeAmt
  let initialUnitPrice :: Quantity
initialUnitPrice = Quantity
100 :: Decimal
  let initialUnits :: Quantity
initialUnits = Quantity
valueBefore Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
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.
        [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a a b. [(a, Either a b)] -> [(a, Either a b)]
zeroUnitsNeedsCashflowAtTheFront
        ([(Day, Either MixedAmount MixedAmount)]
 -> [(Day, Either MixedAmount MixedAmount)])
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a. Ord a => [a] -> [a]
sort
        ([(Day, Either MixedAmount MixedAmount)]
 -> [(Day, Either MixedAmount MixedAmount)])
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a b. (a -> b) -> a -> b
$ [(Day, Either MixedAmount MixedAmount)]
dailyCashflows [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a. [a] -> [a] -> [a]
++ [(Day, Either MixedAmount MixedAmount)]
forall b. [(Day, Either MixedAmount b)]
datedPnls
        where
          zeroUnitsNeedsCashflowAtTheFront :: [(a, Either a b)] -> [(a, Either a b)]
zeroUnitsNeedsCashflowAtTheFront [(a, Either a b)]
changes =
            if Quantity
initialUnits Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
0 then [(a, Either a b)]
changes
            else 
              let ([(a, Either a b)]
leadingPnls, [(a, Either a b)]
rest) = ((a, Either a b) -> Bool)
-> [(a, Either a b)] -> ([(a, Either a b)], [(a, Either a b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Either a b -> Bool
forall a b. Either a b -> Bool
isLeft (Either a b -> Bool)
-> ((a, Either a b) -> Either a b) -> (a, Either a b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Either a b) -> Either a b
forall a b. (a, b) -> b
snd) [(a, Either a b)]
changes
                  ([(a, Either a b)]
firstCashflow, [(a, Either a b)]
rest') = Int -> [(a, Either a b)] -> ([(a, Either a b)], [(a, Either a b)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [(a, Either a b)]
rest
              in [(a, Either a b)]
firstCashflow [(a, Either a b)] -> [(a, Either a b)] -> [(a, Either a b)]
forall a. [a] -> [a] -> [a]
++ [(a, Either a b)]
leadingPnls [(a, Either a b)] -> [(a, Either a b)] -> [(a, Either a b)]
forall a. [a] -> [a] -> [a]
++ [(a, Either a b)]
rest'

          datedPnls :: [(Day, Either MixedAmount b)]
datedPnls = ((Day, MixedAmount) -> (Day, Either MixedAmount b))
-> [(Day, MixedAmount)] -> [(Day, Either MixedAmount b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Day
date,MixedAmount
amt) -> (Day
date,MixedAmount -> Either MixedAmount b
forall a b. a -> Either a b
Left (MixedAmount -> Either MixedAmount b)
-> MixedAmount -> Either MixedAmount b
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
maNegate MixedAmount
amt)) [(Day, MixedAmount)]
pnl
 
          dailyCashflows :: [(Day, Either MixedAmount MixedAmount)]
dailyCashflows =
            [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a. Ord a => [a] -> [a]
sort
          -- Aggregate all entries for a single day, assuming that intraday interest is negligible
            ([(Day, Either MixedAmount MixedAmount)]
 -> [(Day, Either MixedAmount MixedAmount)])
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ([(Day, MixedAmount)] -> (Day, Either MixedAmount MixedAmount))
-> [[(Day, MixedAmount)]]
-> [(Day, Either MixedAmount MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Day, MixedAmount)]
date_cash -> let ([Day]
dates, [MixedAmount]
cash) = [(Day, MixedAmount)] -> ([Day], [MixedAmount])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, MixedAmount)]
date_cash in ([Day] -> Day
forall a. [a] -> a
head [Day]
dates, MixedAmount -> Either MixedAmount MixedAmount
forall a b. b -> Either a b
Right ([MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
cash)))
            ([[(Day, MixedAmount)]] -> [(Day, Either MixedAmount MixedAmount)])
-> [[(Day, MixedAmount)]]
-> [(Day, Either MixedAmount 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 (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)]
cashFlow

  let units :: [(Quantity, Quantity, Quantity, Quantity)]
units =
        [(Quantity, Quantity, Quantity, Quantity)]
-> [(Quantity, Quantity, Quantity, Quantity)]
forall a. [a] -> [a]
tail ([(Quantity, Quantity, Quantity, Quantity)]
 -> [(Quantity, Quantity, Quantity, Quantity)])
-> [(Quantity, Quantity, Quantity, Quantity)]
-> [(Quantity, Quantity, Quantity, Quantity)]
forall a b. (a -> b) -> a -> b
$
        ((Quantity, Quantity, Quantity, Quantity)
 -> (Day, Either MixedAmount MixedAmount)
 -> (Quantity, Quantity, Quantity, Quantity))
-> (Quantity, Quantity, Quantity, Quantity)
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Quantity, Quantity, Quantity, Quantity)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
          (\(Quantity
_, Quantity
_, Quantity
unitPrice, Quantity
unitBalance) (Day
date, Either MixedAmount MixedAmount
amt) ->
             let valueOnDate :: Quantity
valueOnDate = MixedAmount -> Quantity
unMix (MixedAmount -> Quantity) -> MixedAmount -> Quantity
forall a b. (a -> b) -> a -> b
$ Day -> Day -> MixedAmount -> MixedAmount
mixedAmountValue Day
spanEnd Day
date (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 Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Day -> Maybe Day
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 :: Quantity
unitsBoughtOrSold = MixedAmount -> Quantity
unMix MixedAmount
amt Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
unitPrice
                 in (Quantity
valueOnDate, Quantity
unitsBoughtOrSold, Quantity
unitPrice, Quantity
unitBalance Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
+ Quantity
unitsBoughtOrSold)
               Left MixedAmount
pnl ->
                 -- PnL change
                 let valueAfterDate :: Quantity
valueAfterDate = Quantity
valueOnDate Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
+ MixedAmount -> Quantity
unMix MixedAmount
pnl
                     unitPrice' :: Quantity
unitPrice' = Quantity
valueAfterDateQuantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/Quantity
unitBalance
                 in (Quantity
valueOnDate, Quantity
0, Quantity
unitPrice', Quantity
unitBalance))
          (Quantity
0, Quantity
0, Quantity
initialUnitPrice, Quantity
initialUnits)
          ([(Day, Either MixedAmount MixedAmount)]
 -> [(Quantity, Quantity, Quantity, Quantity)])
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Quantity, Quantity, Quantity, Quantity)]
forall a b. (a -> b) -> a -> b
$ CommandDoc
-> [(Day, Either MixedAmount MixedAmount)]
-> [(Day, Either MixedAmount MixedAmount)]
forall a. Show a => CommandDoc -> a -> a
dbg3 CommandDoc
"changes" [(Day, Either MixedAmount MixedAmount)]
changes

  let finalUnitBalance :: Quantity
finalUnitBalance = if [(Quantity, Quantity, Quantity, Quantity)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Quantity, Quantity, Quantity, Quantity)]
units then Quantity
initialUnits else let (Quantity
_,Quantity
_,Quantity
_,Quantity
u) = [(Quantity, Quantity, Quantity, Quantity)]
-> (Quantity, Quantity, Quantity, Quantity)
forall a. [a] -> a
last [(Quantity, Quantity, Quantity, Quantity)]
units in Quantity
u
      finalUnitPrice :: Quantity
finalUnitPrice = if Quantity
finalUnitBalance Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity
0 then Quantity
initialUnitPrice
                       else (MixedAmount -> Quantity
unMix MixedAmount
valueAfter) Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
finalUnitBalance
      -- Technically, totalTWR should be (100*(finalUnitPrice - initialUnitPrice) / initialUnitPrice), but initalUnitPrice is 100, so 100/100 == 1
      totalTWR :: Quantity
totalTWR = Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 (Quantity -> Quantity) -> Quantity -> Quantity
forall a b. (a -> b) -> a -> b
$ (Quantity
finalUnitPrice Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
- Quantity
initialUnitPrice)
      years :: Double
years = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Day -> Integer
diffDays Day
spanEnd Day
spanBegin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
365 :: Double
      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
+(Quantity -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Quantity
totalTWRDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
100))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
    CommandDoc -> Text -> Text -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"\nTWR cash flow for %s - %s\n" (Day -> Text
showDate Day
spanBegin) (Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
spanEnd))
    let ([Day]
dates', [Either MixedAmount MixedAmount]
amounts) = [(Day, Either MixedAmount MixedAmount)]
-> ([Day], [Either MixedAmount MixedAmount])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, Either MixedAmount MixedAmount)]
changes
        cashflows' :: [MixedAmount]
cashflows' = (Either MixedAmount MixedAmount -> MixedAmount)
-> [Either MixedAmount MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> Either MixedAmount MixedAmount -> MixedAmount
forall b a. b -> Either a b -> b
fromRight MixedAmount
nullmixedamt) [Either MixedAmount MixedAmount]
amounts
        pnls :: [MixedAmount]
pnls = (Either MixedAmount MixedAmount -> MixedAmount)
-> [Either MixedAmount MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> Either MixedAmount MixedAmount -> MixedAmount
forall a b. a -> Either a b -> a
fromLeft MixedAmount
nullmixedamt) [Either MixedAmount MixedAmount]
amounts
        ([Quantity]
valuesOnDate,[Quantity]
unitsBoughtOrSold', [Quantity]
unitPrices', [Quantity]
unitBalances') = [(Quantity, Quantity, Quantity, Quantity)]
-> ([Quantity], [Quantity], [Quantity], [Quantity])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(Quantity, Quantity, Quantity, Quantity)]
units
        add :: a -> [a] -> [a]
add a
x [a]
lst = if Quantity
valueBeforeQuantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/=Quantity
0 then a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
lst else [a]
lst
        dates :: [Day]
dates = Day -> [Day] -> [Day]
forall a. a -> [a] -> [a]
add Day
spanBegin [Day]
dates'
        cashflows :: [MixedAmount]
cashflows = MixedAmount -> [MixedAmount] -> [MixedAmount]
forall a. a -> [a] -> [a]
add MixedAmount
valueBeforeAmt [MixedAmount]
cashflows'
        unitsBoughtOrSold :: [Quantity]
unitsBoughtOrSold = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
initialUnits [Quantity]
unitsBoughtOrSold'
        unitPrices :: [Quantity]
unitPrices = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
initialUnitPrice [Quantity]
unitPrices'
        unitBalances :: [Quantity]
unitBalances = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
initialUnits [Quantity]
unitBalances'

    Text -> IO ()
TL.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (Text -> Text)
-> (Text -> Text)
-> (CommandDoc -> Text)
-> Table Text Text CommandDoc
-> Text
forall rh ch 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 CommandDoc -> Text
T.pack
      (Header Text
-> Header Text -> [[CommandDoc]] -> Table Text Text CommandDoc
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
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
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
"Portfolio value", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Unit balance"]
                         , 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
"Pnl", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Cashflow", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Unit price", Text -> Header Text
forall h. h -> Header h
Tab.Header Text
"Units"]
                         , 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
"New Unit Balance"]])
       [ [CommandDoc
value, CommandDoc
oldBalance, CommandDoc
pnl, CommandDoc
cashflow, CommandDoc
prc, CommandDoc
udelta, CommandDoc
balance]
       | CommandDoc
value <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
showDecimal [Quantity]
valuesOnDate
       | CommandDoc
oldBalance <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
showDecimal (Quantity
0Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
:[Quantity]
unitBalances)
       | CommandDoc
balance <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
showDecimal [Quantity]
unitBalances
       | CommandDoc
pnl <- (MixedAmount -> CommandDoc) -> [MixedAmount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> CommandDoc
showMixedAmount [MixedAmount]
pnls
       | CommandDoc
cashflow <- (MixedAmount -> CommandDoc) -> [MixedAmount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> CommandDoc
showMixedAmount [MixedAmount]
cashflows
       | CommandDoc
prc <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
showDecimal [Quantity]
unitPrices
       | CommandDoc
udelta <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
showDecimal [Quantity]
unitsBoughtOrSold ])

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

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

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

      postfix :: (Day, MixedAmount)
postfix = (Day
spanEnd, 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
    CommandDoc -> Text -> Text -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"\nIRR cash flow for %s - %s\n" (Day -> Text
showDate Day
spanBegin) (Day -> Text
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
spanEnd))
    let ([Day]
dates, [MixedAmount]
amounts) = [(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 rh ch 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
. CommandDoc -> Text
T.pack (CommandDoc -> Text)
-> (MixedAmount -> CommandDoc) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> CommandDoc
showMixedAmount) [MixedAmount]
amounts))

  -- 0% is always a solution, so require at least something here
  case [(Day, MixedAmount)]
totalCF of
    [] -> Double -> IO Double
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
spanEnd [(Day, MixedAmount)]
totalCF) of
        Root Double
rate    -> Double -> IO Double
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 -> CommandDoc -> IO Double
forall a. CommandDoc -> a
error' (CommandDoc -> IO Double) -> CommandDoc -> IO Double
forall a b. (a -> b) -> a -> b
$ CommandDoc
"Error (NotBracketed): No solution for Internal Rate of Return (IRR).\n"
                        CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++       CommandDoc
"  Possible causes: IRR is huge (>1000000%), balance of investment becomes negative at some point in time."
        Root Double
SearchFailed -> CommandDoc -> IO Double
forall a. CommandDoc -> a
error' (CommandDoc -> IO Double) -> CommandDoc -> IO Double
forall a b. (a -> b) -> a -> b
$ CommandDoc
"Error (SearchFailed): Failed to find solution for Internal Rate of Return (IRR).\n"
                        CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++       CommandDoc
"  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 (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) = Quantity -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (MixedAmount -> Quantity
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 <- (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) ((Transaction -> [Posting]) -> [Transaction] -> [Posting]
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 ([Posting] -> MixedAmount)
-> ([Posting] -> [Posting]) -> [Posting] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
query) ([Posting] -> MixedAmount) -> [Posting] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
realPostings [Transaction]
trans

unMix :: MixedAmount -> Quantity
unMix :: MixedAmount -> Quantity
unMix MixedAmount
a =
  case (MixedAmount -> Maybe Amount
unifyMixedAmount (MixedAmount -> Maybe Amount) -> MixedAmount -> Maybe Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
a) of
    Just Amount
a -> Amount -> Quantity
aquantity Amount
a
    Maybe Amount
Nothing -> CommandDoc -> Quantity
forall a. CommandDoc -> a
error' (CommandDoc -> Quantity) -> CommandDoc -> Quantity
forall a b. (a -> b) -> a -> b
$ CommandDoc
"Amounts could not be converted to a single cost basis: " CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ [CommandDoc] -> CommandDoc
forall a. Show a => a -> CommandDoc
show ((Amount -> CommandDoc) -> [Amount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> CommandDoc
showAmount ([Amount] -> [CommandDoc]) -> [Amount] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts MixedAmount
a) CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
               CommandDoc
"\nConsider using --value to force all costs to be in a single commodity." CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
               CommandDoc
"\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 :: Quantity -> CommandDoc
showDecimal Quantity
d = if Quantity
d Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity
rounded then Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show Quantity
d else Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show Quantity
rounded
  where
    rounded :: Quantity
rounded = Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 Quantity
d