diff --git a/Hledger/Interest.hs b/Hledger/Interest.hs --- a/Hledger/Interest.hs +++ b/Hledger/Interest.hs @@ -16,7 +16,7 @@ import Data.Maybe import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate -import Numeric +import Data.Decimal type Computer = RWS Config [Transaction] InterestState @@ -50,8 +50,8 @@ interestAcc <- asks interestAccount let posts = [ p | p <- tpostings ts, interestAcc == paccount p ] forM_ posts $ \p -> do - bal <- gets (balance) - modify (\st -> st { balance = normaliseMixedAmountPreservingFirstPrice (bal + (pamount p)) }) + bal <- gets balance + modify (\st -> st { balance = normaliseMixedAmountSquashPricesForDisplay (bal + pamount p) }) computeInterest :: Day -> Computer () computeInterest day = do @@ -74,49 +74,30 @@ where day1 = fromGregorian (fst (toOrdinalDate now)) 1 1 day2 = fromGregorian (succ (fst (toOrdinalDate now))) 1 1 -mkTrans :: Day -> Integer -> Double -> Computer Transaction +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 = Transaction + let t = nulltransaction { tdate = day - , tdate2 = Nothing - , tstatus = False - , tcode = "" - , tdescription = showPercent ratePerAnno ++ "% interest for " ++ showMixedAmount bal ++ " over " ++ show days ++ " days" - , tcomment = "" + , tdescription = showPercent ratePerAnno ++ " interest for " ++ showMixedAmount bal ++ " over " ++ show days ++ " days" , tpostings = [pTarget,pSource] - , tpreceding_comment_lines = "" - , ttags = [] } - pTarget = Posting - { pdate = Nothing - , pdate2 = Nothing - , pstatus = False - , paccount = targetAcc + pTarget = nullposting + { paccount = targetAcc , pamount = Mixed [ a { aquantity = (aquantity a * ratePerAnno) / fromInteger perDayScalar * fromInteger days } | a <- amounts bal ] - , pcomment = "" , ptype = RegularPosting , ptransaction = Just t - , ptags = [] } - pSource = Posting - { pdate = Nothing - , pdate2 = Nothing - , pstatus = False - , paccount = srcAcc + pSource = nullposting + { paccount = srcAcc , pamount = negate (pamount pTarget) - , pcomment = "" , ptype = RegularPosting , ptransaction = Just t - , ptags = [] } return t -showPercent :: Double -> String -showPercent r = showWith2Digits (r * 100) - -showWith2Digits :: Double -> String -showWith2Digits r = showFFloat (Just 2) r "" +showPercent :: Decimal -> String +showPercent r = shows r "%" diff --git a/Hledger/Interest/Rate.hs b/Hledger/Interest/Rate.hs --- a/Hledger/Interest/Rate.hs +++ b/Hledger/Interest/Rate.hs @@ -2,13 +2,14 @@ import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate +import Data.Decimal -type Rate = Day -> (Day,Double) +type Rate = Day -> (Day,Decimal) -constant :: Double -> Rate +constant :: Decimal -> Rate constant rate _ = (day 999999 12 31, rate) -perAnno :: Double -> Rate +perAnno :: Decimal -> Rate perAnno rate date = (day (fst (toOrdinalDate date)) 12 31, rate) day :: Integer -> Int -> Int -> Day @@ -17,12 +18,12 @@ bgb288 :: Rate bgb288 = basiszins (5/100) -basiszins :: Double -> Rate +basiszins :: Decimal -> Rate basiszins r date = (to, r + p) where (_,to,p) = head (dropWhile (\(_,to',_) -> to' < date) basiszinsTable) -basiszinsTable :: [(Day, Day, Double)] +basiszinsTable :: [(Day, Day, Decimal)] basiszinsTable = [ (day 2002 01 01, day 2002 06 30, 257 / 10000) , (day 2002 07 01, day 2002 12 31, 247 / 10000) @@ -51,7 +52,7 @@ where (_,to,p) = head (dropWhile (\(_,to',_) -> to' < date) ingDibaTable) -ingDibaTable :: [(Day, Day, Double)] +ingDibaTable :: [(Day, Day, Decimal)] ingDibaTable = [ (day 2009 01 01, day 2009 12 31, 150 / 10000) , (day 2010 01 01, day 2010 12 31, 150 / 10000) diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -59,7 +59,7 @@ , Option [] ["constant"] (ReqArg (\r o -> o { optRate = Just (constant (read r)) }) "RATE") "constant interest rate" , Option [] ["annual"] (ReqArg (\r o -> o { optRate = Just (perAnno (read r)) }) "RATE") "annual interest rate" , Option [] ["bgb288"] (NoArg (\o -> o { optRate = Just bgb288, optDCC = Just diffAct })) "compute interest according to German BGB288" - , Option [] ["ing-diba"] (NoArg (\o -> o { optRate = Just ingDiba, optDCC = Just diffAct })) "compute interest according for Ing-Diba Tagesgeld account" + , Option [] ["ing-diba"] (NoArg (\o -> o { optRate = Just ingDiba, optDCC = Just diffAct })) "compute interest according for Ing-Diba Tagesgeld account" ] usageMessage :: String @@ -87,7 +87,7 @@ when (isNothing (optRate opts)) (commandLineError "no interest rate specified\n") when (length args < 1) (commandLineError "required argument ACCOUNT is missing\n") when (length args > 1) (commandLineError "only one interest ACCOUNT may be specified\n") - jnl' <- readJournalFile Nothing Nothing (optInput opts) >>= either fail return + jnl' <- readJournalFile Nothing Nothing False (optInput opts) >>= either fail return let [interestAcc] = args jnl = filterJournalTransactions (Acct interestAcc) jnl' ts = sortBy (comparing tdate) (jtxns jnl) diff --git a/hledger-interest.cabal b/hledger-interest.cabal --- a/hledger-interest.cabal +++ b/hledger-interest.cabal @@ -1,5 +1,5 @@ Name: hledger-interest -Version: 1.4.3 +Version: 1.4.4 Synopsis: computes interest for a given account License: BSD3 License-file: LICENSE @@ -9,7 +9,7 @@ Category: Finance Build-type: Simple Cabal-version: >= 1.6 -Tested-with: GHC >= 7.0.4 && <= 7.6.3 +Tested-with: GHC >= 7.4.2 && <= 7.8.3 Data-files: README.md Description: hledger-interest is a small command-line utility based on Simon @@ -27,63 +27,63 @@ . > 2008/09/26 Loan > Assets:Bank EUR 10000.00 - > Liabilities:Loan + > Liabilities:Bank > > 2008/11/27 Payment > Assets:Bank EUR -3771.12 - > Liabilities:Loan + > Liabilities:Bank > > 2009/05/03 Payment > Assets:Bank EUR -1200.00 - > Liabilities:Loan + > Liabilities:Bank > > 2010/12/10 Payment > Assets:Bank EUR -3700.00 - > Liabilities:Loan + > Liabilities:Bank . Suppose that loan earns 5% interest per year, and payments amortize interest before amortizing the principal claim, then the resulting ledger would look like this: . - > $ hledger-interest --file=test.ledger --source=Expenses:Interest --target=Liabilities:Loan --30-360 --annual=0.05 Liabilities:Loan + > $ hledger-interest --file=test.ledger --source=Expenses:Interest --target=Liabilities:Bank --30-360 --annual=0.05 Liabilities:Bank > 2008/09/26 Loan > Assets:Bank EUR 10000.00 - > Liabilities:Loan + > Liabilities:Bank > > 2008/11/27 Payment > Assets:Bank EUR -3771.12 - > Liabilities:Loan + > Liabilities:Bank > > 2008/11/27 5.00% interest for EUR -10000.00 over 61 days - > Liabilities:Loan EUR -84.72 + > Liabilities:Bank EUR -84.72 > Expenses:Interest > > 2008/12/31 5.00% interest for EUR -6313.60 over 34 days - > Liabilities:Loan EUR -29.81 + > Liabilities:Bank EUR -29.81 > Expenses:Interest > > 2009/05/03 Payment > Assets:Bank EUR -1200.00 - > Liabilities:Loan + > Liabilities:Bank > > 2009/05/03 5.00% interest for EUR -6343.42 over 123 days - > Liabilities:Loan EUR -108.37 + > Liabilities:Bank EUR -108.37 > Expenses:Interest > > 2009/12/31 5.00% interest for EUR -5251.78 over 238 days - > Liabilities:Loan EUR -173.60 + > Liabilities:Bank EUR -173.60 > Expenses:Interest > > 2010/12/10 Payment > Assets:Bank EUR -3700.00 - > Liabilities:Loan + > Liabilities:Bank > > 2010/12/10 5.00% interest for EUR -5425.38 over 340 days - > Liabilities:Loan EUR -256.20 + > Liabilities:Bank EUR -256.20 > Expenses:Interest > > 2010/12/31 5.00% interest for EUR -1981.58 over 21 days - > Liabilities:Loan EUR -5.78 + > Liabilities:Bank EUR -5.78 > Expenses:Interest . Running the utility with @--help@ gives a brief overview over the @@ -112,7 +112,7 @@ Executable hledger-interest Main-is: Main.hs - Build-depends: base >= 3 && < 5, hledger-lib >= 0.20, time, mtl, Cabal + Build-depends: base >= 3 && < 5, hledger-lib >= 0.23.98, time, mtl, Cabal, Decimal other-modules: Hledger.Interest Hledger.Interest.DayCountConvention Hledger.Interest.Rate