UMM 0.2.0 → 0.2.1
raw patch · 6 files changed
+369/−295 lines, 6 files
Files
- UMM.cabal +1/−1
- UMM.hs +5/−4
- UMMData.hs +49/−36
- UMMEval.hs +27/−16
- UMMHelp.hs +194/−195
- UMMParser.hs +93/−43
UMM.cabal view
@@ -1,5 +1,5 @@ Name: UMM-Version: 0.2.0+Version: 0.2.1 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.58 2010/05/02 06:53:12 uwe Exp $ -}+$Id: UMM.hs,v 1.61 2010/05/09 06:24:43 uwe Exp $ -} module Main where import Prelude hiding (putStr,putStrLn,print,readFile,getContents)@@ -229,7 +229,7 @@ where hC (_, CCSAmt n _) = c == n hasCur c (ExchRec _ _ _ _ (CCSAmt n1 _) (CCSAmt n2 _) _) = c == n1 || c == n2 hasCur c (SplitRec _ n1 _ _) = c == n1-hasCur _ (ToDoRec _ _ _) = False+hasCur _ (NoteRec _ _ _ _) = False hasCur _ r = error ("internal error at hasCur! got " ++ show r) main :: IO ()@@ -258,13 +258,14 @@ ExportCmd -> mapM_ pse trans >> mapM_ pse (reverse prices) ListDataCmd w -> doList w dc ccs accts grps incs exps- PriceCmd name date ->+ PriceCmd name date1 date2 -> if elem name (map getRecName cb) then putStrLn (show name ++ " is a base CCS!") else let crec = find (\r -> getRecName r == name) cd in if isNothing crec then putStrLn ("Error! unknown CCS " ++ show name)- else getPrices name (getNB (fromJust crec)) date prices+ else getPrices name (getNB (fromJust crec))+ date1 date2 prices RegisterCmd name date1 date2 -> doRegister date1 date2 name dc ccs accts trans prices False ReconcileCmd name date ->
UMMData.hs view
@@ -16,18 +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.50 2010/05/02 00:37:25 uwe Exp $ -}+$Id: UMMData.hs,v 1.54 2010/05/09 06:24:44 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(..),- Period(..), CCSAmt(..), cmpCCSAmtName, eqCCSAmtName,- AccountData, noName, todoName, joinDrop, roundP, isLeap,- validDate, julianDate, gregorianDate, offsetDate,- previousDate, nextDate, trimspace, mylines, mergelines,- uniqAdjBy, uniqAdj) where+ SN(..), 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@@ -143,14 +143,15 @@ | BasisCmd Name Date | RegisterCmd Name Date Date | ReconcileCmd Name Date- | PriceCmd Name Date+ | PriceCmd Name Date Date | ChangeCmd Bool Name Date Date | ExportCmd instance Show Command where show (ListDataCmd opt) = joinDrop ["list", show opt] show (ToDoCmd date) = joinDrop ["todo", show date]- show (PriceCmd name date) = joinDrop ["price", show name, show date]+ show (PriceCmd name date1 date2) =+ joinDrop ["price", show name, show date1, show date2] show (BalanceCmd name date) = joinDrop ["balance", show name, show date] show (BasisCmd name date) = joinDrop ["basis", show name, show date] show (RegisterCmd name date1 date2) =@@ -166,34 +167,38 @@ -- that makes the code simple, but the user can enter "buy" or "sell", -- and it seems only polite to echo that back on output. -data BSE = B | S | E deriving (Eq)+data BSE = BSE_B | BSE_S | BSE_E deriving (Eq) instance Show BSE where- show B = "buy"- show S = "sell"- show E = "exch"+ show BSE_B = "buy"+ show BSE_S = "sell"+ show BSE_E = "exch" -data Period = PSW | PSM | PND Int | PNW Int | PNM Int | PNY Int deriving (Eq)+data SN = SN_T | SN_A | SN_B deriving (Eq) +instance Show SN where+ show SN_T = "todo"+ show SN_A = "anniversary"+ show SN_B = "birthday"++data Period = PSW | PSM | PND Int | PNM 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"+ show (PND n) | n == 1 = "daily"+ | n == 7 = "weekly"+ | n == 14 = "biweekly"+ | mod n 7 == 0 = show (div n 7) ++ "weeks"+ | otherwise = show n ++ " days"+ show (PNM n) | n == 1 = "monthly"+ | n == 2 = "bimonthly"+ | n == 3 = "quarterly"+ | n == 6 = "semiannually"+ | n == 12 = "annually"+ | n == 24 = "biannually"+ | mod n 12 == 0 = show (div n 12) ++ "years"+ | otherwise = show n ++ " months" data Record = CCSRec Name String (Maybe Amount) Name | IncomeRec Name String@@ -205,9 +210,9 @@ | ExchRec BSE Date Bool Name CCSAmt CCSAmt String | SplitRec Date Name Amount Amount | CommentRec String- | ToDoRec Date Bool String | ErrorRec String | RecurRec Period Date Date Record+ | NoteRec Date Bool SN String instance Show Record where show = showR@@ -247,7 +252,7 @@ joinDrop ["xfer", shRec r, show d, show from, showTos tos, optStr m, i] showR (ExchRec t d r a c1 c2 memo) =- let hs = if t == S then [show c2, show c1] else [show c1, show c2]+ let hs = if t == BSE_S then [show c2, show c1] else [show c1, show c2] in joinDrop ([show t, shRec r, show d, show a] ++ hs ++ [optStr memo]) showR (SplitRec d n a1 a2) =@@ -255,9 +260,13 @@ showR (CommentRec c) = shIf (c /= "") (joinDrop ["#", c]) -showR (ToDoRec d r memo) =+showR (NoteRec d r SN_T memo) = joinDrop ["todo", shRec r, show d, shDef memo "something! but what?"] +showR (NoteRec (Date _ m d) r t memo) =+ joinDrop [show t, shRec r, show m ++ "/" ++ show d,+ shDef memo "some important anniversary! but what?"]+ showR (ErrorRec str) = joinDrop ["#err", str] showR (RecurRec p dl dr r) =@@ -291,8 +300,8 @@ joinDrop ["P", show d, show n1, ' ' : show (CCSAmt n2 (Amount (roundP 4 (a2/a1))))] -showExp (SplitRec _ _ _ _) = "# Split to be implemented"-showExp r@(ToDoRec _ _ _) = "# " ++ showR r+showExp (SplitRec _ _ _ _) = "# Split to be implemented"+showExp r@(NoteRec _ _ _ _) = "# " ++ showR r showExp r = error ("internal error at showExp! got " ++ show r) -- Get the date (or at any rate /some/ date) from a Record@@ -303,7 +312,8 @@ getRecDate (XferRec d _ _ _ _ _) = d getRecDate (ExchRec _ d _ _ _ _ _) = d getRecDate (SplitRec d _ _ _) = d-getRecDate (ToDoRec d _ _) = d+getRecDate (NoteRec d _ SN_T _) = d+getRecDate (NoteRec d _ _ _) = offsetDate d (-7) getRecDate (RecurRec _ _ _ r) = getRecDate r getRecDate _ = startTime -- so it works for every Record @@ -476,17 +486,20 @@ -- and the two lines joined. In conjunction with the trimspace aspect of -- mylines, above, this pretty much replicates the haskell way. -isL, isF :: String -> Bool+isL, isF, isC :: String -> Bool isL s = not (null s) && last s == '\\' isF s = not (null s) && head s == '\\'+isC s = not (null s) && (head s == '#' || head s == ';') mergelines :: [String] -> [String] mergelines [] = [] mergelines (h:[])+ | isC h = [h] | isL h || isF h = error ("mergelines: partial line " ++ h) | otherwise = [h] mergelines (h:t:ts) | isL h && isF t = mergelines ((init h ++ tail t):ts)+ | isC h = h : mergelines (t:ts) | isL h || isF h = error ("mergelines: partial line " ++ h) | otherwise = h : mergelines (t:ts)
UMMEval.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: UMMEval.hs,v 1.40 2010/05/02 06:53:12 uwe Exp $ -}+$Id: UMMEval.hs,v 1.44 2010/05/10 04:06:46 uwe Exp $ -} module UMMEval (validateRecs, validateCCS, validateAccts, classifyRecs, validateTransPrices, generateImplicitPrices, getBalances,@@ -112,8 +112,11 @@ [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)+ let c1 = if null c+ then [CCSRec (Name "zorkmid") "" Nothing noName]+ else c+ dc = getRecName (last c1)+ (cb, cd) = partition isB (vsN c1) 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 =@@ -165,7 +168,7 @@ (notIn from incs && notIn from accts) || any chkTo tos chk (ExchRec _ _ _ a (CCSAmt c1 _) (CCSAmt c2 _) _) = notIn a accts || notIn c1 ccs || notIn c2 ccs- chk (ToDoRec _ _ _) = False+ chk (NoteRec _ _ _ _) = False chk (RecurRec _ _ _ r) = chk r chk _ = True chkTo (to, CCSAmt n _) =@@ -237,7 +240,7 @@ nb = if null acc then [CCSAmt noName (Amount 0)] else snd (head acc)- in if isJ && (tst rn || rn == noName)+ in if isJ && tst rn then recordInfo (record, nb) else recordNil @@ -254,7 +257,8 @@ exchTrans :: Maybe Name -> Bool -> Record -> AccountData -> Ledger e (Record, [CCSAmt]) AccountData exchTrans reg dorec record@(ExchRec _ _ isrec acc amtn amto _) accs =- maybeDo reg dorec record isrec accs (doExch accs acc amtn amto) (== acc)+ maybeDo reg dorec record isrec accs (doExch accs acc amtn amto)+ (\rn -> rn == acc || rn == noName) where doExch [] _ _ _ = [] doExch ((an,ab):as) n en eo = if an == n@@ -268,7 +272,7 @@ foldM (xfer1 False) accs (init tos) >>= (\a -> xfer1 True a (last tos)) where xfer1 rf as (to,amt) = maybeDo reg dorec record isrec as (doXfer as from to amt)- (\rn -> (rf && rn == from) || rn == to)+ (\rn -> (rf && (rn == from || rn == noName)) || rn == to) doXfer [] _ _ _ = [] doXfer (a@(an,ab):as) nf nt e | an == nf = (an, subFrom ab e) : doXfer as nf nt e@@ -313,10 +317,20 @@ XferRec _ _ _ _ _ _ -> xferTrans r f t as >>= appTr d r f ts ExchRec _ _ _ _ _ _ _ -> exchTrans r f t as >>= appTr d r f ts SplitRec _ _ _ _ -> splitTrans r t as >>= appTr d r f ts- ToDoRec _ isrec _ ->+ NoteRec _ isrec SN_T _ -> (if isrec then recordNil else recordInfo (t,[])) >> appTr d r f ts as+ NoteRec da isrec _ _ ->+ (if isrec || not (ca d da)+ then recordNil+ else recordInfo (t,[])) >> appTr d r f ts as _ -> recordErr t >> appTr d r f ts as+ where ca dn@(Date yn _ _) (Date _ ma da) =+ let jn = julianDate dn+ j1 = julianDate (Date (yn - 1) ma da)+ j2 = julianDate (Date yn ma da)+ j3 = julianDate (Date (yn + 1) ma da)+ in abs (jn - j1) <= 7 || abs (jn - j2) <= 7 || abs (jn - j3) <= 7 showT :: (Record, [CCSAmt]) -> IO () showT (t,_) = print t@@ -338,10 +352,11 @@ -- For now, we don't generate "swap prices" internally, so unless the user -- enters some, we won't see any; see also generateImplicitPrices above. -getPrices :: Name -> Name -> Date -> [Record] -> IO ()-getPrices nm dc date prices =- do let p1 = dropWhile (\t -> date < getRecDate t) prices- (_,i,e) = runLedger (get p1)+getPrices :: Name -> Name -> Date -> Date -> [Record] -> IO ()+getPrices nm dc date1 date2 prices =+ do let p1 = dropWhile (\t -> date2 < getRecDate t) prices+ p2 = takeWhile (\t -> date1 < getRecDate t) p1+ (_,i,e) = runLedger (get p2) unless (null e) (doShow "Swap \"Prices\"" e >> putStrLn "") unless (null i) (doShow "Ordinary Prices" i) when (null i && null e)@@ -363,8 +378,6 @@ 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@@ -372,8 +385,6 @@ 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
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.37 2010/05/02 21:32:50 uwe Exp $ -}+$Id: help-head.txt,v 1.2 2010/05/10 04:33:16 uwe Exp $ -} module UMMHelp (writeHdr, usageMsg) where import Prelude version :: String-version = "0.2.0"+version = "0.2.1" writeHdr :: String writeHdr =@@ -31,28 +31,25 @@ "# Available under GPL V3 or later. Share and enjoy!\n" ++ "# http://www.korgwal.com/umm/\n" --- TODO: store these unadorned in some separate text files, and use--- a program (Template Haskell?) to turn them into proper source code- usageMsg :: String -> String usageMsg prog = "usage is '" ++ prog ++ " <ledger-file> <command> <options>'\n" ++ "where <command> and <options> can be any of the following:\n" ++ "\n" ++ " 'balance' [account-or-group] [date]\n" ++- " 'change' acc-or-inc-or-exp [date] [date]\n" +++ " 'change' acc-or-inc-or-exp [date-range]\n" ++ " 'list' ['all' | 'accounts' | 'ccs' | 'expenses' | 'incomes' | 'groups']\n" ++- " 'price' ccs [date]\n" ++- " 'register' account [date] [date]\n" +++ " 'price' ccs [date-range]\n" +++ " 'register' account [date-range]\n" ++ " 'reconcile' [account] [date]\n" ++ " 'todo' [date]\n" ++ " 'basis' ccs [date]\n" ++ " 'export'\n" ++ "\n" ++ "The commands may be shortened to the unique prefixes or anything\n" ++- "longer: 'b', 'ba', 'bala' etc, 'reg', 'regi' etc, but not 'r'.\n" ++- "If no command or options are specified, the default action is\n" ++- "to show the balances of all accounts as of the current date.\n" +++ "longer: 'b', 'ba', 'bala' etc, 'reg', 'regi' etc, but not 'r'. If no\n" +++ "command or options are specified, the default action is to show the\n" +++ "balances of all accounts as of the current date.\n" ++ "\n" ++ "'account' is the name of an account; see the description of 'name'\n" ++ "below for more details of formatting. Likewise, 'account-or-group'\n" ++@@ -65,32 +62,23 @@ "'date' defaults to the current date if not specified; again, see\n" ++ "below for details of formatting.\n" ++ "\n" +++ "'date-range' may be specified in any of several formats; see below\n" +++ "for details of formatting.\n" +++ "\n" ++ "--------\n" ++ "\n" ++ "* 'balance' shows the balance in the specified account or group,\n" ++ " or in all accounts if none is specified, as of the given date.\n" ++ "\n" ++- "\n" ++- "* 'price' shows the price history of the specified currency, commodity,\n" ++- " or security, up to the specified date.\n" ++- "\n" ++- "\n" ++ "* 'change' shows the change in the specified account or pseudo-account\n" ++- " between the two given dates, or from the beginning of the ledger to\n" ++- " the specified date.\n" ++- "\n" +++ " in the given date range.\n" ++ "\n" ++ "* 'price' shows the price history of the specified currency,\n" ++- " commodity, or security, up to the specified date.\n" ++- "\n" +++ " commodity, or security, in the given date range\n" ++ "\n" ++ "* 'register' shows all transactions involving the specified\n" ++- " account up to the given date, and shows the balance as of\n" ++- " that date.\n" ++- "\n" ++- " If 'register' is given two dates, it prints transactions from\n" ++- " the earlier to the later date.\n" ++- "\n" +++ " account in the given date range, and shows the balance as of\n" +++ " the end of that date range.\n" ++ "\n" ++ "* 'reconcile' applies all reconciled transactions up to the\n" ++ " given date, shows relevant unreconciled transactions up to\n" ++@@ -101,20 +89,16 @@ " transactions involving that account are shown, otherwise all\n" ++ " unreconciled transactions are shown\n" ++ "\n" ++- "\n" ++ "* 'todo' shows all the unreconciled 'todo' items in the ledger\n" ++ " up to the date specified, defaulting to the current date\n" ++ "\n" ++- "\n" ++ "* 'list' shows summaries of the various kinds of non-transaction\n" ++ " entries in the ledger file: currencies/commodities/securities,\n" ++ " income and expense categories, accounts, and groups\n" ++ "\n" ++- "\n" ++ "* 'basis' shows the cost basis for a given currency or commodity\n" ++ " or security.\n" ++ "\n" ++- "\n" ++ "* 'export' will eventually export the data in ledger/hledger\n" ++ " format. It is only partially implemented.\n" ++ "\n" ++@@ -135,108 +119,96 @@ " \\ name3 amount [name], ...} [desc] [id]\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" ++- "section describing the meaning of each type of record. The\n" ++- "individual fields for each record are separated by whitespace.\n" ++- "\n" ++- "Blank lines or lines whose first non-blank character is '#'\n" ++- "are treated as comments and are ignored.\n" +++ "There are also 'buy' and 'sell' records which are just syntactic sugar\n" +++ "for 'exch', and 'birthday' and 'anniversary' records which are mostly\n" +++ "just syntactic sugar for 'todo'; see more details below in the section\n" +++ "describing the meaning of each type of record. The individual fields\n" +++ "for each record are separated by whitespace.\n" ++ "\n" ++- "Syntactically, all of these are optional: there are no\n" ++- "required records, and an empty ledger file is syntactically\n" ++- "legal. However, a minimally-useful ledger file will probably\n" ++- "contain at least some 'xfer' records, which in turn require\n" ++- "that there be at least a couple of 'account' or 'income' or\n" ++- "'expense' records.\n" +++ "Blank lines or lines whose first non-blank character is '#' or ';' are\n" +++ "treated as comments and are ignored.\n" ++ "\n" ++- "The order of records in the ledger file is not significant;\n" ++- "the program orders them by type and date, and applies\n" ++- "transactions in order by date.\n" +++ "Syntactically, all of these are optional: there are no required\n" +++ "records, and an empty ledger file is syntactically legal. However, a\n" +++ "minimally-useful ledger file will probably contain at least some\n" +++ "'xfer' records, which in turn require that there be at least a couple\n" +++ "of 'account' or 'income' or 'expense' records.\n" ++ "\n" ++- "The second form of the 'xfer' record above shows splitting\n" ++- "of records across multiple physical lines. All whitespace\n" ++- "between the trailing '\\' on the first line and the leading '\\'\n" ++- "on the second line, plus the two '\\', is annihilated and the\n" ++- "remainders are joined.\n" +++ "The order of records in the ledger file is not significant; the\n" +++ "program orders them by type and date, and applies transactions in\n" +++ "order by date.\n" ++ "\n" +++ "The second form of the 'xfer' record above shows splitting of records\n" +++ "across multiple physical lines. All whitespace between the trailing\n" +++ "'\\' on the first line and the leading '\\' on the second line, plus the\n" +++ "two '\\', is annihilated and the remainders are joined.\n" ++ "\n" ++ "The meaning of each record type is as follows:\n" ++ "\n" ++ "* 'ccs name [desc] [amount] [name]' describes a currency or commodity\n" ++- " or security: the things you want to keep track of. The first\n" ++- " ccs record in the ledger file is the default unit; my ledger\n" ++- " file has 'ccs US$' very near the top. However, you don't\n" ++- " need one, in which case the program computes in Zorkmid\n" ++- " ('zm'). If you don't enter any 'ccs' record, you can't\n" ++- " specify any units in 'xfer' records, and you can't use any\n" ++- " 'price' or 'split' records. You can use 'exch' (and 'buy'\n" ++- " and 'sell') records, but they probably won't be very useful,\n" +++ " or security: the things you want to keep track of. The first ccs\n" +++ " record in the ledger file is the default unit; my ledger file has\n" +++ " 'ccs US$' very near the top. However, you don't need one, in which\n" +++ " case the program computes in Zorkmid ('zm'). If you don't enter any\n" +++ " 'ccs' record, you can't specify any units in 'xfer' records, and you\n" +++ " can't use any 'price' or 'split' records. You can use 'exch' (and\n" +++ " 'buy' and 'sell') records, but they probably won't be very useful,\n" ++ " since all you can do is to trade one amount of Zorkmids for\n" ++- " another. The 'desc' field in a ccs record is currently just\n" ++- " for documentation, it's not used by the program. The optional\n" ++- " 'amount' field is for specifying the initial price of this ccs\n" ++- " in units of the second 'name' ccs, or the default ccs if no second\n" ++- " 'name' is specified. If present, the second 'name' is also the ccs\n" ++- " into which this ccs is translated.\n" ++- "\n" +++ " another. The 'desc' field in a ccs record is currently just for\n" +++ " documentation, it's not used by the program. The optional 'amount'\n" +++ " field is for specifying the initial price of this ccs in units of\n" +++ " the second 'name' ccs, or the default ccs if no second 'name' is\n" +++ " specified. If present, the second 'name' is also the ccs into which\n" +++ " this ccs is translated.\n" ++ "\n" ++ "* 'account name [date] [desc]' records specify accounts where you\n" ++- " want to keep of the quantity of what's in the account as well\n" ++- " as transactions which move stuff into or out of the account.\n" ++- " An account can contain multiple types of ccs, for example a\n" ++- " single account could be used to describe a brokerage account\n" ++- " containing many securities as well as cash. The date and desc\n" ++- " fields are currently just for documentation and are not used\n" ++- " by the program.\n" ++- "\n" +++ " want to keep of the quantity of what's in the account as well as\n" +++ " transactions which move stuff into or out of the account. An\n" +++ " account can contain multiple types of ccs, for example a single\n" +++ " account could be used to describe a brokerage account containing\n" +++ " many securities as well as cash. The date and desc fields are\n" +++ " currently just for documentation and are not used by the program.\n" ++ "\n" ++ "* 'group name [name...]' groups multiple accounts together into one\n" ++ " group, so that it's possible to query the balances for a group of\n" ++ " accounts as a whole.\n" ++ "\n" ++- "\n" ++ "* 'income name [desc]' and 'expense name [desc]' records specify\n" ++- " pseudo-accounts where you don't want to keep track of what's\n" ++- " inside, just the transactions: think of these as categories.\n" ++- " 'income' specifies a source of ccs, and 'expense' specifies a\n" ++- " destination or sink. The desc field is currently just for\n" ++- " documentation. You can, to some extent, circumvent the source\n" ++- " or sink nature by entering a transaction from a source to an\n" ++- " account, but with a negative amount: this would actually take\n" ++- " money out of the account. This is intended for VERY OCCASIONAL\n" ++- " overrides, say you overpaid a utility bill and get a credit\n" ++- " which you don't want to just apply to the next bill. Don't\n" ++- " abuse this!\n" ++- "\n" +++ " pseudo-accounts where you don't want to keep track of what's inside,\n" +++ " just the transactions: think of these as categories. 'income'\n" +++ " specifies a source of ccs, and 'expense' specifies a destination or\n" +++ " sink. The desc field is currently just for documentation. You can,\n" +++ " to some extent, circumvent the source or sink nature by entering a\n" +++ " transaction from a source to an account, but with a negative amount:\n" +++ " this would actually take money out of the account. This is intended\n" +++ " for VERY OCCASIONAL overrides, say you overpaid a utility bill and\n" +++ " get a credit which you don't want to just apply to the next\n" +++ " bill. Don't abuse this!\n" ++ "\n" ++- "* 'price date [amount1] name1 amount2 [name2]' records are\n" ++- " used to specify the price of one ccs in terms of another;\n" ++- " usually a currency. If the first amount is not specified,\n" ++- " it defaults to 1, and if the second name is not specified,\n" ++- " it defaults to the default ccs. For example, if you are\n" ++- " tracking ounces of gold using the ccs name 'Au', you might\n" ++- " have a price record\n" +++ "* 'price date [amount1] name1 amount2 [name2]' records are used to\n" +++ " specify the price of one ccs in terms of another; usually a\n" +++ " currency. If the first amount is not specified, it defaults to 1,\n" +++ " and if the second name is not specified, it defaults to the default\n" +++ " ccs. For example, if you are tracking ounces of gold using the ccs\n" +++ " name 'Au', you might have a price record\n" ++ "\n" ++ " price 2009-10-21 Au 1063.70\n" ++ "\n" ++- " and if you track ounces but for some reason have a price quote\n" ++- " in grams, you might write\n" +++ " and if you track ounces but for some reason have a price quote in\n" +++ " grams, you might write\n" ++ "\n" ++ " price 2009-10-21 0.03215075 Au 34.19875 US$\n" ++ "\n" ++- " 'name1' (and 'name2', if specified) must be specified in the\n" ++- " ledger by 'ccs' records.\n" ++- "\n" +++ " 'name1' (and 'name2', if specified) must be specified in the ledger\n" +++ " by 'ccs' records.\n" ++ "\n" ++- "* 'split date name amount1 amount2' records are used to specify\n" ++- " stock splits: 'name' is the name of the security being split,\n" ++- " which must be specified in the ledger by a 'ccs' record, 'date'\n" ++- " is the date of the split, and 'amount1' and 'amount2' are the\n" ++- " new and old numbers of shares, respectively. In the markets,\n" ++- " these are usually integers, but the program does not require\n" ++- " this. For example, General Electric did a 3:1 stock split on\n" ++- " May 8, 2000, which could be specified as\n" +++ "* 'split date name amount1 amount2' records are used to specify stock\n" +++ " splits: 'name' is the name of the security being split, which must\n" +++ " be specified in the ledger by a 'ccs' record, 'date' is the date of\n" +++ " the split, and 'amount1' and 'amount2' are the new and old numbers\n" +++ " of shares, respectively. In the markets, these are usually integers,\n" +++ " but the program does not require this. For example, General Electric\n" +++ " did a 3:1 stock split on May 8, 2000, which could be specified as\n" ++ "\n" ++ " split 2000-5-8 GE 3 1\n" ++ "\n" ++@@ -246,62 +218,58 @@ " split 2000-5-8 GE 1.5 0.5\n" ++ " split 2000-5-8 GE 15/7 5/7\n" ++ "\n" ++- "\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" ++- " an 'income' record. If you don't specify the name of what's\n" ++- " being transferred, the program assumes it's the default ccs,\n" ++- " US$ or Zorkmids or whatever. For example, this record from my\n" ++- " ledger file\n" +++ " records are used to transfer 'amount' of 'name' from account 'name1'\n" +++ " to account 'name2'; 'name1' may be either an account specified by an\n" +++ " 'account' record, or a source specified by an 'income' record. If\n" +++ " you don't specify the name of what's being transferred, the program\n" +++ " assumes it's the default ccs, US$ or Zorkmids or whatever. For\n" +++ " example, this record from my ledger file\n" ++ "\n" ++ " xfer* 2009/2/27 interest abc:savings 0.01\n" ++ "\n" ++- " says that on February 27, 2009, one penny interest was credited\n" ++- " to my ABC Bank savings account, and this record\n" +++ " says that on February 27, 2009, one penny interest was credited to\n" +++ " my ABC Bank savings account, and this record\n" ++ "\n" ++ " xfer* 2009/9/26 checking utility:water 43.99 1216\n" ++ "\n" ++- " is the payment of my water bill, in the amount of US$ 43.99,\n" ++- " with check #1216.\n" +++ " is the payment of my water bill, in the amount of US$ 43.99, with\n" +++ " check #1216.\n" ++ "\n" ++- " Both of these are marked as reconciled; this affects only\n" ++- " the 'reconcile' command: when that command is run, reconciled\n" ++- " transactions are included in the reconciled balance and are\n" ++- " not printed, whereas not-reconciled transactions are printed\n" ++- " but not included in the reconciled balance.\n" +++ " Both of these are marked as reconciled; this affects only the\n" +++ " 'reconcile' command: when that command is run, reconciled\n" +++ " transactions are included in the reconciled balance and are not\n" +++ " printed, whereas not-reconciled transactions are printed but not\n" +++ " included in the reconciled balance.\n" ++ "\n" ++ " 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" ++- "\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" ++- " less error-prone. In 'exch' and 'buy' records,\n" ++- " (amount1,name1) is the new quantity coming into the account\n" ++- " named 'name', and (amount2,name2) is the quantity leaving\n" +++ " records and their aliases 'buy' and 'sell' are used to trade some\n" +++ " amount of one ccs for another. To some extent, these are syntactic\n" +++ " sugar: the same could be accomplished with a pair of 'xfer' records,\n" +++ " but this is a little clearer and less error-prone. In 'exch' and\n" +++ " 'buy' records, (amount1,name1) is the new quantity coming into the\n" +++ " account named 'name', and (amount2,name2) is the quantity leaving\n" ++ " the account; for example\n" ++ "\n" ++ " exch 2009-7-10 brokerage 300 MTLQQ.PK 300 GM \"rename GM\"\n" ++ "\n" ++- " might be an entry describing the name change of GM shares\n" ++- " when GM went through bankruptcy (I'm not sure of the date though,\n" ++- " and in any case shareholders of \"old GM\" wouldn't simply\n" ++- " get shares of \"new GM\"... but ignore that), and\n" +++ " might be an entry describing the name change of GM shares when GM\n" +++ " went through bankruptcy (I'm not sure of the date though, and in any\n" +++ " case shareholders of \"old GM\" wouldn't simply get shares of \"new\n" +++ " GM\"... but ignore that), and\n" ++ "\n" ++ " buy 2009/10/2 brokerage 3.959 VTSMX 100\n" ++ "\n" ++ " might be an entry describing a regular automatic purchase of\n" ++- " VTSMX. For 'sell' records, the order is reversed: the first\n" ++- " pair (amount1,name1) describes what's being sold, ie, going\n" ++- " out of the account, and the second pair (amount2,name2) shows\n" ++- " what's being acquired in exchange. Thus\n" +++ " VTSMX. For 'sell' records, the order is reversed: the first pair\n" +++ " (amount1,name1) describes what's being sold, ie, going out of the\n" +++ " account, and the second pair (amount2,name2) shows what's being\n" +++ " acquired in exchange. Thus\n" ++ "\n" ++ " sell 2009/10/2 brokerage 3.959 VTSMX 100\n" ++ "\n" ++@@ -314,75 +282,106 @@ "\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" ++- " the text is printed out. If the record is marked as\n" ++- " reconciled, the text is not printed out; the record merely\n" ++- " serves as a comment in the ledger. This is for leaving\n" ++- " yourself reminders of stuff that needs to be done at some\n" ++- " time: for example, my ledger file has entries\n" +++ "* 'todo [rec] date text' is basically a sticky note in the ledger. If\n" +++ " the record is not marked as reconciled, and the date falls within\n" +++ " the range of the command being executed, the text is printed out. If\n" +++ " the record is marked as reconciled, the text is not printed out; the\n" +++ " record merely serves as a comment in the ledger. This is for leaving\n" +++ " yourself reminders of stuff that needs to be done at some time: for\n" +++ " example, my ledger file has entries\n" ++ "\n" ++ " todo 2009/12/1 Start actively gathering tax info\n" ++ " todo 2010/4/10 Taxes better be done!!!\n" ++ "\n" ++- " yet I won't be bothered by seeing these until those dates\n" ++- " have passed (or if I do a query for some time in the future).\n" +++ " yet I won't be bothered by seeing these until those dates have\n" +++ " passed (or if I do a query for some time in the future).\n" ++ "\n" +++ " In addition, there are two not-quite-financial bits of syntactic\n" +++ " sugar: there are two record types 'birthday' and 'anniversary', with\n" +++ " syntax otherwise just like 'todo', that act somewhat similarly. Both\n" +++ " of these are essentially periodic 'todo' records, however they only\n" +++ " trigger in a limited window of one week around each annual\n" +++ " recurrence of the given date. In addition, only the month and day\n" +++ " are printed, not the year. Thus, if there were a record\n" ++ "\n" ++- "In the above:\n" +++ " birthday 1928-11-18 Mickey Mouse\n" ++ "\n" ++- "* 'name' is a sequence of non-blank characters whose first\n" ++- " character is a letter or a currency symbol and whose remaining\n" ++- " characters are letters or currency symbols or digits or symbols\n" ++- " from the set !%&*+-/:<=>?@^_~\n" +++ " in the ledger file, a note would be printed for one week around each\n" +++ " November 18, formatted as\n" ++ "\n" +++ " birthday 11/18 Mickey Mouse\n" ++ "\n" ++- "* 'date' is a date formatted as Y/M/D or Y-M-D, where no\n" ++- " assumptions are made about implicit century years etc:\n" ++- " what you enter is what's there, so 98-1-27, for example,\n" ++- " is a date describing the death of the roman emperor Nerva\n" ++- " and the beginning of the reign of his successor Trajan,\n" ++- " not January 27, 1998. The program knows that there are\n" ++- " 12 months in a year, and how many days there are in each\n" ++- " month (including leap years, for which it assumes the use\n" ++- " of the proleptic Gregorian calendar), and it checks these\n" ++- " for validity; it makes no assumptions about the validity\n" ++- " of the year. Years BC cannot be entered... this is probably\n" ++- " not a significant limitation.\n" +++ " There is no difference between 'birthday' and 'anniversary' except\n" +++ " the keyword used to enter them and the same keyword used to print\n" +++ " them. As in 'todo' records, the reconciliation mark serves to\n" +++ " suppress these.\n" ++ "\n" +++ "In the above:\n" ++ "\n" ++- "* 'desc' is an arbitrary string enclosed in double quotes:\n" ++- " \"a string\". It may contain embedded escaped characters\n" ++- " and escaped quotes, using a back-slash for escaping:\n" ++- " \"this is a\\\" string with \\n embedded quote and newline\".\n" +++ "* 'name' is a sequence of non-blank characters whose first character\n" +++ " is a letter or a currency symbol and whose remaining characters are\n" +++ " letters or currency symbols or digits or symbols from the set\n" +++ " !%&*+-/:<=>?@^_~\n" ++ "\n" +++ "* 'date' is a date formatted as Y/M/D or Y-M-D, where no assumptions\n" +++ " are made about implicit century years etc: what you enter is what's\n" +++ " there, so 98-1-27, for example, is a date describing the death of\n" +++ " the roman emperor Nerva and the beginning of the reign of his\n" +++ " successor Trajan, not January 27, 1998. The program knows that there\n" +++ " are 12 months in a year, and how many days there are in each month\n" +++ " (including leap years, for which it assumes the use of the proleptic\n" +++ " Gregorian calendar), and it checks these for validity; it makes no\n" +++ " assumptions about the validity of the year. Years BC cannot be\n" +++ " entered... this is probably not a significant limitation.\n" ++ "\n" ++- "* 'amount' is a rational number formatted in one of several\n" ++- " ways: one or more digits, possibly followed by a decimal\n" ++- " point '.' and zero or more digits ('\\d+(\\.\\d*)?' in perl\n" ++- " regexp-speak), or a decimal point '.' followed by one or\n" ++- " more digits ('\\.\\d+'), or two sequences of one or more\n" ++- " digits each separated by '/' ('\\d+\\/\\d+'). In all cases,\n" ++- " an optional sign, '+' or '-', may precede the rational\n" ++- " number.\n" +++ "* 'date-range' is a pair of dates specified in one of several ways.\n" ++ "\n" +++ " The first (and originally the only) way is to simply specify two\n" +++ " dates: \"2009-4-17 2009-9-27\" is most of spring and summer of 2009.\n" +++ " In this version, either or both dates can be left out, in which case\n" +++ " defaults get used: if only one date is given, it is assumed to be\n" +++ " the end of the range, and the beginning is implicitly taken to be\n" +++ " \"the beginning of time\", an internal date several thousand years ago\n" +++ " (October 23, 4004 BC to be exact). If both dates are left off, the\n" +++ " range is assumed to be from the beginning of time until today,\n" +++ " whatever today's date is.\n" ++ "\n" ++- "* 'rec' is a reconciliation mark: an asterisk '*'. It may\n" ++- " immediately follow the record type, or it may be separated\n" ++- " from the record type by whitespace: ie, both 'todo*' and\n" ++- " 'todo *' are legal.\n" +++ " The second way to specify a date range is to specify an incomplete\n" +++ " date: specifying just a year+month, \"2010-5\", or just a year,\n" +++ " \"2010\", generates a range that is that month or that year. There is\n" +++ " a special case in that if the year+month is the current year+month,\n" +++ " then the range extends from the beginning of the month to today's\n" +++ " date, and similarly if just the year is the current year, then the\n" +++ " range extends from the beginning of the year to today's date. For\n" +++ " other year+month or year ranges, the range is the full month or year\n" +++ " respectively.\n" ++ "\n" +++ " The last way to specify a date range is to give the literal keyword\n" +++ " 'last' followed by a number which is the number of days into the\n" +++ " past: \"last 30\" means from 30 days ago until today.\n" ++ "\n" ++- "* 'id' (in an 'xfer' record) is a sequence of digits: a\n" ++- " check number or other identifying number.\n" +++ "* 'desc' is an arbitrary string enclosed in double quotes: \"a\n" +++ " string\". It may contain embedded escaped characters and escaped\n" +++ " quotes, using a back-slash for escaping: \"this is a\\\" string with \\n\n" +++ " embedded quote and newline\".\n" ++ "\n" +++ "* 'amount' is a rational number formatted in one of several ways: one\n" +++ " or more digits, possibly followed by a decimal point '.' and zero or\n" +++ " more digits ('\\d+(\\.\\d*)?' in perl regexp-speak), or a decimal point\n" +++ " '.' followed by one or more digits ('\\.\\d+'), or two sequences of\n" +++ " one or more digits each separated by '/' ('\\d+\\/\\d+'). In all cases,\n" +++ " an optional sign, '+' or '-', may precede the rational number.\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" +++ "* 'rec' is a reconciliation mark: a '*' or a '!'. It may immediately\n" +++ " follow the record type, or it may be separated from the record type\n" +++ " by whitespace: ie, both 'todo*' and 'todo *' are legal.\n" ++ "\n" +++ "* 'id' (in an 'xfer' record) is a sequence of digits: a check number\n" +++ " or other identifying number.\n" +++ "\n" +++ "* 'period' is an optional prefix of 'xfer' and 'exch' records: it\n" +++ " specifies that this is a periodic transaction. It has the format\n" +++ "\n" ++ " recurring interval until end-date [reconciled rec-date]\n" ++ "\n" ++ " where 'recurring', 'until', and 'reconciled' are literal keywords,\n" ++@@ -397,9 +396,9 @@ " 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" +++ " is a monthly interest payment into abc:savings, occurring on the\n" +++ " 27th of each month from Feb 2009 until Dec 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"+ " The 'reconciled' keyword and rec-date are themselves optional. If\n" +++ " present, they indicate that instances of this record before the\n" +++ " 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.43 2010/05/02 00:37:26 uwe Exp $ -}+$Id: UMMParser.hs,v 1.47 2010/05/09 06:24:44 uwe Exp $ -} -- TODO: template := <to be determined> @@ -43,6 +43,16 @@ fv = readInt fp in (e*iv + fv) % e +-- Parse a string, recognizing the whole string even if only a partial+-- prefix of it is given: the size of the minimal acceptable prefix has+-- to be specified to the parser++parsePrefixOf :: Int -> String -> Parser String+parsePrefixOf n str =+ string (take n str) >> opts (drop n str) >> return str+ where opts [] = return ()+ opts (c:cs) = optional (char c >> opts cs)+ -- Hide parsec's spaces and substitute this one: -- want "spaces" to mean an actual something there @@ -211,6 +221,56 @@ return (Date (fromInteger y) (fromInteger m) (fromInteger d)) where pMS s = char s >> parseInt >>= (\m -> char s >> return m) +-- Parse a date range in any of several formats:+-- DR1 -> an optional pair of dates, with defaults+-- DR2 -> a year/month, generating a fractional-month-long range+-- DR3 -> a year, generating a fractional-year-long range+-- DR4 -> literal 'last' followed by a number -> that many days into past+-- In DR[23], if the fractional input date is the same as the current+-- date, go from the beginning of the period to the current date;+-- otherwise, go the full period.++parseDateRange, parseDR1, parseDR2, parseDR3, parseDR4 ::+ Date -> Parser (Date, Date)+parseDR1 now =+ do date1 <- option now parseDate+ date2 <- option startTime parseDate+ return (if date2 < date1 then (date2, date1) else (date1, date2))++parseDR2 dn@(Date yn mn _) =+ do spaces+ y <- parseInt+ oneOf "/-"+ m <- parseInt+ let yi = fromInteger y+ mi = fromInteger m+ d1 = Date yi mi 1+ d2 = if yi == yn && mi == mn+ then dn+ else previousDate (Date yi (mi + 1) 1)+ return (d1, d2)++parseDR3 dn@(Date yn _ _) =+ do spaces+ y <- parseInt+ let yi = fromInteger y+ d1 = Date yi 1 1+ d2 = if yi == yn then dn else Date yi 12 31+ return (d1, d2)++parseDR4 dn =+ do spaces+ string "last"+ spaces+ dd <- parseInt+ return (offsetDate dn (- fromInteger dd), dn)++parseDateRange now =+ TPCP.try (parseDR1 now) <|>+ TPCP.try (parseDR2 now) <|>+ TPCP.try (parseDR3 now) <|>+ parseDR4 now+ parseReconcile :: Parser Bool parseReconcile = option False (TPCP.try (many space >> oneOf "*!" >> return True))@@ -219,13 +279,13 @@ parsePeriod = spaces >> (pPG <|> pPS "daily" (PND 1) <|>- pPS "weekly" (PNW 1) <|>+ pPS "weekly" (PND 7) <|> pPS "monthly" (PNM 1) <|> pPS "quarterly" (PNM 3) <|>- pPS "annually" (PNY 1) <|>- TPCP.try (pPS "biweekly" (PNW 2)) <|>+ pPS "annually" (PNM 12) <|>+ TPCP.try (pPS "biweekly" (PND 14)) <|> TPCP.try (pPS "bimonthly" (PNM 2)) <|>- pPS "biannually" (PNY 2) <|>+ pPS "biannually" (PNM 24) <|> TPCP.try (pPS "semiweekly" PSW) <|> TPCP.try (pPS "semimonthly" PSM) <|> pPS "semiannually" (PNM 6))@@ -239,15 +299,15 @@ let ni = fromInteger n return (case p of "days" -> PND ni- "weeks" -> PNW ni+ "weeks" -> PND (7*ni) "months" -> PNM ni- "years" -> PNY ni+ "years" -> PNM (12*ni) _ -> intErr "parsePeriod") -- The top-level record parsers parseCCS, parseIE, parseAccount, parseGroup, parsePrice, parseXfer, parseEBS,- parseSplit, parseTodo, parseRecur, parseComment, parseBlank, parseRecord ::+ parseSplit, parseTBA, parseRecur, parseComment, parseBlank, parseRecord :: Parser Record parseCCS =@@ -312,12 +372,12 @@ ca2 <- parseCCSAmt memo <- parseOptionalString let et = case rtype of- "buy" -> B- "sell" -> S- "exch" -> E+ "buy" -> BSE_B+ "sell" -> BSE_S+ "exch" -> BSE_E _ -> intErr "parseEBS" ca1 = CCSAmt name1 amt1- if et == S+ if et == BSE_S then return (ExchRec et date rec acct ca2 ca1 memo) else return (ExchRec et date rec acct ca1 ca2 memo) @@ -329,13 +389,18 @@ amt2 <- parseAmount return (SplitRec date name amt1 amt2) -parseTodo =- do string "todo"+parseTBA =+ do rtype <- string "todo" <|> string "birthday" <|> string "anniversary" rec <- parseReconcile date <- parseDate spaces memo <- many anyChar- return (ToDoRec date rec (trimspace memo))+ let nt = case rtype of+ "todo" -> SN_T+ "birthday" -> SN_B+ "anniversary" -> SN_A+ _ -> intErr "parseTBA"+ return (NoteRec date rec nt (trimspace memo)) parseComment = do many1 (oneOf "#;")@@ -365,16 +430,14 @@ <|> parseCCS <|> TPCP.try parseIE <|> TPCP.try parseEBS+ <|> TPCP.try parseAccount <|> parseSplit- <|> parseTodo- <|> parseAccount+ <|> parseTBA <|> parseGroup <|> parseRecur <|> parseComment <|> parseBlank -- this must be last, as it can match nothing- many space- eof- return record+ many space >> eof >> return record parseURecord :: String -> Record parseURecord input =@@ -385,12 +448,6 @@ parseUDate :: String -> Either ParseError Date parseUDate input = parse parseDate "umm date" (' ' : input) -parsePrefixOf :: Int -> String -> Parser String-parsePrefixOf n str =- string (take n str) >> opts (drop n str) >> return str- where opts [] = return ()- opts (c:cs) = optional (char c >> opts cs)- parseCmdBalance, parseCmdBasis, parseCmdChange, parseCmdPrice, parseCmdReconcile, parseCmdRegister, parseCmdToDo, parseCommand :: Date -> Parser Command@@ -399,28 +456,24 @@ parseCmdBalance now = do parsePrefixOf 3 "balance" name <- parseOptionalName- date <- option now (TPCP.try parseDate)+ date <- option now parseDate return (BalanceCmd name date) parseCmdBasis now = do parsePrefixOf 3 "basis" name <- parseName- date <- option now (TPCP.try parseDate)+ date <- option now parseDate return (BasisCmd name date) parseCmdExport = parsePrefixOf 1 "export" >> return ExportCmd -- TODO: make verbose/nonverbose work... somehow add optional verbosity--- ok, this is really cheesy! make it better! parseCmdChange now = do parsePrefixOf 1 "change" name <- parseName- date1 <- option now parseDate- date2 <- option startTime parseDate- if date2 < date1- then return (ChangeCmd True name date2 date1)- else return (ChangeCmd False name date1 date2)+ (date1, date2) <- parseDateRange now+ return (ChangeCmd False name date1 date2) parseCmdList = do parsePrefixOf 1 "list"@@ -443,27 +496,24 @@ parseCmdPrice now = do parsePrefixOf 1 "price" name <- parseName- date <- option now (TPCP.try parseDate)- return (PriceCmd name date)+ (date1, date2) <- parseDateRange now+ return (PriceCmd name date1 date2) parseCmdReconcile now = do parsePrefixOf 3 "reconcile" name <- parseOptionalName- date <- option now (TPCP.try parseDate)+ date <- option now parseDate return (ReconcileCmd name date) parseCmdRegister now = do parsePrefixOf 3 "register" name <- parseName- date1 <- option now (TPCP.try parseDate)- date2 <- option startTime (TPCP.try parseDate)- if date2 < date1- then return (RegisterCmd name date2 date1)- else return (RegisterCmd name date1 date2)+ (date1, date2) <- parseDateRange now+ return (RegisterCmd name date1 date2) parseCmdToDo now = do parsePrefixOf 1 "todo"- date <- option now (TPCP.try parseDate)+ date <- option now parseDate return (ToDoCmd date) parseCommand date =