UMM 0.1.6 → 0.2.0
raw patch · 6 files changed
+255/−60 lines, 6 files
Files
- UMM.cabal +1/−1
- UMM.hs +17/−6
- UMMData.hs +80/−4
- UMMEval.hs +70/−35
- UMMHelp.hs +39/−9
- UMMParser.hs +48/−5
UMM.cabal view
@@ -1,5 +1,5 @@ Name: UMM-Version: 0.1.6+Version: 0.2.0 Homepage: http://www.korgwal.com/umm/ Author: Uwe Hollerbach <uh@alumni.caltech.edu> Maintainer: Uwe Hollerbach <uh@alumni.caltech.edu>
UMM.hs view
@@ -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 ->
UMMData.hs view
@@ -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.
UMMEval.hs view
@@ -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
UMMHelp.hs view
@@ -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"
UMMParser.hs view
@@ -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 := <to be determined> @@ -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