{-# LANGUAGE ParallelListComp, CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Roi (
roimode
, roi
) where
import Control.Monad
import System.Exit
import Data.Time.Calendar
import Text.Printf
import Data.Function (on)
import Data.List
import Numeric.RootFinding
import Data.Decimal
import System.Console.CmdArgs.Explicit as CmdArgs
import Text.Tabular as Tbl
import Text.Tabular.AsciiWide as Ascii
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 ["cashflow"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "cashflow") "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 ["investment"] (\s :: CommandDoc
s opts :: 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 "investment" CommandDoc
s RawOpts
opts) "QUERY"
"query to select your investment transactions"
,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq ["profit-loss","pnl"] (\s :: CommandDoc
s opts :: 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 "pnl" CommandDoc
s RawOpts
opts) "QUERY"
"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 "[QUERY]")
data OneSpan = OneSpan
Day
Day
Quantity
Quantity
[(Day,Quantity)]
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, reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
Day
d <- IO Day
getCurrentDay
let
investmentsQuery :: Query
investmentsQuery = Day -> ReportOpts -> Query
queryFromOpts Day
d (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportOpts
ropts{query_ :: CommandDoc
query_ = CommandDoc -> RawOpts -> CommandDoc
stringopt "investment" RawOpts
rawopts,period_ :: Period
period_=Period
PeriodAll}
pnlQuery :: Query
pnlQuery = Day -> ReportOpts -> Query
queryFromOpts Day
d (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportOpts
ropts{query_ :: CommandDoc
query_ = CommandDoc -> RawOpts -> CommandDoc
stringopt "pnl" RawOpts
rawopts,period_ :: Period
period_=Period
PeriodAll}
showCashFlow :: Bool
showCashFlow = CommandDoc -> RawOpts -> Bool
boolopt "cashflow" RawOpts
rawopts
prettyTables :: Bool
prettyTables = ReportOpts -> Bool
pretty_tables_ ReportOpts
ropts
trans :: [Transaction]
trans = CommandDoc -> [Transaction] -> [Transaction]
forall a. Show a => CommandDoc -> a -> a
dbg3 "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 Transaction -> Day
transactionDate2 [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 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 -> DateSpan) -> Period -> DateSpan
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Period
period_ ReportOpts
ropts
requestedInterval :: Interval
requestedInterval = ReportOpts -> Interval
interval_ ReportOpts
ropts
wholeSpan :: DateSpan
wholeSpan = 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 "No relevant transactions found. Check your investments query"
IO ()
forall a. IO a
exitFailure
let spans :: [DateSpan]
spans = case Interval
requestedInterval of
NoInterval -> [DateSpan
wholeSpan]
interval :: Interval
interval ->
Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval (DateSpan -> [DateSpan]) -> DateSpan -> [DateSpan]
forall a b. (a -> b) -> a -> b
$
DateSpan -> DateSpan -> DateSpan
spanIntersect DateSpan
journalSpan DateSpan
wholeSpan
[[CommandDoc]]
tableBody <- [DateSpan] -> (DateSpan -> IO [CommandDoc]) -> IO [[CommandDoc]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DateSpan]
spans ((DateSpan -> IO [CommandDoc]) -> IO [[CommandDoc]])
-> (DateSpan -> IO [CommandDoc]) -> IO [[CommandDoc]]
forall a b. (a -> b) -> a -> b
$ \(DateSpan (Just spanBegin :: Day
spanBegin) (Just spanEnd :: Day
spanEnd)) -> do
let
valueBefore :: Quantity
valueBefore =
[Transaction] -> Query -> Quantity
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 :: Quantity
valueAfter =
[Transaction] -> Query -> Quantity
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))])
cashFlow :: CashFlow
cashFlow =
[Transaction] -> Query -> CashFlow
calculateCashFlow [Transaction]
trans ([Query] -> Query
And [ Query -> Query
Not Query
investmentsQuery
, Query -> Query
Not Query
pnlQuery
, DateSpan -> Query
Date (Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
spanBegin) (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
spanEnd)) ] )
thisSpan :: OneSpan
thisSpan = CommandDoc -> OneSpan -> OneSpan
forall a. Show a => CommandDoc -> a -> a
dbg3 "processing span" (OneSpan -> OneSpan) -> OneSpan -> OneSpan
forall a b. (a -> b) -> a -> b
$
Day -> Day -> Quantity -> Quantity -> CashFlow -> OneSpan
OneSpan Day
spanBegin Day
spanEnd Quantity
valueBefore Quantity
valueAfter CashFlow
cashFlow
Double
irr <- Bool -> Bool -> OneSpan -> IO Double
internalRateOfReturn Bool
showCashFlow Bool
prettyTables OneSpan
thisSpan
Double
twr <- Bool -> Bool -> Query -> [Transaction] -> OneSpan -> IO Double
timeWeightedReturn Bool
showCashFlow Bool
prettyTables Query
investmentsQuery [Transaction]
trans OneSpan
thisSpan
let cashFlowAmt :: Quantity
cashFlowAmt = Quantity -> Quantity
forall a. Num a => a -> a
negate (Quantity -> Quantity) -> Quantity -> Quantity
forall a b. (a -> b) -> a -> b
$ [Quantity] -> Quantity
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Quantity] -> Quantity) -> [Quantity] -> Quantity
forall a b. (a -> b) -> a -> b
$ ((Day, Quantity) -> Quantity) -> CashFlow -> [Quantity]
forall a b. (a -> b) -> [a] -> [b]
map (Day, Quantity) -> Quantity
forall a b. (a, b) -> b
snd CashFlow
cashFlow
let smallIsZero :: p -> p
smallIsZero x :: p
x = if p -> p
forall a. Num a => a -> a
abs p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< 0.01 then 0.0 else p
x
[CommandDoc] -> IO [CommandDoc]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Day -> CommandDoc
showDate Day
spanBegin
, Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-1) Day
spanEnd)
, Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show Quantity
valueBefore
, Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show Quantity
cashFlowAmt
, Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show Quantity
valueAfter
, Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Quantity
valueAfter Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
- (Quantity
valueBefore Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
+ Quantity
cashFlowAmt))
, CommandDoc -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf "%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 -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf "%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 CommandDoc CommandDoc CommandDoc
table = Header CommandDoc
-> Header CommandDoc
-> [[CommandDoc]]
-> Table CommandDoc CommandDoc CommandDoc
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
NoLine ((Integer -> Header CommandDoc) -> [Integer] -> [Header CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header (CommandDoc -> Header CommandDoc)
-> (Integer -> CommandDoc) -> Integer -> Header CommandDoc
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 ([[CommandDoc]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[CommandDoc]]
tableBody) [1..])))
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
DoubleLine
[ Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Begin", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "End"]
, Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Value (begin)", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Cashflow", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Value (end)", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "PnL"]
, Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "IRR", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "TWR"]])
[[CommandDoc]]
tableBody
CommandDoc -> IO ()
putStrLn (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> Table CommandDoc CommandDoc CommandDoc
-> CommandDoc
forall rh ch a.
Bool
-> (rh -> CommandDoc)
-> (ch -> CommandDoc)
-> (a -> CommandDoc)
-> Table rh ch a
-> CommandDoc
Ascii.render Bool
prettyTables CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id Table CommandDoc CommandDoc CommandDoc
table
timeWeightedReturn :: Bool -> Bool -> Query -> [Transaction] -> OneSpan -> IO Double
timeWeightedReturn showCashFlow :: Bool
showCashFlow prettyTables :: Bool
prettyTables investmentsQuery :: Query
investmentsQuery trans :: [Transaction]
trans (OneSpan spanBegin :: Day
spanBegin spanEnd :: Day
spanEnd valueBefore :: Quantity
valueBefore valueAfter :: Quantity
valueAfter cashFlow :: CashFlow
cashFlow) = do
let initialUnitPrice :: Quantity
initialUnitPrice = 100
let initialUnits :: Quantity
initialUnits = Quantity
valueBefore Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
initialUnitPrice
let cashflow :: CashFlow
cashflow =
(CashFlow -> (Day, Quantity)) -> [CashFlow] -> CashFlow
forall a b. (a -> b) -> [a] -> [b]
map (\date_cash :: CashFlow
date_cash -> let (dates :: [Day]
dates, cash :: [Quantity]
cash) = CashFlow -> ([Day], [Quantity])
forall a b. [(a, b)] -> ([a], [b])
unzip CashFlow
date_cash in ([Day] -> Day
forall a. [a] -> a
head [Day]
dates, [Quantity] -> Quantity
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Quantity]
cash))
([CashFlow] -> CashFlow) -> [CashFlow] -> CashFlow
forall a b. (a -> b) -> a -> b
$ ((Day, Quantity) -> (Day, Quantity) -> Bool)
-> CashFlow -> [CashFlow]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Day -> Day -> Bool)
-> ((Day, Quantity) -> Day)
-> (Day, Quantity)
-> (Day, Quantity)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Day, Quantity) -> Day
forall a b. (a, b) -> a
fst)
(CashFlow -> [CashFlow]) -> CashFlow -> [CashFlow]
forall a b. (a -> b) -> a -> b
$ ((Day, Quantity) -> Day) -> CashFlow -> CashFlow
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Day, Quantity) -> Day
forall a b. (a, b) -> a
fst
(CashFlow -> CashFlow) -> CashFlow -> CashFlow
forall a b. (a -> b) -> a -> b
$ ((Day, Quantity) -> (Day, Quantity)) -> CashFlow -> CashFlow
forall a b. (a -> b) -> [a] -> [b]
map (\(d :: Day
d,a :: Quantity
a) -> (Day
d, Quantity -> Quantity
forall a. Num a => a -> a
negate Quantity
a))
(CashFlow -> CashFlow) -> CashFlow -> CashFlow
forall a b. (a -> b) -> a -> b
$ ((Day, Quantity) -> Bool) -> CashFlow -> CashFlow
forall a. (a -> Bool) -> [a] -> [a]
filter ((Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/=0)(Quantity -> Bool)
-> ((Day, Quantity) -> Quantity) -> (Day, Quantity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Day, Quantity) -> Quantity
forall a b. (a, b) -> b
snd) CashFlow
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, Quantity) -> (Quantity, Quantity, Quantity, Quantity))
-> (Quantity, Quantity, Quantity, Quantity)
-> CashFlow
-> [(Quantity, Quantity, Quantity, Quantity)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(_, _, _, unitBalance :: Quantity
unitBalance) (date :: Day
date, amt :: Quantity
amt) ->
let valueOnDate :: Quantity
valueOnDate = [Transaction] -> Query -> Quantity
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))])
unitPrice :: Quantity
unitPrice =
if Quantity
unitBalance Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
== 0.0
then Quantity
initialUnitPrice
else Quantity
valueOnDate Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
unitBalance
unitsBoughtOrSold :: Quantity
unitsBoughtOrSold = Quantity
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))
(0, 0, 0, Quantity
initialUnits)
CashFlow
cashflow
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 (_,_,_,u :: 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
== 0 then Quantity
initialUnitPrice
else Quantity
valueAfter Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
finalUnitBalance
totalTWR :: Quantity
totalTWR = Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo 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
/ 365 :: Double
annualizedTWR :: Double
annualizedTWR = 100Double -> Double -> Double
forall a. Num a => a -> a -> a
*((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
/100))Double -> Double -> Double
forall a. Floating a => a -> a -> a
**(1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
years)Double -> Double -> Double
forall a. Num a => a -> a -> a
-1) :: Double
let s :: DecimalRaw i -> CommandDoc
s d :: DecimalRaw i
d = DecimalRaw i -> CommandDoc
forall a. Show a => a -> CommandDoc
show (DecimalRaw i -> CommandDoc) -> DecimalRaw i -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Word8 -> DecimalRaw i -> DecimalRaw i
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo 2 DecimalRaw i
d
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 -> CommandDoc -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf "\nTWR cash flow for %s - %s\n" (Day -> CommandDoc
showDate Day
spanBegin) (Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-1) Day
spanEnd))
let (dates' :: [Day]
dates', amounts' :: [Quantity]
amounts') = CashFlow -> ([Day], [Quantity])
forall a b. [(a, b)] -> ([a], [b])
unzip CashFlow
cashflow
(valuesOnDate' :: [Quantity]
valuesOnDate',unitsBoughtOrSold' :: [Quantity]
unitsBoughtOrSold', unitPrices' :: [Quantity]
unitPrices', unitBalances' :: [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 x :: a
x lst :: [a]
lst = if Quantity
valueBeforeQuantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/=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'
amounts :: [Quantity]
amounts = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
valueBefore [Quantity]
amounts'
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'
valuesOnDate :: [Quantity]
valuesOnDate = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add 0 [Quantity]
valuesOnDate'
CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> Table CommandDoc CommandDoc CommandDoc
-> CommandDoc
forall rh ch a.
Bool
-> (rh -> CommandDoc)
-> (ch -> CommandDoc)
-> (a -> CommandDoc)
-> Table rh ch a
-> CommandDoc
Ascii.render Bool
prettyTables CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id
(Header CommandDoc
-> Header CommandDoc
-> [[CommandDoc]]
-> Table CommandDoc CommandDoc CommandDoc
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
NoLine ((Day -> Header CommandDoc) -> [Day] -> [Header CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header (CommandDoc -> Header CommandDoc)
-> (Day -> CommandDoc) -> Day -> Header CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> CommandDoc
showDate) [Day]
dates))
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
DoubleLine [ Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Portfolio value", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Unit balance"]
, Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Cash", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Unit price", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Units"]
, Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "New Unit Balance"]])
[ [CommandDoc
value, CommandDoc
oldBalance, CommandDoc
amt, CommandDoc
prc, CommandDoc
udelta, CommandDoc
balance]
| CommandDoc
value <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
valuesOnDate
| CommandDoc
oldBalance <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s (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
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
unitBalances
| CommandDoc
amt <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
amounts
| CommandDoc
prc <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
unitPrices
| CommandDoc
udelta <- (Quantity -> CommandDoc) -> [Quantity] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
unitsBoughtOrSold ])
CommandDoc
-> CommandDoc
-> CommandDoc
-> CommandDoc
-> CommandDoc
-> Double
-> Double
-> IO ()
forall r. PrintfType r => CommandDoc -> r
printf "Final unit price: %s/%s=%s U.\nTotal TWR: %s%%.\nPeriod: %.2f years.\nAnnualized TWR: %.2f%%\n\n" (Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s Quantity
valueAfter) (Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s Quantity
finalUnitBalance) (Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s Quantity
finalUnitPrice) (Quantity -> CommandDoc
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s 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 showCashFlow :: Bool
showCashFlow prettyTables :: Bool
prettyTables (OneSpan spanBegin :: Day
spanBegin spanEnd :: Day
spanEnd valueBefore :: Quantity
valueBefore valueAfter :: Quantity
valueAfter cashFlow :: CashFlow
cashFlow) = do
let prefix :: (Day, Quantity)
prefix = (Day
spanBegin, Quantity -> Quantity
forall a. Num a => a -> a
negate Quantity
valueBefore)
postfix :: (Day, Quantity)
postfix = (Day
spanEnd, Quantity
valueAfter)
totalCF :: CashFlow
totalCF = ((Day, Quantity) -> Bool) -> CashFlow -> CashFlow
forall a. (a -> Bool) -> [a] -> [a]
filter ((Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/=0) (Quantity -> Bool)
-> ((Day, Quantity) -> Quantity) -> (Day, Quantity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, Quantity) -> Quantity
forall a b. (a, b) -> b
snd) (CashFlow -> CashFlow) -> CashFlow -> CashFlow
forall a b. (a -> b) -> a -> b
$ (Day, Quantity)
prefix (Day, Quantity) -> CashFlow -> CashFlow
forall a. a -> [a] -> [a]
: (((Day, Quantity) -> Day) -> CashFlow -> CashFlow
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Day, Quantity) -> Day
forall a b. (a, b) -> a
fst CashFlow
cashFlow) CashFlow -> CashFlow -> CashFlow
forall a. [a] -> [a] -> [a]
++ [(Day, Quantity)
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 -> CommandDoc -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf "\nIRR cash flow for %s - %s\n" (Day -> CommandDoc
showDate Day
spanBegin) (Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-1) Day
spanEnd))
let (dates :: [Day]
dates, amounts :: [Quantity]
amounts) = CashFlow -> ([Day], [Quantity])
forall a b. [(a, b)] -> ([a], [b])
unzip CashFlow
totalCF
CommandDoc -> IO ()
putStrLn (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> (CommandDoc -> CommandDoc)
-> Table CommandDoc CommandDoc CommandDoc
-> CommandDoc
forall rh ch a.
Bool
-> (rh -> CommandDoc)
-> (ch -> CommandDoc)
-> (a -> CommandDoc)
-> Table rh ch a
-> CommandDoc
Ascii.render Bool
prettyTables CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id CommandDoc -> CommandDoc
forall a. a -> a
id
(Header CommandDoc
-> Header CommandDoc
-> [[CommandDoc]]
-> Table CommandDoc CommandDoc CommandDoc
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
NoLine ((Day -> Header CommandDoc) -> [Day] -> [Header CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header (CommandDoc -> Header CommandDoc)
-> (Day -> CommandDoc) -> Day -> Header CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> CommandDoc
showDate) [Day]
dates))
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
Tbl.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header "Amount"])
((Quantity -> [CommandDoc]) -> [Quantity] -> [[CommandDoc]]
forall a b. (a -> b) -> [a] -> [b]
map ((CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:[]) (CommandDoc -> [CommandDoc])
-> (Quantity -> CommandDoc) -> Quantity -> [CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> CommandDoc
forall a. Show a => a -> CommandDoc
show) [Quantity]
amounts))
case CashFlow
totalCF of
[] -> Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return 0
_ ->
case RiddersParam
-> (Double, Double) -> (Double -> Double) -> Root Double
ridders
#if MIN_VERSION_math_functions(0,3,0)
(Int -> Tolerance -> RiddersParam
RiddersParam 100 (Double -> Tolerance
AbsTol 0.00001))
#else
0.00001
#endif
(0.000000000001,10000) (Day -> CashFlow -> Double -> Double
interestSum Day
spanEnd CashFlow
totalCF) of
Root rate :: 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
-1)Double -> Double -> Double
forall a. Num a => a -> a -> a
*100)
NotBracketed -> CommandDoc -> IO Double
forall a. HasCallStack => CommandDoc -> a
error "Error: No solution -- not bracketed."
SearchFailed -> CommandDoc -> IO Double
forall a. HasCallStack => CommandDoc -> a
error "Error: Failed to find solution."
type CashFlow = [(Day, Quantity)]
interestSum :: Day -> CashFlow -> Double -> Double
interestSum :: Day -> CashFlow -> Double -> Double
interestSum referenceDay :: Day
referenceDay cf :: CashFlow
cf rate :: 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, Quantity) -> Double) -> CashFlow -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Day, Quantity) -> Double
forall a. Real a => (Day, a) -> Double
go CashFlow
cf
where go :: (Day, a) -> Double
go (t :: Day
t,m :: a
m) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (a -> Rational
forall a. Real a => a -> Rational
toRational a
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
/ 365))
calculateCashFlow :: [Transaction] -> Query -> CashFlow
calculateCashFlow :: [Transaction] -> Query -> CashFlow
calculateCashFlow trans :: [Transaction]
trans query :: Query
query = (Transaction -> (Day, Quantity)) -> [Transaction] -> CashFlow
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> (Day, Quantity)
go [Transaction]
trans
where
go :: Transaction -> (Day, Quantity)
go t :: Transaction
t = (Transaction -> Day
transactionDate2 Transaction
t, [Transaction] -> Query -> Quantity
total [Transaction
t] Query
query)
total :: [Transaction] -> Query -> Quantity
total :: [Transaction] -> Query -> Quantity
total trans :: [Transaction]
trans query :: Query
query = MixedAmount -> Quantity
unMix (MixedAmount -> Quantity) -> MixedAmount -> Quantity
forall a b. (a -> b) -> a -> b
$ [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 Query
query) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
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 a :: MixedAmount
a =
case (MixedAmount -> MixedAmount
normaliseMixedAmount (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
a) of
(Mixed [a :: Amount
a]) -> Amount -> Quantity
aquantity Amount
a
_ -> CommandDoc -> Quantity
forall a. HasCallStack => CommandDoc -> a
error "MixedAmount failed to normalize"