hledger-interest (empty) → 1.0
raw patch · 7 files changed
+473/−0 lines, 7 filesdep +Cabaldep +basedep +hledger-libsetup-changed
Dependencies added: Cabal, base, hledger-lib, mtl, time
Files
- Hledger/Interest.hs +117/−0
- Hledger/Interest/DayCountConvention.hs +45/−0
- Hledger/Interest/Rate.hs +60/−0
- LICENSE +29/−0
- Main.hs +103/−0
- Setup.hs +2/−0
- hledger-interest.cabal +117/−0
+ Hledger/Interest.hs view
@@ -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 ""
+ Hledger/Interest/DayCountConvention.hs view
@@ -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
+ Hledger/Interest/Rate.hs view
@@ -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)+ ]
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2011 Peter Simons <simons@cryp.to>+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.
+ Main.hs view
@@ -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)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hledger-interest.cabal view
@@ -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 <simons@cryp.to>+Maintainer: Peter Simons <simons@cryp.to>+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