diff --git a/Hledger/Interest.hs b/Hledger/Interest.hs new file mode 100644 --- /dev/null +++ b/Hledger/Interest.hs @@ -0,0 +1,117 @@ +module Hledger.Interest + ( Computer, runComputer + , Config(..) + , InterestState(..), nullInterestState + , processTransaction, computeInterest + , module Hledger.Interest.DayCountConvention + , module Hledger.Interest.Rate + , module Hledger.Data + ) + where + +import Hledger.Interest.DayCountConvention +import Hledger.Interest.Rate +import Hledger.Data +import Control.Monad.RWS +import Data.Time.Calendar.OrdinalDate +import Numeric + +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) (teffectivedate ts) + computeInterest day + interestAcc <- asks interestAccount + let posts = [ p | p <- tpostings ts, interestAcc == paccount p ] + forM_ posts $ \p -> do + bal <- gets (amounts . balance) + let bal' = bal ++ amounts (pamount p) + modify (\st -> st { balance = normaliseMixedAmount (Mixed bal') }) + +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 (isZeroMixedAmount 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 -> Double -> Computer Transaction +mkTrans day days ratePerAnno = do + bal <- gets balance + srcAcc <- asks sourceAccount + targetAcc <- asks targetAccount + perDayScalar <- daysInYear day + let t = Transaction + { tdate = day + , teffectivedate = Nothing + , tstatus = False + , tcode = "" + , tdescription = showPercent ratePerAnno ++ "% interest for " ++ show bal ++ " over " ++ show days ++ " days" + , tcomment = "" + , tmetadata = [] + , tpostings = [pTarget,pSource] + , tpreceding_comment_lines = "" + } + pTarget = Posting + { pstatus = False + , paccount = targetAcc + , pamount = Mixed [ a { quantity = (quantity a * ratePerAnno) / fromInteger perDayScalar * fromInteger days } | a <- amounts bal ] + , pcomment = "" + , ptype = RegularPosting + , pmetadata = [] + , ptransaction = Just t + } + pSource = Posting + { pstatus = False + , paccount = srcAcc + , pamount = negate (pamount pTarget) + , pcomment = "" + , ptype = RegularPosting + , pmetadata = [] + , ptransaction = Just t + } + return t + +showPercent :: Double -> String +showPercent r = showWith2Digits (r * 100) + +showWith2Digits :: Double -> String +showWith2Digits r = showFFloat (Just 2) r "" diff --git a/Hledger/Interest/DayCountConvention.hs b/Hledger/Interest/DayCountConvention.hs new file mode 100644 --- /dev/null +++ b/Hledger/Interest/DayCountConvention.hs @@ -0,0 +1,45 @@ +module Hledger.Interest.DayCountConvention + ( DayCountConvention + , diffAct + , diff30_360 + , diff30E_360 + , diff30E_360isda + ) + where + +import Control.Exception ( assert ) +import Data.Time.Calendar + +type DayCountConvention = Day -> Day -> Integer + +diffAct :: DayCountConvention +diffAct date1 date2 = assert (date1 <= date2) $ fromInteger (date2 `diffDays` date1) + +mkDiff30_360 :: (Integer,Int,Int) -> (Integer,Int,Int) -> Integer +mkDiff30_360 (y1,m1,d1) (y2,m2,d2) = 360*(y2-y1) + 30*(toInteger (m2-m1)) + toInteger (d2-d1) + +-- The un-corrected naked formular. + +diff30_360 :: DayCountConvention +diff30_360 date1 date2 = assert (date1 <= date2) $ mkDiff30_360 (toGregorian date1) (toGregorian date2) + +-- No month has more than 30 days, but February may have 28 or 29; i.e. +-- there are 32 days between 2003-02-28 and 2003-03-31. Commonly known +-- as "Deutsche Zinsmethode 30 / 360". + +diff30E_360 :: DayCountConvention +diff30E_360 date1 date2 = assert (date1 <= date2) $ mkDiff30_360 (y1, m1, min 30 d1) (y2, m2, min 30 d2) + where + (y1,m1,d1) = toGregorian date1 + (y2,m2,d2) = toGregorian date2 + +-- This variant additionally normalizes end-of-months to 30, i.e. there +-- are 30 days between 2003-02-28 and 2003-03-31. + +diff30E_360isda :: DayCountConvention +diff30E_360isda date1 date2 = assert (date1 <= date2) $ mkDiff30_360 (y1, m1, d1') (y2, m2, d2') + where + (y1,m1,d1) = toGregorian date1 + (y2,m2,d2) = toGregorian date2 + d1' = if d1 > 30 || d1 == gregorianMonthLength y1 m1 then 30 else d1 + d2' = if d1 > 30 || d2 == gregorianMonthLength y2 m2 then 30 else d2 diff --git a/Hledger/Interest/Rate.hs b/Hledger/Interest/Rate.hs new file mode 100644 --- /dev/null +++ b/Hledger/Interest/Rate.hs @@ -0,0 +1,60 @@ +module Hledger.Interest.Rate ( Rate, perAnno, constant, bgb288, ingDiba ) where + +import Data.Time.Calendar +import Data.Time.Calendar.OrdinalDate + +type Rate = Day -> (Day,Double) + +constant :: Double -> Rate +constant rate _ = (day 999999 12 31, rate) + +perAnno :: Double -> Rate +perAnno rate date = (day (fst (toOrdinalDate date)) 12 31, rate) + +day :: Integer -> Int -> Int -> Day +day = fromGregorian + +bgb288 :: Rate +bgb288 = basiszins (5/100) + +basiszins :: Double -> Rate +basiszins r date = (to, r + p) + where + (_,to,p) = head (dropWhile (\(_,to',_) -> to' < date) basiszinsTable) + +basiszinsTable :: [(Day, Day, Double)] +basiszinsTable = + [ (day 2002 01 01, day 2002 06 30, 257 / 10000) + , (day 2002 07 01, day 2002 12 31, 247 / 10000) + , (day 2003 01 01, day 2003 06 30, 197 / 10000) + , (day 2003 07 01, day 2003 12 31, 122 / 10000) + , (day 2004 01 01, day 2004 06 30, 114 / 10000) + , (day 2004 07 01, day 2004 12 31, 113 / 10000) + , (day 2005 01 01, day 2005 06 30, 121 / 10000) + , (day 2005 07 01, day 2005 12 31, 117 / 10000) + , (day 2006 01 01, day 2006 06 30, 137 / 10000) + , (day 2006 07 01, day 2006 12 31, 195 / 10000) + , (day 2007 01 01, day 2007 06 30, 270 / 10000) + , (day 2007 07 01, day 2007 12 31, 319 / 10000) + , (day 2008 01 01, day 2008 06 30, 332 / 10000) + , (day 2008 07 01, day 2008 12 31, 319 / 10000) + , (day 2009 01 01, day 2009 06 30, 162 / 10000) + , (day 2009 07 01, day 2009 12 31, 12 / 10000) + , (day 2010 01 01, day 2010 06 30, 12 / 10000) + , (day 2010 07 01, day 2010 12 31, 12 / 10000) + , (day 2011 01 01, day 2011 06 30, 12 / 10000) + , (day 2011 07 01, day 2999 12 31, 37 / 10000) + ] + +ingDiba :: Rate +ingDiba date = (to, p) + where + (_,to,p) = head (dropWhile (\(_,to',_) -> to' < date) ingDibaTable) + +ingDibaTable :: [(Day, Day, Double)] +ingDibaTable = + [ (day 2009 01 01, day 2009 12 31, 150 / 10000) + , (day 2010 01 01, day 2010 12 31, 150 / 10000) + , (day 2011 01 01, day 2011 07 14, 150 / 10000) + , (day 2011 07 15, day 2999 12 31, 175 / 10000) + ] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2011 Peter Simons +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Peter Simons nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,103 @@ +module Main ( main ) where + +import Hledger.Interest +import Hledger.Read + +import Control.Exception ( bracket ) +import Distribution.Text ( display ) +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO + +import Paths_hledger_interest ( version ) + +data Options = Options + { optVerbose :: Bool + , optShowVersion :: Bool + , optShowHelp :: Bool + , optInput :: FilePath + , optSourceAcc :: String + , optTargetAcc :: String + , optDCC :: Maybe DayCountConvention + , optRate :: Maybe Rate + , optBalanceToday :: Bool + } + +defaultOptions :: Options +defaultOptions = Options + { optVerbose = True + , optShowVersion = False + , optShowHelp = False + , optInput = "" + , optSourceAcc = "" + , optTargetAcc = "" + , optDCC = Nothing + , optRate = Nothing + , optBalanceToday = False + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['h'] ["help"] (NoArg (\o -> o { optShowHelp = True })) "print this message and exit" + , Option ['V'] ["version"] (NoArg (\o -> o { optShowVersion = True })) "show version number and exit" + , Option ['v'] ["verbose"] (NoArg (\o -> o { optVerbose = True })) "echo input ledger to stdout (default)" + , Option ['q'] ["quiet"] (NoArg (\o -> o { optVerbose = False })) "don't echo input ledger to stdout" + , Option [] ["today"] (NoArg (\o -> o { optBalanceToday = True })) "update account until today" + , Option ['f'] ["file"] (ReqArg (\f o -> o { optInput = f }) "FILE") "input ledger file" + , Option ['s'] ["source"] (ReqArg (\a o -> o { optSourceAcc = a }) "ACCOUNT") "interest source account" + , Option ['t'] ["target"] (ReqArg (\a o -> o { optTargetAcc = a }) "ACCOUNT") "interest target account" + , Option [] ["act"] (NoArg (\o -> o { optDCC = Just diffAct })) "use 'act' day counting convention" + , Option [] ["30-360"] (NoArg (\o -> o { optDCC = Just diff30_360 })) "use '30/360' day counting convention" + , Option [] ["30E-360"] (NoArg (\o -> o { optDCC = Just diff30E_360 })) "use '30E/360' day counting convention" + , Option [] ["30E-360isda"] (NoArg (\o -> o { optDCC = Just diff30E_360isda })) "use '30E/360isda' day counting convention" + , 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" + ] + +usageMessage :: String +usageMessage = usageInfo header options + where header = "Usage: hledger-interest [OPTION...] ACCOUNT" + +commandLineError :: String -> IO a +commandLineError err = do hPutStrLn stderr (err ++ usageMessage) + exitFailure + +parseOpts :: [String] -> IO (Options, [String]) +parseOpts argv = + case getOpt Permute options argv of + (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) + (_,_,errs) -> commandLineError (concat errs) + +main :: IO () +main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do + (opts, args) <- getArgs >>= parseOpts + when (optShowVersion opts) (putStrLn (display version) >> exitSuccess) + when (optShowHelp opts) (putStr usageMessage >> exitSuccess) + when (null (optInput opts)) (commandLineError "required --file option is missing\n") + when (null (optSourceAcc opts)) (commandLineError "required --source option is missing\n") + when (null (optTargetAcc opts)) (commandLineError "required --target option is missing\n") + when (isNothing (optDCC opts)) (commandLineError "no day counting convention specified\n") + when (isNothing (optRate opts)) (commandLineError "no interest rate specified\n") + when (length args /= 1) (commandLineError "required argument ACCOUNT is missing\n") + let [interestAcc] = args + Right jnl' <- readFile (optInput opts) >>= readJournal Nothing + let jnl = filterJournalTransactionsByAccount [interestAcc] jnl' + ts = sortBy (comparing tdate) (jtxns jnl) + cfg = Config + { interestAccount = interestAcc + , sourceAccount = optSourceAcc opts + , targetAccount = optTargetAcc opts + , dayCountConvention = fromJust (optDCC opts) + , interestRate = fromJust (optRate opts) + } + thisDay <- getCurrentDay + let finalize + | optBalanceToday opts = computeInterest thisDay + | otherwise = return () + ts' = runComputer cfg (mapM_ processTransaction ts >> finalize) + result + | optVerbose opts = ts ++ ts' + | otherwise = ts' + mapM_ (putStr . show) (sortBy (comparing tdate) result) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hledger-interest.cabal b/hledger-interest.cabal new file mode 100644 --- /dev/null +++ b/hledger-interest.cabal @@ -0,0 +1,117 @@ +Name: hledger-interest +Version: 1.0 +Synopsis: computes interest for a given account +License: BSD3 +License-file: LICENSE +Author: Peter Simons +Maintainer: Peter Simons +Homepage: http://github.com/peti/hledger-interest +Category: Finance +Build-type: Simple +Cabal-version: >= 1.6 +Description: + hledger-interest is a small command-line utility based on Simon + Michael's hleder library. Its purpose is to compute interest for a + given ledger account. Using command line flags, the program can be + configured to use various schemes for day-counting, such as act/act, + 30/360, 30E/360, and 30/360isda. Furthermore, it supports a (small) + number of interest schemes, i.e. annual interest with a fixed rate and + the scheme mandated by the German BGB288 (Basiszins für + Verbrauchergeschäfte). Extending support for other schemes is fairly + easy, but currently requires changing to the source code. + + As an example, consider the following loan, stored in a file called + @test.ledger@: + + > 2008/09/26 Loan + > Assets:Bank EUR 10000.00 + > Liabilities:Loan + > + > 2008/11/27 Payment + > Assets:Bank EUR -3771.12 + > Liabilities:Loan + > + > 2009/05/03 Payment + > Assets:Bank EUR -1200.00 + > Liabilities:Loan + > + > 2010/12/10 Payment + > Assets:Bank EUR -3700.00 + > Liabilities:Loan + + 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 + > 2008/09/26 Loan + > Assets:Bank EUR 10000.00 + > Liabilities:Loan + > + > 2008/11/27 Payment + > Assets:Bank EUR -3771.12 + > Liabilities:Loan + > + > 2008/11/27 5.00% interest for EUR -10000.00 over 61 days + > Liabilities:Loan EUR -84.72 + > Expenses:Interest + > + > 2008/12/31 5.00% interest for EUR -6313.60 over 34 days + > Liabilities:Loan EUR -29.81 + > Expenses:Interest + > + > 2009/05/03 Payment + > Assets:Bank EUR -1200.00 + > Liabilities:Loan + > + > 2009/05/03 5.00% interest for EUR -6343.42 over 123 days + > Liabilities:Loan EUR -108.37 + > Expenses:Interest + > + > 2009/12/31 5.00% interest for EUR -5251.78 over 238 days + > Liabilities:Loan EUR -173.60 + > Expenses:Interest + > + > 2010/12/10 Payment + > Assets:Bank EUR -3700.00 + > Liabilities:Loan + > + > 2010/12/10 5.00% interest for EUR -5425.38 over 340 days + > Liabilities:Loan EUR -256.20 + > Expenses:Interest + > + > 2010/12/31 5.00% interest for EUR -1981.58 over 21 days + > Liabilities:Loan EUR -5.78 + > Expenses:Interest + + Running the utility with @--help@ gives a brief overview over the + available options: + + > Usage: hledger-interest [OPTION...] ACCOUNT + > -h --help print this message and exit + > -V --version show version number and exit + > -v --verbose echo input ledger to stdout (default) + > -q --quiet don't echo input ledger to stdout + > --today update account until today + > -f FILE --file=FILE input ledger file + > -s ACCOUNT --source=ACCOUNT interest source account + > -t ACCOUNT --target=ACCOUNT interest target account + > --act use 'act' day counting convention + > --30-360 use '30/360' day counting convention + > --30E-360 use '30E/360' day counting convention + > --30E-360isda use '30E/360isda' day counting convention + > --constant=RATE constant interest rate + > --annual=RATE annual interest rate + > --bgb288 compute interest according to German BGB288 + +Source-Repository head + Type: git + Location: git://github.com/peti/hledger-interest.git + +Executable hledger-interest + Main-is: Main.hs + Build-depends: base >= 3 && < 5, hledger-lib >= 0.14, time, mtl, Cabal + other-modules: Hledger.Interest + Hledger.Interest.DayCountConvention + Hledger.Interest.Rate + Ghc-Options: -Wall