{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE TemplateHaskell  #-}
{-|

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.Function (on)
import Data.List
import Numeric.RootFinding
import Data.Decimal
import qualified Data.Text as T
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 [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
  Quantity -- value of investment at the beginning of day on spanBegin_
  Quantity  -- value of investment at the end of day on spanEnd_
  [(Day,Quantity)] -- all deposits and withdrawals (but not changes of value) in the DateSpan [spanBegin_,spanEnd_)
  [(Day,Quantity)] -- 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_=ReportSpec
rspec} Journal
j = do
  Day
d <- IO Day
getCurrentDay
  let
    ropts :: ReportOpts
ropts = ReportSpec -> ReportOpts
rsOpts ReportSpec
rspec
    showCashFlow :: Bool
showCashFlow = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"cashflow" RawOpts
rawopts
    prettyTables :: Bool
prettyTables = ReportOpts -> Bool
pretty_tables_ ReportOpts
ropts
    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
d (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 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 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 -> 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 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 -> [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 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
      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)) ] )

      pnl :: CashFlow
pnl =
        [Transaction] -> Query -> CashFlow
calculateCashFlow [Transaction]
trans ([Query] -> Query
And [ Query -> Query
Not Query
investmentsQuery
                                     , 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 CommandDoc
"processing span" (OneSpan -> OneSpan) -> OneSpan -> OneSpan
forall a b. (a -> b) -> a -> b
$
                 Day
-> Day -> Quantity -> Quantity -> CashFlow -> CashFlow -> OneSpan
OneSpan Day
spanBegin Day
spanEnd Quantity
valueBefore Quantity
valueAfter CashFlow
cashFlow CashFlow
pnl

    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 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
    [CommandDoc] -> IO [CommandDoc]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Day -> CommandDoc
showDate Day
spanBegin
           , Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-Integer
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 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 -> 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 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) [Integer
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 CommandDoc
"Begin", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"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 CommandDoc
"Value (begin)", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"Cashflow", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"Value (end)", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"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 CommandDoc
"IRR", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"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 Bool
showCashFlow Bool
prettyTables Query
investmentsQuery [Transaction]
trans (OneSpan Day
spanBegin Day
spanEnd Quantity
valueBefore Quantity
valueAfter CashFlow
cashFlow CashFlow
pnl) = do
  let initialUnitPrice :: Quantity
initialUnitPrice = Quantity
100
  let initialUnits :: Quantity
initialUnits = Quantity
valueBefore Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity
initialUnitPrice
  let changes :: [(Day, Either Quantity Quantity)]
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
        [(Day, Either Quantity Quantity)]
-> [(Day, Either Quantity Quantity)]
forall a. Ord a => [a] -> [a]
sort
        ([(Day, Either Quantity Quantity)]
 -> [(Day, Either Quantity Quantity)])
-> [(Day, Either Quantity Quantity)]
-> [(Day, Either Quantity Quantity)]
forall a b. (a -> b) -> a -> b
$ [(Day, Either Quantity Quantity)]
-> [(Day, Either Quantity Quantity)]
-> [(Day, Either Quantity Quantity)]
forall a. [a] -> [a] -> [a]
(++) (((Day, Quantity) -> (Day, Either Quantity Quantity))
-> CashFlow -> [(Day, Either Quantity Quantity)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Day
date,Quantity
amt) -> (Day
date,Quantity -> Either Quantity Quantity
forall a b. a -> Either a b
Left (-Quantity
amt))) CashFlow
pnl )
        -- Aggregate all entries for a single day, assuming that intraday interest is negligible
        ([(Day, Either Quantity Quantity)]
 -> [(Day, Either Quantity Quantity)])
-> [(Day, Either Quantity Quantity)]
-> [(Day, Either Quantity Quantity)]
forall a b. (a -> b) -> a -> b
$ (CashFlow -> (Day, Either Quantity Quantity))
-> [CashFlow] -> [(Day, Either Quantity Quantity)]
forall a b. (a -> b) -> [a] -> [b]
map (\CashFlow
date_cash -> let ([Day]
dates, [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 -> Either Quantity Quantity
forall a b. b -> Either a b
Right ([Quantity] -> Quantity
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Quantity]
cash)))
        ([CashFlow] -> [(Day, Either Quantity Quantity)])
-> [CashFlow] -> [(Day, Either Quantity Quantity)]
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 (\(Day
d,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
$ 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, Either Quantity Quantity)
 -> (Quantity, Quantity, Quantity, Quantity))
-> (Quantity, Quantity, Quantity, Quantity)
-> [(Day, Either Quantity Quantity)]
-> [(Quantity, Quantity, Quantity, Quantity)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
          (\(Quantity
_, Quantity
_, Quantity
unitPrice, Quantity
unitBalance) (Day
date, Either Quantity 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))])
             in
             case Either Quantity Quantity
amt of
               Right Quantity
amt ->
                 -- we are buying or selling
                 let 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)
               Left Quantity
pnl ->
                 -- PnL change
                 let valueAfterDate :: Quantity
valueAfterDate = Quantity
valueOnDate Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
+ Quantity
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 Quantity Quantity)]
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 Quantity
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

  let s :: DecimalRaw i -> CommandDoc
s 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 Word8
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 CommandDoc
"\nTWR cash flow for %s - %s\n" (Day -> CommandDoc
showDate Day
spanBegin) (Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
spanEnd))
    let ([Day]
dates', [Either Quantity Quantity]
amounts) = [(Day, Either Quantity Quantity)]
-> ([Day], [Either Quantity Quantity])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Day, Either Quantity Quantity)]
changes
        cashflows' :: [Quantity]
cashflows' = (Either Quantity Quantity -> Quantity)
-> [Either Quantity Quantity] -> [Quantity]
forall a b. (a -> b) -> [a] -> [b]
map ((Quantity -> Quantity)
-> (Quantity -> Quantity) -> Either Quantity Quantity -> Quantity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Quantity
_ -> Quantity
0) Quantity -> Quantity
forall a. a -> a
id) [Either Quantity Quantity]
amounts
        pnls' :: [Quantity]
pnls' = (Either Quantity Quantity -> Quantity)
-> [Either Quantity Quantity] -> [Quantity]
forall a b. (a -> b) -> [a] -> [b]
map ((Quantity -> Quantity)
-> (Quantity -> Quantity) -> Either Quantity Quantity -> Quantity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Quantity -> Quantity
forall a. a -> a
id (\Quantity
_ -> Quantity
0)) [Either Quantity Quantity]
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 :: [Quantity]
cashflows = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
valueBefore [Quantity]
cashflows'
        pnls :: [Quantity]
pnls = Quantity -> [Quantity] -> [Quantity]
forall a. a -> [a] -> [a]
add Quantity
0 [Quantity]
pnls'
        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 Quantity
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 CommandDoc
"Portfolio value", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"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 CommandDoc
"Pnl", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"Cashflow", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"Unit price", CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
"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 CommandDoc
"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
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 (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
forall i. (Integral i, Show i) => DecimalRaw i -> CommandDoc
s [Quantity]
unitBalances
       | CommandDoc
pnl <- (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]
pnls
       | CommandDoc
cashflow <- (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]
cashflows
       | 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 CommandDoc
"Final unit price: %s/%s units = %s\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 Bool
showCashFlow Bool
prettyTables (OneSpan Day
spanBegin Day
spanEnd Quantity
valueBefore Quantity
valueAfter CashFlow
cashFlow CashFlow
_pnl) = 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
/=Quantity
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 CommandDoc
"\nIRR cash flow for %s - %s\n" (Day -> CommandDoc
showDate Day
spanBegin) (Day -> CommandDoc
showDate (Integer -> Day -> Day
addDays (-Integer
1) Day
spanEnd))
    let ([Day]
dates, [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 CommandDoc
"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))

  -- 0% is always a solution, so require at least something here
  case CashFlow
totalCF of
    [] -> Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
0
    CashFlow
_ -> 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 -> CashFlow -> Double -> Double
interestSum Day
spanEnd CashFlow
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, Quantity)]

interestSum :: Day -> CashFlow -> Double -> Double
interestSum :: Day -> CashFlow -> Double -> Double
interestSum Day
referenceDay CashFlow
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, 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 (Day
t,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
/ Double
365))


calculateCashFlow :: [Transaction] -> Query -> CashFlow
calculateCashFlow :: [Transaction] -> Query -> CashFlow
calculateCashFlow [Transaction]
trans Query
query = ((Day, Quantity) -> Bool) -> CashFlow -> CashFlow
forall a. (a -> Bool) -> [a] -> [a]
filter ((Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/=Quantity
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
$ (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 Transaction
t = (Transaction -> Day
transactionDate2 Transaction
t, [Transaction] -> Query -> Quantity
total [Transaction
t] Query
query)

total :: [Transaction] -> Query -> Quantity
total :: [Transaction] -> Query -> Quantity
total [Transaction]
trans 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 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)