diff --git a/UMM.cabal b/UMM.cabal --- a/UMM.cabal +++ b/UMM.cabal @@ -1,5 +1,5 @@ Name: UMM -Version: 0.2.0 +Version: 0.2.1 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.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 -> diff --git a/UMMData.hs b/UMMData.hs --- a/UMMData.hs +++ b/UMMData.hs @@ -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) diff --git a/UMMEval.hs b/UMMEval.hs --- a/UMMEval.hs +++ b/UMMEval.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: 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 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.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 ++ " '\n" ++ "where and 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" 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.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 := @@ -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 =