diff --git a/UMM.cabal b/UMM.cabal --- a/UMM.cabal +++ b/UMM.cabal @@ -1,5 +1,5 @@ Name: UMM -Version: 0.1.6 +Version: 0.2.0 Homepage: http://www.korgwal.com/umm/ Author: Uwe Hollerbach Maintainer: Uwe Hollerbach diff --git a/UMM.hs b/UMM.hs --- a/UMM.hs +++ b/UMM.hs @@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMM.hs,v 1.57 2010/01/17 00:13:47 uwe Exp $ -} +$Id: UMM.hs,v 1.58 2010/05/02 06:53:12 uwe Exp $ -} module Main where import Prelude hiding (putStr,putStrLn,print,readFile,getContents) @@ -59,8 +59,10 @@ -- Merge explicit (ps) and implicit (qs) prices: the inputs are sorted -- by date, newest first, and the output is the same, preferring -- explicit over implicit prices in case of a date match. +-- For transactions, the inputs are sorted the other way: oldest first -mergePrices :: [Record] -> [Record] -> [Record] +mergePrices, mergeTrans :: [Record] -> [Record] -> [Record] + mergePrices [] qs = qs mergePrices ps [] = ps mergePrices pa@(p:ps) qa@(q:qs) = @@ -68,6 +70,13 @@ then q : mergePrices pa qs else p : mergePrices ps qa +mergeTrans [] qs = qs +mergeTrans ps [] = ps +mergeTrans pa@(p:ps) qa@(q:qs) = + if cmpRecDate p q == LT + then p : mergeTrans ps qa + else q : mergeTrans pa qs + -- Get the base currency for a given CCS, which may be itself getBaseCurrency :: Name -> Name -> [Record] -> Name @@ -227,13 +236,15 @@ main = do (file, action) <- processArgs recs <- getLines file >>= mapM (return . parseURecord) >>= validateRecs - let (dc, cb, c1, incs, exps, a1, grps, trans, p1) = classifyRecs recs + let (dc, cb, c1, incs, exps, a1, grps, tr1, per, pr1) = classifyRecs recs cd <- validateCCS dc cb c1 let ccs = cb ++ cd accts <- validateAccts dc ccs a1 - validateTransPrices ccs incs exps accts (trans ++ p1) - let p2 = generateImplicitPrices dc trans cd - prices = mergePrices (reverse p1) p2 + validateTransPrices ccs incs exps accts (tr1 ++ per ++ pr1) + let tr2 = expandRecurringTrans per + trans = mergeTrans tr1 tr2 + pr2 = generateImplicitPrices dc trans cd + prices = mergePrices (reverse pr1) pr2 pse r = putStrLn (showExp r) >> putStrLn "" case action of ChangeCmd verbose name date1 date2 -> diff --git a/UMMData.hs b/UMMData.hs --- a/UMMData.hs +++ b/UMMData.hs @@ -16,16 +16,18 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMData.hs,v 1.49 2010/01/02 22:33:34 uwe Exp $ -} +$Id: UMMData.hs,v 1.50 2010/05/02 00:37:25 uwe Exp $ -} module UMMData (Name(..), Date(..), Amount(..), startTime, Command(..), CmdOpt(..), Record(..), genDate, getRecDate, cmpRecDate, getRecName, cmpRecName, Ledger(..), runLedger, getResult, getInfo, getErrs, recordInfo, recordErr, recordNil, showExp, BSE(..), - CCSAmt(..), cmpCCSAmtName, eqCCSAmtName, AccountData, - noName, todoName, joinDrop, roundP, isLeap, validDate, - trimspace, mylines, mergelines, uniqAdjBy, uniqAdj) where + Period(..), CCSAmt(..), cmpCCSAmtName, eqCCSAmtName, + AccountData, noName, todoName, joinDrop, roundP, isLeap, + validDate, julianDate, gregorianDate, offsetDate, + previousDate, nextDate, trimspace, mylines, mergelines, + uniqAdjBy, uniqAdj) where import Prelude import Data.Char import Data.List @@ -171,6 +173,28 @@ show S = "sell" show E = "exch" +data Period = PSW | PSM | PND Int | PNW Int | PNM Int | PNY Int deriving (Eq) + +instance Show Period where + show PSW = "semiweekly" -- twice per week: N, N + 3, N + 7, ... + show PSM = "semimonthly" -- twice per month: N, N +- 15 days + show (PND n) | n == 1 = "daily" + | n == 7 = "weekly" + | n == 14 = "biweekly" + | otherwise = show n ++ " days" + show (PNW n) | n == 1 = "weekly" + | n == 2 = "biweekly" + | otherwise = show n ++ " weeks" + show (PNM n) | n == 1 = "monthly" + | n == 2 = "bimonthly" + | n == 3 = "quarterly" + | n == 6 = "semiannually" + | n == 12 = "annually" + | otherwise = show n ++ " months" + show (PNY n) | n == 1 = "annually" + | n == 2 = "biannually" + | otherwise = show n ++ " years" + data Record = CCSRec Name String (Maybe Amount) Name | IncomeRec Name String | ExpenseRec Name String @@ -183,6 +207,7 @@ | CommentRec String | ToDoRec Date Bool String | ErrorRec String + | RecurRec Period Date Date Record instance Show Record where show = showR @@ -235,6 +260,11 @@ showR (ErrorRec str) = joinDrop ["#err", str] +showR (RecurRec p dl dr r) = + joinDrop ["recurring", show p, "until", show dl, + if dr == startTime then "" else "reconciled " ++ show dr, + "\\\n \\", show r] + showTos :: [(Name, CCSAmt)] -> String showTos [] = "{}" showTos (t:[]) = showTo1 False t @@ -274,6 +304,7 @@ getRecDate (ExchRec _ d _ _ _ _ _) = d getRecDate (SplitRec d _ _ _) = d getRecDate (ToDoRec d _ _) = d +getRecDate (RecurRec _ _ _ r) = getRecDate r getRecDate _ = startTime -- so it works for every Record -- Get the name (or at any rate /some/ name) from a Record @@ -376,6 +407,51 @@ let lim = [ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ] !! m in (m >= 1 && m <= 12 && d >= 1 && (d <= lim || m == 2 && isLeap y && d <= 29)) + +-- This returns an integer which is the Julian day number at noon + eps, ie, +-- an instant after it has incremented to a new (Julian) day. Inputs are +-- 4-digit (or whatever is appropriate) year, month from 1 to 12, day from +-- 1 to 28/31 as appropriate. +-- +-- Jan 1 2000 = 2451545 + +julianDate :: Date -> Int +julianDate (Date y m d) = + let a = quot (14 - m) 12 + y1 = y + 4800 - a + m1 = m + 12*a - 3 + in d + quot (153*m1 + 2) 5 + 365*y1 + quot y1 4 + + quot y1 400 - quot y1 100 - 32045 + +-- This returns astronomical years for dates before 1 AD: the year before +-- that is year 0, not 1 BC, etc. For years after 1 AD, this returns +-- proleptic Gregorian dates. Taken & hacked up from FORTRAN routine from US +-- Naval Observatory website + +gregorianDate :: Int -> Date +gregorianDate j = + let l1 = j + 68569 + n = quot (4*l1) 146097 + l2 = l1 - quot (146097*n + 3) 4 + i1 = quot (4000*(l2+1)) 1461001 + l3 = l2 + 31 - quot (1461*i1) 4 + j1 = quot (80*l3) 2447 + d = l3 - quot (2447*j1) 80 + l4 = quot j1 11 + m = j1 + 2 - 12*l4 + y = 100*(n - 49) + i1 + l4 + in Date y m d + +-- This returns the date offset by n days from the given date + +offsetDate :: Date -> Int -> Date +offsetDate d n = gregorianDate (n + julianDate d) + +-- These return the previous & next date from the given date + +previousDate, nextDate :: Date -> Date +previousDate d = offsetDate d (-1) +nextDate d = offsetDate d 1 -- Remove leading and trailing whitespace from a string. diff --git a/UMMEval.hs b/UMMEval.hs --- a/UMMEval.hs +++ b/UMMEval.hs @@ -16,11 +16,11 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMEval.hs,v 1.37 2010/01/03 06:02:32 uwe Exp $ -} +$Id: UMMEval.hs,v 1.40 2010/05/02 06:53:12 uwe Exp $ -} module UMMEval (validateRecs, validateCCS, validateAccts, classifyRecs, validateTransPrices, generateImplicitPrices, getBalances, - getPrices) where + getPrices, expandRecurringTrans) where import Prelude hiding (putStr,putStrLn,print) import Data.List import Data.Maybe @@ -109,22 +109,24 @@ -- separately (or just account groups, right now) classifyRecs :: [Record] -> (Name, [Record], [Record], [Record], [Record], - [Record], [Record], [Record], [Record]) -classifyRecs recs = cw recs [] [] [] [] [] [] [] - where cw [] c i e a g t p = + [Record], [Record], [Record], [Record], [Record]) +classifyRecs rs = cw rs [] [] [] [] [] [] [] [] + where cw [] c i e a g t p r = let dc = if null c then Name "zorkmid" else getRecName (last c) (cb, cd) = partition isB (vsN c) - in (dc, cb, cd, vsN i, vsN e, reverse a, vsN g, asD dc t, asD dc p) - cw (r:rs) c i e a g t p = - case r of - CommentRec _ -> cw rs c i e a g t p - CCSRec _ _ _ _ -> cw rs (r:c) i e a g t p - IncomeRec _ _ -> cw rs c (r:i) e a g t p - ExpenseRec _ _ -> cw rs c i (r:e) a g t p - AccountRec _ _ _ _ -> cw rs c i e (r:a) g t p - GroupRec _ _ -> cw rs c i e a (r:g) t p - PriceRec _ _ _ _ -> cw rs c i e a g t (r:p) - _ -> cw rs c i e a g (r:t) p + in (dc, cb, cd, vsN i, vsN e, reverse a, vsN g, + asD dc t, asD dc r, asD dc p) + cw (rec:recs) c i e a g t p r = + case rec of + CommentRec _ -> cw recs c i e a g t p r + CCSRec _ _ _ _ -> cw recs (rec:c) i e a g t p r + IncomeRec _ _ -> cw recs c (rec:i) e a g t p r + ExpenseRec _ _ -> cw recs c i (rec:e) a g t p r + AccountRec _ _ _ _ -> cw recs c i e (rec:a) g t p r + GroupRec _ _ -> cw recs c i e a (rec:g) t p r + PriceRec _ _ _ _ -> cw recs c i e a g t (rec:p) r + RecurRec _ _ _ _ -> cw recs c i e a g t p (rec:r) + _ -> cw recs c i e a g (rec:t) p r vsN = uChk . sortBy cmpRecName uChk vs = if uniqAdjBy (\v1 v2 -> cmpRecName v1 v2 == EQ) vs then vs @@ -137,6 +139,7 @@ XferRec d f from (map (addDCCAt dc) tos) m c addDC dc (ExchRec t d f acc ccsa1 ccsa2 m) = ExchRec t d f acc (addDCCA dc ccsa1) (addDCCA dc ccsa2) m + addDC dc (RecurRec p dl dr r) = RecurRec p dl dr (addDC dc r) addDC _ r = r addDCCAt d (n,a) = (n, addDCCA d a) isB (CCSRec _ _ ma nb) = isNothing ma && nb == noName @@ -163,6 +166,7 @@ chk (ExchRec _ _ _ a (CCSAmt c1 _) (CCSAmt c2 _) _) = notIn a accts || notIn c1 ccs || notIn c2 ccs chk (ToDoRec _ _ _) = False + chk (RecurRec _ _ _ r) = chk r chk _ = True chkTo (to, CCSAmt n _) = (notIn to exps && notIn to accts) || notIn n ccs @@ -224,34 +228,33 @@ qq = getCA q in if qn == dn then CCSAmt qn (Amount (qq * dq)) else q -maybeRecord :: Bool -> Maybe Name -> Record -> AccountData -> (Name -> Bool) -> +maybeRecord :: Maybe Name -> Record -> AccountData -> (Name -> Bool) -> Ledger e (Record, [CCSAmt]) () -maybeRecord rt reg record newaccs tst = +maybeRecord reg record newaccs tst = let isJ = isJust reg rn = fromJust reg acc = filter (\a -> fst a == rn) newaccs nb = if null acc then [CCSAmt noName (Amount 0)] else snd (head acc) - in if rt && isJ && (tst rn || rn == noName) + in if isJ && (tst rn || rn == noName) then recordInfo (record, nb) else recordNil -maybeDo :: Bool -> Maybe Name -> Bool -> Record -> Bool -> +maybeDo :: Maybe Name -> Bool -> Record -> Bool -> AccountData -> AccountData -> (Name -> Bool) -> Ledger e (Record, [CCSAmt]) AccountData -maybeDo rt reg dorec record isrec accs newaccs tst = +maybeDo reg dorec record isrec accs newaccs tst = if dorec then if isrec then return newaccs - else maybeRecord rt reg record newaccs tst >> return accs - else maybeRecord rt reg record newaccs tst >> return newaccs + else maybeRecord reg record newaccs tst >> return accs + else maybeRecord reg record newaccs tst >> return newaccs exchTrans :: Maybe Name -> Bool -> Record -> AccountData -> Ledger e (Record, [CCSAmt]) AccountData exchTrans reg dorec record@(ExchRec _ _ isrec acc amtn amto _) accs = - maybeDo True reg dorec record isrec accs - (doExch accs acc amtn amto) (== acc) + maybeDo reg dorec record isrec accs (doExch accs acc amtn amto) (== acc) where doExch [] _ _ _ = [] doExch ((an,ab):as) n en eo = if an == n @@ -259,18 +262,13 @@ else (an,ab) : doExch as n en eo exchTrans _ _ r _ = intErr "exchTrans" r --- TODO: alternately, we could have '(xfer1 (not dorec))' in the --- foldM, that would cause register displays to be shown once for each --- sub-transaction, but reconciliation displays would show the entire --- transaction only once - xferTrans :: Maybe Name -> Bool -> Record -> AccountData -> Ledger e (Record, [CCSAmt]) AccountData xferTrans reg dorec record@(XferRec _ isrec from tos _ _) accs = foldM (xfer1 False) accs (init tos) >>= (\a -> xfer1 True a (last tos)) - where xfer1 rf as (to,amt) = maybeDo rf reg dorec record isrec as - (doXfer as from to amt) - (\rn -> rn == from || rn == to) + where xfer1 rf as (to,amt) = + maybeDo reg dorec record isrec as (doXfer as from to amt) + (\rn -> (rf && rn == from) || rn == to) doXfer [] _ _ _ = [] doXfer (a@(an,ab):as) nf nt e | an == nf = (an, subFrom ab e) : doXfer as nf nt e @@ -287,7 +285,7 @@ Ledger e (Record, [CCSAmt]) AccountData splitTrans reg record@(SplitRec _ ccs (Amount an) (Amount ao)) acc = let newaccs = map doST acc - in maybeRecord True reg record newaccs (const True) >> return newaccs + in maybeRecord reg record newaccs (const True) >> return newaccs where doST (a1,a2) = (a1, scaleBy a2 (CCSAmt ccs (Amount (an/ao)))) splitTrans _ r _ = intErr "splitTrans" r @@ -295,7 +293,7 @@ -- new version with printing of initial values mkInit reg as = let iaccs = (map (\a -> (getRecName a, maybeToList (gI a))) as) - in maybeRecord True reg (CommentRec "") iaccs (const True) >> return iaccs + in maybeRecord reg (CommentRec "") iaccs (const True) >> return iaccs where gI (AccountRec _ _ _ mi) = mi gI r = intErr "mkInit" r -} @@ -357,3 +355,40 @@ else get ps get _ = recordNil doShow t p = putStrLn t >> mapM_ print (reverse p) + +-- Convert a list of RecurRec records into equivalent list +-- of individual transactions, sorted by date + +expandRecurringTrans :: [Record] -> [Record] +expandRecurringTrans rs = sortBy cmpRecDate (concatMap eRT rs) + where eRT (RecurRec (PND n) dl dr rec) = + map (mRD rec dr) (genD (getRecDate rec) n dl) + eRT (RecurRec (PNW n) dl dr rec) = + map (mRD rec dr) (genD (getRecDate rec) (7*n) dl) + eRT (RecurRec PSW dl dr rec) = + let da = getRecDate rec + db = offsetDate da 3 + mf = map (mRD rec dr) + in mf (genD da 7 dl) ++ mf (genD db 7 dl) + eRT (RecurRec (PNM n) dl dr rec) = + map (mRD rec dr) (genM (getRecDate rec) n dl) + eRT (RecurRec (PNY n) dl dr rec) = + map (mRD rec dr) (genM (getRecDate rec) (12*n) dl) + eRT (RecurRec PSM dl dr rec) = + let da = getRecDate rec + db = offsetDate da 15 + mf = map (mRD rec dr) + in mf (genM da 1 dl) ++ mf (genM db 1 dl) + eRT rec = intErr "expandRecurringTrans" rec + genD d1 dd d2 = + let j = julianDate d1 + in map gregorianDate [j, j + dd .. julianDate d2] + genM d1 dm d2 = if d1 <= d2 then d1 : genM (oMo d1 dm) dm d2 else [] + oMo (Date y m d) mstep = + let (dy,m1) = divMod (mstep + m - 1) 12 + in Date (y + dy) (m1 + 1) d + mRD (XferRec _ _ f t m i) dr dc = + XferRec dc (dc <= dr) f t m i + mRD (ExchRec t _ _ a c1 c2 m) dr dc = + ExchRec t dc (dc <= dr) a c1 c2 m + mRD r _ _ = intErr "expandRecurringTrans" r diff --git a/UMMHelp.hs b/UMMHelp.hs --- a/UMMHelp.hs +++ b/UMMHelp.hs @@ -16,13 +16,13 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMHelp.hs,v 1.34 2010/01/19 04:02:20 uwe Exp $ -} +$Id: UMMHelp.hs,v 1.37 2010/05/02 21:32:50 uwe Exp $ -} module UMMHelp (writeHdr, usageMsg) where import Prelude version :: String -version = "0.1.6" +version = "0.2.0" writeHdr :: String writeHdr = @@ -130,10 +130,10 @@ " 'price' date [amount1] name1 amount2 [name2]\n" ++ " 'split' date name amount1 amount2\n" ++ " 'todo' [rec] date text\n" ++ - " 'xfer' [rec] date name1 name2 amount [name] [desc] [id]\n" ++ - " 'xfer' [rec] date name1 {name2 amount [name],\\\n" ++ + " [period] 'xfer' [rec] date name1 name2 amount [name] [desc] [id]\n" ++ + " [period] 'xfer' [rec] date name1 {name2 amount [name],\\\n" ++ " \\ name3 amount [name], ...} [desc] [id]\n" ++ - " 'exch' [rec] date name amount1 name1 amount2 [name2] [desc]\n" ++ + " [period] 'exch' [rec] date name amount1 name1 amount2 [name2] [desc]\n" ++ "\n" ++ "There are also 'buy' and 'sell' records which are just\n" ++ "syntactic sugar for 'exch'; see more details below in the\n" ++ @@ -247,7 +247,7 @@ " split 2000-5-8 GE 15/7 5/7\n" ++ "\n" ++ "\n" ++ - "* 'xfer [rec] date name1 name2 amount [name] [desc] [id]'\n" ++ + "* '[period] xfer [rec] date name1 name2 amount [name] [desc] [id]'\n" ++ " records are used to transfer 'amount' of 'name' from account\n" ++ " 'name1' to account 'name2'; 'name1' may be either an account\n" ++ " specified by an 'account' record, or a source specified by\n" ++ @@ -275,9 +275,11 @@ " The second form of the 'xfer' record allows specification of\n" ++ " multiple transfers as one logical transaction.\n" ++ "\n" ++ + " For details on the optional [period] prefix, see below.\n" ++ "\n" ++ - "* 'exch [rec] date name amount1 name1 amount2 [name2] [desc]'\n" ++ - " records and their aliases 'buy and 'sell' are used to trade\n" ++ + "\n" ++ + "* '[period] exch [rec] date name amount1 name1 amount2 [name2] [desc]'\n" ++ + " records and their aliases 'buy' and 'sell' are used to trade\n" ++ " some amount of one ccs for another. To some extent, these\n" ++ " are syntactic sugar: the same could be accomplished with a\n" ++ " pair of 'xfer' records, but this is a little clearer and\n" ++ @@ -310,7 +312,9 @@ " exch 2009/10/2 brokerage 3.959 VTSMX 100 US$\n" ++ " exch 2009/10/2 brokerage 100 US$ 3.959 VTSMX\n" ++ "\n" ++ + " Again, for details on the optional [period] prefix, see below.\n" ++ "\n" ++ + "\n" ++ "* 'todo [rec] date text' is basically a sticky note in the\n" ++ " ledger. If the record is not marked as reconciled, and the\n" ++ " date falls within the range of the command being executed,\n" ++ @@ -372,4 +376,30 @@ "\n" ++ "\n" ++ "* 'id' (in an 'xfer' record) is a sequence of digits: a\n" ++ - " check number or other identifying number.\n" + " check number or other identifying number.\n" ++ + "\n" ++ + "\n" ++ + "* 'period' is an optional prefix of 'xfer' and 'exch' records:\n" ++ + " it specifies that this is a periodic transaction. It has the\n" ++ + " format\n" ++ + "\n" ++ + " recurring interval until end-date [reconciled rec-date]\n" ++ + "\n" ++ + " where 'recurring', 'until', and 'reconciled' are literal keywords,\n" ++ + " end-date and rec-date are dates in the usual format described above,\n" ++ + " and interval specifies how far apart the repetitions are: interval\n" ++ + " may be any one of the literal keywords 'daily', 'weekly', 'monthly',\n" ++ + " 'quarterly', 'annually', 'biweekly', 'bimonthly', 'biannually',\n" ++ + " 'semiweekly', 'semimonthly', or 'semiannually', or an integer\n" ++ + " followed by one of the literal keywords 'days', 'weeks', 'months',\n" ++ + " or 'years'. For example\n" ++ + "\n" ++ + " recurring monthly until 2010-12-31 \\\n" ++ + " \\ xfer 2009-2-27 interest abc:savings 0.01\n" ++ + "\n" ++ + " is a monthly interest payment into abc:savings, occurring on\n" ++ + " the 27th of each month from February 2009 until December 2010.\n" ++ + "\n" ++ + " The reconciled keyword and rec-date are themselves optional.\n" ++ + " If present, they indicate that instances of this record before\n" ++ + " the rec-date are reconciled.\n" diff --git a/UMMParser.hs b/UMMParser.hs --- a/UMMParser.hs +++ b/UMMParser.hs @@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMParser.hs,v 1.42 2010/01/02 22:33:34 uwe Exp $ -} +$Id: UMMParser.hs,v 1.43 2010/05/02 00:37:26 uwe Exp $ -} -- TODO: template := @@ -28,6 +28,9 @@ import UMMData +intErr :: String -> o +intErr loc = error ("internal error at " ++ loc ++ ", please report this") + readInt :: String -> Integer readInt s = foldl ma 0 s where ma v1 v2 = 10*v1 + toInteger (digitToInt v2) @@ -212,13 +215,39 @@ parseReconcile = option False (TPCP.try (many space >> oneOf "*!" >> return True)) -intErr :: String -> o -intErr loc = error ("internal error at " ++ loc ++ ", please report this") +parsePeriod :: Parser Period +parsePeriod = + spaces >> (pPG <|> + pPS "daily" (PND 1) <|> + pPS "weekly" (PNW 1) <|> + pPS "monthly" (PNM 1) <|> + pPS "quarterly" (PNM 3) <|> + pPS "annually" (PNY 1) <|> + TPCP.try (pPS "biweekly" (PNW 2)) <|> + TPCP.try (pPS "bimonthly" (PNM 2)) <|> + pPS "biannually" (PNY 2) <|> + TPCP.try (pPS "semiweekly" PSW) <|> + TPCP.try (pPS "semimonthly" PSM) <|> + pPS "semiannually" (PNM 6)) + where pPS s p = string s >> return p + pPG = do n <- parseInt + spaces + p <- parsePrefixOf 1 "days" <|> + parsePrefixOf 1 "weeks" <|> + parsePrefixOf 1 "months" <|> + parsePrefixOf 1 "years" + let ni = fromInteger n + return (case p of + "days" -> PND ni + "weeks" -> PNW ni + "months" -> PNM ni + "years" -> PNY ni + _ -> intErr "parsePeriod") -- The top-level record parsers -parseCCS, parseIE, parseAccount, parseGroup, parsePrice, parseXfer, - parseEBS, parseSplit, parseTodo, parseComment, parseBlank, parseRecord :: +parseCCS, parseIE, parseAccount, parseGroup, parsePrice, parseXfer, parseEBS, + parseSplit, parseTodo, parseRecur, parseComment, parseBlank, parseRecord :: Parser Record parseCCS = @@ -314,6 +343,19 @@ comment <- many anyChar return (CommentRec (trimspace comment)) +parseRecur = + do string "recurring" + period <- parsePeriod + spaces -- TODO: keep this syntactic sugar? + string "until" -- it kinda reads better...? + dl <- parseDate + spaces + dr <- option startTime + (TPCP.try (parsePrefixOf 3 "reconciled" >> parseDate)) + many space + record <- parseEBS <|> parseXfer + return (RecurRec period dl dr record) + parseBlank = many space >> return (CommentRec "") parseRecord = @@ -327,6 +369,7 @@ <|> parseTodo <|> parseAccount <|> parseGroup + <|> parseRecur <|> parseComment <|> parseBlank -- this must be last, as it can match nothing many space