module HAX.Assets where
import HAX.Bookkeeping
import Control.Monad.Reader
import HAX.Common
class Asset a where
handle :: a -> AccountingRW s ()
data TransactionalAccount = TransactionalAccount {
taCredit :: InterestRate
, taDebit :: InterestRate
, taAcc :: AccountName
, taPeriod :: ASpan
}
instance Asset TransactionalAccount where
handle (TransactionalAccount icredit idebit acc period) = do
let avg m = sum m / fromIntegral (sMonths period)
tx a b c = interestTx a (b ++ " für "++ show acc) acc (Just $ return $ avg c)
date <- curDate
onceEvery period (month 12) $ do
(debit,credit) <- partition (>0) <$> balancesSince (shift (1period) date) acc
when ((sum $ debit ++ fmap negate credit) /= 0) $
logLedger $ printf "%s: positive balances: %v, negative balances: %v"
acc (PList debit) (PList credit)
tx icredit "Sollzins" credit
tx idebit "Habenzins" debit
return ()
data PaymentType = Linear Decimal
| Annuity Decimal
deriving Show
data Loan = Loan { lPrincipal :: Amount
, lPType :: PaymentType
, lPaymentAcc :: AccountName
, lLoanAcc :: AccountName
, lInterest :: InterestRate
, lStart :: ADate
, lPeriod :: ASpan
}
instance Asset Loan where
handle (Loan principal pType paymentAcc loanAcc ir start period) = do
date <- curDate
let name = show loanAcc
dur = duration pType ir
onceAt start $ fromTo principal ("Principal for "++name) loanAcc paymentAcc
>> lift (do printf "Loan %v runs for %v periods\n" name $ show $ roundTo 3 $ conv dur
)
onlyAfter start $ onceEvery period start $ do
curInterest <- interestTx ir ("Interest on "++name) loanAcc Nothing
let payment (Linear x) = x*principal + curInterest
payment (Annuity x)= x*principal + interest ir principal
fromToLimit (negate $ roundTo 3 $ payment pType) ("Rate for "++name) loanAcc paymentAcc
data Liquidity = Liquidity { lFrom :: AccountName
, lTo :: AccountName
, lPayments :: [Amount]
}
instance Asset Liquidity where
handle (Liquidity from to pays) = do
m <-reader (getMonth.eDate)
fromTo (pays !! pred m) "Liquidity Simulation" from to
where avg = sum (take 12 pays) / 12
duration :: PaymentType -> InterestRate -> Decimal
duration ptype ir = conv $ duration' ptype $ iRate ir
where duration' (Linear x) _ = conv $ 1/x
duration' (Annuity x) 0 = conv $ 1/x
duration' (Annuity x) rate = negate $ on logBase conv (1 + rate) (x/(rate + x))
annuity :: Decimal
-> Decimal
-> Amount
annuity duration' rate' = conv $ ((1 + rate) ** duration) * rate/(((1 + rate) ** duration) 1)
where rate = conv rate' :: Double
duration = conv duration' :: Double
data FixedPayment = FixedPayment {
fPayment :: Amount
, fStart :: ADate
, fOffset :: ADate
, fPeriod :: ASpan
, fSource :: AccountName
, fSink :: AccountName
, fComment :: Comment
}
instance Asset FixedPayment where
handle (FixedPayment am start offset period source sink comment) =
onlyAfter start $ onceEvery period offset $ fromTo am comment source sink
data InterestRate = IR {
iRate :: Amount
, iSource :: AccountName
}
interest :: InterestRate -> Amount -> Amount
interest ir am = roundTo 2 $ am * (iRate ir)
currentInterest :: (Monoid w, Ledger l) => InterestRate-> AccountName -> AmountA s l w
currentInterest ir acc = interest ir <$> currentBalance acc
interestTx :: InterestRate -> String
-> AccountName
-> Maybe (AmountRW s)
-> AmountRW s
interestTx ir comment acc maybeAm = do
am <- maybe (currentInterest ir acc) (interest ir <$>) maybeAm
when (am /= 0) $
fromTo am comment (iSource ir) acc
return am