1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
module Hledger.Interest
( Computer, runComputer
, Config(..)
, InterestState(..), nullInterestState
, processTransaction, computeInterest
, module Hledger.Interest.DayCountConvention
, module Hledger.Interest.Rate
, module Hledger.Data
)
where
import Hledger.Data
import Hledger.Interest.DayCountConvention
import Hledger.Interest.Rate
import Control.Monad
import Control.Monad.RWS
import Data.Decimal
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
type Computer = RWS Config [Transaction] InterestState
runComputer :: Config -> Computer () -> [Transaction]
runComputer cfg f = ts
where ((),_,ts) = runRWS f cfg nullInterestState
data Config = Config
{ interestAccount :: AccountName
, sourceAccount :: AccountName
, targetAccount :: AccountName
, dayCountConvention :: DayCountConvention
, interestRate :: Rate
}
data InterestState = InterestState
{ balancedUntil :: Day
, balance :: MixedAmount
}
nullInterestState :: InterestState
nullInterestState = InterestState
{ balancedUntil = nulldate
, balance = nullmixedamt
}
processTransaction :: Transaction -> Computer ()
processTransaction ts = do
let day = fromMaybe (tdate ts) (tdate2 ts)
computeInterest day
interestAcc <- asks interestAccount
let posts = [ p | p <- tpostings ts, interestAcc == paccount p ]
forM_ posts $ \p -> do
bal <- gets balance
modify (\st -> st { balance = bal + pamount p })
computeInterest :: Day -> Computer ()
computeInterest day = do
from <- gets balancedUntil
bal <- gets balance
rate <- asks interestRate
let (endOfPeriod,ratePerAnno) = rate from
to = min day endOfPeriod
newFrom = succ to
modify (\st -> st { balancedUntil = newFrom })
when (to >= from && not (mixedAmountIsZero bal)) $ do
diff <- asks dayCountConvention
t <- mkTrans to ((from `diff` to) + 1) ratePerAnno
tell [t]
processTransaction t
when (newFrom < day) (computeInterest day)
daysInYear :: Day -> Computer Integer
daysInYear now = asks dayCountConvention >>= \diff -> return (day1 `diff` day2)
where day1 = fromGregorian (fst (toOrdinalDate now)) 1 1
day2 = fromGregorian (succ (fst (toOrdinalDate now))) 1 1
mkTrans :: Day -> Integer -> Decimal -> Computer Transaction
mkTrans day days ratePerAnno = do
bal <- gets balance
srcAcc <- asks sourceAccount
targetAcc <- asks targetAccount
perDayScalar <- daysInYear day
let t = nulltransaction
{ tdate = day
, tdescription = T.pack $ showPercent ratePerAnno ++ " interest for " ++ showMixedAmount bal ++ " over " ++ show days ++ " days"
, tpostings = [pTarget,pSource]
}
pTarget = nullposting
{ paccount = targetAcc
, pamount = mixed [ a { aquantity = (aquantity a * ratePerAnno) / fromInteger perDayScalar * fromInteger days } | a <- amounts bal ]
, ptype = RegularPosting
, ptransaction = Just t
}
pSource = nullposting
{ paccount = srcAcc
, pamount = negate (pamount pTarget)
, ptype = RegularPosting
, ptransaction = Just t
}
return t
showPercent :: Decimal -> String
showPercent r = shows (r * 100) "%"
|
