diff --git a/UMM.cabal b/UMM.cabal --- a/UMM.cabal +++ b/UMM.cabal @@ -1,5 +1,5 @@ Name: UMM -Version: 0.2.1 +Version: 0.2.2 Homepage: http://www.korgwal.com/umm/ Author: Uwe Hollerbach Maintainer: Uwe Hollerbach @@ -16,7 +16,8 @@ Category: Finance Executable umm - Build-Depends: base >= 4 && < 5, haskell98, parsec, old-time, utf8-string + Build-Depends: base >= 4 && < 5, haskell98, parsec, old-time, + utf8-string, process Main-is: UMM.hs Other-Modules: UMMData UMMParser 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.61 2010/05/09 06:24:43 uwe Exp $ -} +$Id: UMM.hs,v 1.67 2010/06/10 06:44:20 uwe Exp $ -} module Main where import Prelude hiding (putStr,putStrLn,print,readFile,getContents) @@ -128,7 +128,7 @@ showPos :: Name -> [Record] -> Date -> [Record] -> AccountData -> [(Name, [String])] showPos dc ccs da ps as = map f1 as - where f1 (n1,es) = (n1, if null es then ["[empty]"] else map f2 es) + where f1 (n1,_,es) = (n1, if null es then ["[empty]"] else map f2 es) f2 c2@(CCSAmt c2n _) = let sv = show c2 ep = equivPrice c2 (getBaseCurrency c2n dc ccs) da ps @@ -142,9 +142,13 @@ selAccts :: Bool -> [Name] -> AccountData -> AccountData selAccts keep names accs = f2 (f1 accs) - where f0 = filter (\a -> elem (fst a) names) + where f0 = filter (\a -> elem (tr1 a) names) f1 = if length names == 1 && head names == noName then id else f0 - f2 = if keep then id else filter (not . null . snd) + f2 = filter (\a -> (if keep then not . tr2 else const False) a || + not (null (tr3 a))) + tr1 (v,_,_) = v + tr2 (_,v,_) = v + tr3 (_,_,v) = v -- Turn an account-group into a list of accounts. An account-group can -- contain (names of) other account-groups, including recursively, and @@ -184,36 +188,35 @@ doBalance ke date names dc ccs accts trans prices = do final <- getBalances startTime date Nothing False accts trans let fsel = selAccts ke names final - fp = map (\e -> reprice e dc ccs date prices) (concatMap snd fsel) + fp = map (\e -> reprice e dc ccs date prices) (concatMap tr3 fsel) gp = groupBy eqCCSAmtName (sortBy cmpCCSAmtName fp) sp = filter (\e -> ccsA e /= 0) (map sumCCS gp) - if length names == 1 && head names == todoName - then putStr "" - else putStrLn ("Account balances as of " ++ show date) >> - mapM_ putStrLn (ppAccts (showPos dc ccs date prices fsel) 8) >> - putStrLn ("Grand total: ~" ++ show sp) + putStrLn ("Account balances as of " ++ show date) + mapM_ putStrLn (ppAccts (showPos dc ccs date prices fsel) 8) + putStrLn ("Grand total: ~" ++ show sp) where sumCCS cs = CCSAmt (ccsN (head cs)) (Amount (roundP 2 (sum (map ccsA cs)))) ccsN (CCSAmt n _) = n ccsA (CCSAmt _ (Amount a)) = a + tr3 (_,_,v) = v -doRegister :: Date -> Date -> Name -> Name -> [Record] -> +doRegister :: Date -> Date -> [Name] -> Name -> [Record] -> [Record] -> [Record] -> [Record] -> Bool -> IO () -doRegister d1 d2 name dc ccs accts trans prices dorec = - do final <- getBalances d1 d2 (Just name) dorec accts trans +doRegister d1 d2 names dc ccs accts trans prices dorec = + do final <- getBalances d1 d2 (Just names) dorec accts trans putStrLn ((if dorec then "Reconciled" else "Account") ++ " balance as of " ++ show d2) mapM_ putStrLn (ppAccts (showPos dc ccs d2 prices - (selAccts True [name] final)) 8) + (selAccts True names final)) 8) doChange :: Bool -> Date -> Date -> Name -> Name -> [Record] -> [Record] -> [Record] -> IO () doChange verbose d1 d2 name dc ccs accts trans = do let aux = if notElem name (map getRecName accts) - then [AccountRec name d1 "" Nothing] + then [AccountRec name d1 False "" Nothing] else [] trs = dropWhile (\t -> getRecDate t <= d1) trans - mn = if verbose then Just name else Nothing + mn = if verbose then Just [name] else Nothing final <- getBalances d1 d2 mn False (aux ++ accts) trs putStr "Change" when (d1 /= startTime) (putStr (" from " ++ show d1)) @@ -245,32 +248,43 @@ trans = mergeTrans tr1 tr2 pr2 = generateImplicitPrices dc trans cd prices = mergePrices (reverse pr1) pr2 + egrp = expandGroup accts grps pse r = putStrLn (showExp r) >> putStrLn "" case action of ChangeCmd verbose name date1 date2 -> doChange verbose date1 date2 name dc ccs accts trans BalanceCmd name date -> - doBalance True date (expandGroup accts grps name) - dc ccs accts trans prices + doBalance True date (egrp name) dc ccs accts trans prices BasisCmd name date -> doBalance False date [noName] dc ccs accts (filter (hasCur name) trans) [] ExportCmd -> mapM_ pse trans >> mapM_ pse (reverse prices) ListDataCmd w -> doList w dc ccs accts grps incs exps + PlotCmd name date1 date2 (Name output) -> + let crec = find (\r -> getRecName r == name) cd + in if elem name (map getRecName cb) + then putStrLn (show name ++ " is a base CCS!") + else if isNothing crec + then if elem name (map getRecName accts) + then plotBalances date1 date2 name + accts trans output + else putStrLn (show name ++ " is unknown!") + else plotPrices name (getNB (fromJust crec)) + date1 date2 prices output 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 + let crec = find (\r -> getRecName r == name) cd + in if elem name (map getRecName cb) + then putStrLn (show name ++ " is a base CCS!") + else if isNothing crec then putStrLn ("Error! unknown CCS " ++ show name) else getPrices name (getNB (fromJust crec)) date1 date2 prices RegisterCmd name date1 date2 -> - doRegister date1 date2 name dc ccs accts trans prices False + doRegister date1 date2 (egrp name) dc ccs accts trans prices False ReconcileCmd name date -> - doRegister startTime date name dc ccs accts trans prices True + doRegister startTime date (egrp name) dc ccs accts trans prices True ToDoCmd date -> - doBalance True date [todoName] dc ccs accts trans prices + getBalances startTime date Nothing False accts trans >> return () where getNB (CCSRec _ _ _ nb) = nb getNB r = error ("internal error at main! got " ++ show r) diff --git a/UMMData.hs b/UMMData.hs --- a/UMMData.hs +++ b/UMMData.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: UMMData.hs,v 1.54 2010/05/09 06:24:44 uwe Exp $ -} +$Id: UMMData.hs,v 1.56 2010/05/17 05:24:09 uwe Exp $ -} module UMMData (Name(..), Date(..), Amount(..), startTime, Command(..), CmdOpt(..), Record(..), genDate, @@ -119,7 +119,7 @@ -- All accounts: an array of tuples of names and amounts -- TODO: make this a newtype? -type AccountData = [(Name, [CCSAmt])] +type AccountData = [(Name, Bool, [CCSAmt])] data CmdOpt = COLAll | COLCCS @@ -146,6 +146,7 @@ | PriceCmd Name Date Date | ChangeCmd Bool Name Date Date | ExportCmd + | PlotCmd Name Date Date Name instance Show Command where show (ListDataCmd opt) = joinDrop ["list", show opt] @@ -161,6 +162,8 @@ joinDrop ["change", shIf verbose "verbose", show name, show date1, show date2] show ExportCmd = "export" + show (PlotCmd name date1 date2 output) = + joinDrop ["plot", show name, show date1, show date2, show output] -- No, not bovine spongiform encephalitis! Disambiguate buy, sell, and -- exch records: internally, they are all treated as exch, because @@ -203,7 +206,7 @@ data Record = CCSRec Name String (Maybe Amount) Name | IncomeRec Name String | ExpenseRec Name String - | AccountRec Name Date String (Maybe CCSAmt) + | AccountRec Name Date Bool String (Maybe CCSAmt) | GroupRec Name [Name] | PriceRec Date Bool CCSAmt CCSAmt | XferRec Date Bool Name [(Name, CCSAmt)] String String @@ -242,8 +245,8 @@ joinDrop ["ccs", show n, optStr d, shM ma, show nb] showR (IncomeRec n d) = joinDrop ["income", show n, optStr d] showR (ExpenseRec n d) = joinDrop ["expense", show n, optStr d] -showR (AccountRec n da de mi) = - joinDrop ["account", show n, show da, optStr de, shM mi] +showR (AccountRec n da r de mi) = + joinDrop ["account", shRec r, show n, show da, optStr de, shM mi] showR (GroupRec n as) = joinDrop (["group", show n] ++ map show as) showR (PriceRec d imp c1 c2) = joinDrop [shIf imp "[", "price", show d, show c1, show c2, shIf imp "]"] @@ -307,7 +310,7 @@ -- Get the date (or at any rate /some/ date) from a Record getRecDate :: Record -> Date -getRecDate (AccountRec _ d _ _) = d +getRecDate (AccountRec _ d _ _ _) = d getRecDate (PriceRec d _ _ _) = d getRecDate (XferRec d _ _ _ _ _) = d getRecDate (ExchRec _ d _ _ _ _ _) = d @@ -320,11 +323,11 @@ -- Get the name (or at any rate /some/ name) from a Record getRecName :: Record -> Name -getRecName (CCSRec n _ _ _) = n -getRecName (IncomeRec n _) = n -getRecName (ExpenseRec n _) = n -getRecName (AccountRec n _ _ _) = n -getRecName (GroupRec n _) = n +getRecName (CCSRec n _ _ _) = n +getRecName (IncomeRec n _) = n +getRecName (ExpenseRec n _) = n +getRecName (AccountRec n _ _ _ _) = n +getRecName (GroupRec n _) = n getRecName _ = nilName -- so it works for every Record -- Compare two Records diff --git a/UMMEval.hs b/UMMEval.hs --- a/UMMEval.hs +++ b/UMMEval.hs @@ -16,11 +16,12 @@ 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.44 2010/05/10 04:06:46 uwe Exp $ -} +$Id: UMMEval.hs,v 1.48 2010/06/10 06:44:20 uwe Exp $ -} module UMMEval (validateRecs, validateCCS, validateAccts, classifyRecs, validateTransPrices, generateImplicitPrices, getBalances, - getPrices, expandRecurringTrans) where + plotBalances, getPrices, plotPrices, expandRecurringTrans) + where import Prelude hiding (putStr,putStrLn,print) import Data.List import Data.Maybe @@ -28,6 +29,7 @@ import Control.Monad import UMMData +import UMMPlot -- Internal error: complain loudly! @@ -92,10 +94,11 @@ unless (null e) (showErrs "problems with initial values in accounts" e) return i where chk _ [] = return () - chk cn (r@(AccountRec _ _ _ Nothing):rs) = recordInfo r >> chk cn rs - chk cn (r@(AccountRec n da de (Just (CCSAmt nb ia))):rs) + chk cn (r@(AccountRec _ _ _ _ Nothing):rs) = recordInfo r >> chk cn rs + chk cn (r@(AccountRec n da rec de (Just (CCSAmt nb ia))):rs) | nb == noName = - recordInfo (AccountRec n da de (Just (CCSAmt dc ia))) >> chk cn rs + recordInfo (AccountRec n da rec de (Just (CCSAmt dc ia))) + >> chk cn rs | elem nb cn = recordInfo r >> chk cn rs | otherwise = rE "unknown" nb >> recordErr r >> chk cn rs chk _ (r:_) = intErr "validateCCS" r @@ -121,15 +124,15 @@ asD dc t, asD dc r, asD dc p) cw (rec:recs) c i e a g t p r = case rec of - CommentRec _ -> cw recs c i e a g t p r - CCSRec _ _ _ _ -> cw recs (rec:c) i e a g t p r - IncomeRec _ _ -> cw recs c (rec:i) e a g t p r - ExpenseRec _ _ -> cw recs c i (rec:e) a g t p r - AccountRec _ _ _ _ -> cw recs c i e (rec:a) g t p r - GroupRec _ _ -> cw recs c i e a (rec:g) t p r - PriceRec _ _ _ _ -> cw recs c i e a g t (rec:p) r - RecurRec _ _ _ _ -> cw recs c i e a g t p (rec:r) - _ -> cw recs c i e a g (rec:t) p r + CommentRec _ -> cw recs c i e a g t p r + CCSRec _ _ _ _ -> cw recs (rec:c) i e a g t p r + IncomeRec _ _ -> cw recs c (rec:i) e a g t p r + ExpenseRec _ _ -> cw recs c i (rec:e) a g t p r + AccountRec _ _ _ _ _ -> cw recs c i e (rec:a) g t p r + GroupRec _ _ -> cw recs c i e a (rec:g) t p r + PriceRec _ _ _ _ -> cw recs c i e a g t (rec:p) r + RecurRec _ _ _ _ -> cw recs c i e a g t p (rec:r) + _ -> cw recs c i e a g (rec:t) p r vsN = uChk . sortBy cmpRecName uChk vs = if uniqAdjBy (\v1 v2 -> cmpRecName v1 v2 == EQ) vs then vs @@ -231,21 +234,21 @@ qq = getCA q in if qn == dn then CCSAmt qn (Amount (qq * dq)) else q -maybeRecord :: Maybe Name -> Record -> AccountData -> (Name -> Bool) -> +maybeRecord :: Maybe [Name] -> Record -> AccountData -> ([Name] -> Bool) -> Ledger e (Record, [CCSAmt]) () maybeRecord reg record newaccs tst = let isJ = isJust reg rn = fromJust reg - acc = filter (\a -> fst a == rn) newaccs - nb = if null acc - then [CCSAmt noName (Amount 0)] - else snd (head acc) + acc = filter (\a -> elem (tr1 a) rn) newaccs + nb = if null acc then [CCSAmt noName (Amount 0)] else tr3 (head acc) in if isJ && tst rn then recordInfo (record, nb) else recordNil + where tr1 (v,_,_) = v + tr3 (_,_,v) = v -maybeDo :: Maybe Name -> Bool -> Record -> Bool -> - AccountData -> AccountData -> (Name -> Bool) -> +maybeDo :: Maybe [Name] -> Bool -> Record -> Bool -> + AccountData -> AccountData -> ([Name] -> Bool) -> Ledger e (Record, [CCSAmt]) AccountData maybeDo reg dorec record isrec accs newaccs tst = if dorec @@ -254,29 +257,30 @@ else maybeRecord reg record newaccs tst >> return accs else maybeRecord reg record newaccs tst >> return newaccs -exchTrans :: Maybe Name -> Bool -> Record -> AccountData -> +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) - (\rn -> rn == acc || rn == noName) + (\rn -> elem acc rn || rn == [noName]) where doExch [] _ _ _ = [] - doExch ((an,ab):as) n en eo = + doExch ((an,ah,ab):as) n en eo = if an == n - then (an, subFrom (addTo ab en) eo) : as - else (an,ab) : doExch as n en eo + then (an, ah, subFrom (addTo ab en) eo) : as + else (an, ah, ab) : doExch as n en eo exchTrans _ _ r _ = intErr "exchTrans" r -xferTrans :: Maybe Name -> Bool -> Record -> AccountData -> +xferTrans :: Maybe [Name] -> Bool -> Record -> AccountData -> Ledger e (Record, [CCSAmt]) AccountData xferTrans reg dorec record@(XferRec _ isrec from tos _ _) accs = foldM (xfer1 False) accs (init tos) >>= (\a -> xfer1 True a (last tos)) where xfer1 rf as (to,amt) = maybeDo reg dorec record isrec as (doXfer as from to amt) - (\rn -> (rf && (rn == from || rn == noName)) || rn == to) + (\rn -> (rf && (elem from rn || rn == [noName])) || + elem to rn) doXfer [] _ _ _ = [] - doXfer (a@(an,ab):as) nf nt e - | an == nf = (an, subFrom ab e) : doXfer as nf nt e - | an == nt = (an, addTo ab e) : doXfer as nf nt e + doXfer (a@(an,ah,ab):as) nf nt e + | an == nf = (an, ah, subFrom ab e) : doXfer as nf nt e + | an == nt = (an, ah, addTo ab e) : doXfer as nf nt e | otherwise = a : doXfer as nf nt e xferTrans _ _ r _ = intErr "xferTrans" r @@ -285,12 +289,12 @@ -- but is this a reconcilable transaction? It reaches across accounts, -- so maybe not -splitTrans :: Maybe Name -> Record -> AccountData -> +splitTrans :: Maybe [Name] -> Record -> AccountData -> Ledger e (Record, [CCSAmt]) AccountData splitTrans reg record@(SplitRec _ ccs (Amount an) (Amount ao)) acc = let newaccs = map doST acc in maybeRecord reg record newaccs (const True) >> return newaccs - where doST (a1,a2) = (a1, scaleBy a2 (CCSAmt ccs (Amount (an/ao)))) + where doST (a1,a2,a3) = (a1, a2, scaleBy a3 (CCSAmt ccs (Amount (an/ao)))) splitTrans _ r _ = intErr "splitTrans" r {- @@ -298,25 +302,27 @@ mkInit reg as = let iaccs = (map (\a -> (getRecName a, maybeToList (gI a))) as) in maybeRecord reg (CommentRec "") iaccs (const True) >> return iaccs - where gI (AccountRec _ _ _ mi) = mi + where gI (AccountRec _ _ _ _ mi) = mi gI r = intErr "mkInit" r -} mkInit :: Monad m => [Record] -> m AccountData -mkInit as = return (map (\a -> (getRecName a, maybeToList (gI a))) as) - where gI (AccountRec _ _ _ mi) = mi +mkInit as = return (map (\a -> (getRecName a, gR a, maybeToList (gI a))) as) + where gI (AccountRec _ _ _ _ mi) = mi gI r = intErr "mkInit" r + gR (AccountRec _ _ r _ _) = r + gR r = intErr "mkInit" r -appTr :: Date -> Maybe Name -> Bool -> [Record] -> AccountData -> +appTr :: Date -> Maybe [Name] -> Bool -> [Record] -> AccountData -> Ledger Record (Record, [CCSAmt]) AccountData appTr _ _ _ [] as = return as appTr d r f (t:ts) as = if getRecDate t > d then return as else case t of - XferRec _ _ _ _ _ _ -> xferTrans r f t as >>= appTr d r f ts + 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 + SplitRec _ _ _ _ -> splitTrans r t as >>= appTr d r f ts NoteRec _ isrec SN_T _ -> (if isrec then recordNil else recordInfo (t,[])) >> appTr d r f ts as @@ -332,6 +338,8 @@ j3 = julianDate (Date (yn + 1) ma da) in abs (jn - j1) <= 7 || abs (jn - j2) <= 7 || abs (jn - j3) <= 7 +-- Show just a transaction, and show transaction & balance, respectively + showT :: (Record, [CCSAmt]) -> IO () showT (t,_) = print t @@ -339,7 +347,11 @@ showTB e@(_,b) = showT e >> mapM_ sB b where sB ccsa = putStrLn ('\t' : show ccsa) -getBalances :: Date -> Date -> Maybe Name -> Bool -> +-- These two routines are for collecting account balances and presenting +-- them in various ways. For now, keep them separate, although the first +-- halves are pretty much the same... maybe merge them later + +getBalances :: Date -> Date -> Maybe [Name] -> Bool -> [Record] -> [Record] -> IO AccountData getBalances date1 date2 reg dorec accts trans = do let (r,i1,e) = runLedger (mkInit accts >>= appTr date2 reg dorec trans) @@ -349,27 +361,54 @@ unless (null i) (putStrLn "Notes:" >> mapM_ ss i >> putStrLn "") return r +plotBalances :: Date -> Date -> Name -> [Record] -> [Record] -> String -> IO () +plotBalances date1 date2 reg accts trans output = + do let (_,i1,e) = + runLedger (mkInit accts >>= appTr date2 (Just [reg]) False trans) + i = dropWhile (\t -> getRecDate (fst t) < date1) i1 + unless (null e) (showErrs "processing errors" e) + unless (null i) (putStrLn "Notes:" >> mapM_ showTB i >> putStrLn "") + putStrLn ("gonna plot: " ++ output) + -- For now, we don't generate "swap prices" internally, so unless the user -- enters some, we won't see any; see also generateImplicitPrices above. +getP :: Name -> Name -> [Record] -> Ledger Record Record () +getP _ _ [] = return () +getP nm dc (p@(PriceRec _ _ (CCSAmt nr1 _) (CCSAmt nr2 _)):ps) + | (nr1 == nm && nr2 == dc) || (nr1 == dc && nr2 == nm) + = recordInfo p >> getP nm dc ps + | nr1 == nm || nr2 == nm = recordErr p >> getP nm dc ps + | otherwise = getP nm dc ps +getP nm dc (_:ps) = getP nm dc ps + +-- These two routines are for collecting prices and presenting them in +-- various ways. For now, keep them separate, although the first halves +-- are pretty much the same... maybe merge them later + 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) + (_,i,e) = runLedger (getP nm dc p2) unless (null e) (doShow "Swap \"Prices\"" e >> putStrLn "") unless (null i) (doShow "Ordinary Prices" i) when (null i && null e) (putStrLn ("No prices known for " ++ show nm)) - where get [] = return () - get (p@(PriceRec _ _ (CCSAmt nr1 _) (CCSAmt nr2 _)):ps) = - if (nr1 == nm && nr2 == dc) || (nr1 == dc && nr2 == nm) - then recordInfo p >> get ps - else if nr1 == nm || nr2 == nm - then recordErr p >> get ps - else get ps - get _ = recordNil - doShow t p = putStrLn t >> mapM_ print (reverse p) + where doShow t p = putStrLn t >> mapM_ print (reverse p) + +plotPrices :: Name -> Name -> Date -> Date -> [Record] -> String -> IO () +plotPrices nm dc date1 date2 prices output = + do let p1 = dropWhile (\t -> date2 < getRecDate t) prices + p2 = takeWhile (\t -> date1 < getRecDate t) p1 + (_,i,e) = runLedger (getP nm dc p2) + pdata = map gp (reverse i) + unless (null e) (putStrLn "There were swap \"prices\" which are ignored") + if null i then putStrLn ("No prices known for " ++ show nm) + else genPlot output nm pdata + where gp (PriceRec d _ (CCSAmt _ (Amount a1)) (CCSAmt _ (Amount a2))) = + (d, [Amount (a2/a1)]) + gp r = intErr "plotPrices" r -- Convert a list of RecurRec records into equivalent list -- of individual transactions, sorted by date 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: help-head.txt,v 1.2 2010/05/10 04:33:16 uwe Exp $ -} +$Id: help-head.txt,v 1.4 2010/06/13 23:46:16 uwe Exp $ -} module UMMHelp (writeHdr, usageMsg) where import Prelude version :: String -version = "0.2.1" +version = "0.2.2" writeHdr :: String writeHdr = @@ -39,6 +39,7 @@ " 'balance' [account-or-group] [date]\n" ++ " 'change' acc-or-inc-or-exp [date-range]\n" ++ " 'list' ['all' | 'accounts' | 'ccs' | 'expenses' | 'incomes' | 'groups']\n" ++ + " 'plot' account-or-ccs [date-range] [output-template]\n" ++ " 'price' ccs [date-range]\n" ++ " 'register' account [date-range]\n" ++ " 'reconcile' [account] [date]\n" ++ @@ -73,6 +74,12 @@ "* 'change' shows the change in the specified account or pseudo-account\n" ++ " in the given date range.\n" ++ "\n" ++ + "* 'plot' generates a plot of the price history of the specified\n" ++ + " currency, commodity, or security, or of the value of the specified\n" ++ + " account, in the given date range.\n" ++ + "\n" ++ + " This is in progress, and only partially implemented.\n" ++ + "\n" ++ "* 'price' shows the price history of the specified currency,\n" ++ " commodity, or security, in the given date range\n" ++ "\n" ++ @@ -109,7 +116,7 @@ " 'ccs' name [desc] [amount] [name]\n" ++ " 'income' name [desc]\n" ++ " 'expense' name [desc]\n" ++ - " 'account' name [date] [desc]\n" ++ + " 'account' [rec] name [date] [desc]\n" ++ " 'group' name [name...]\n" ++ " 'price' date [amount1] name1 amount2 [name2]\n" ++ " 'split' date name amount1 amount2\n" ++ @@ -132,7 +139,8 @@ "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" ++ + "of 'account' or 'income' or 'expense' records, or possibly some 'todo'\n" ++ + "records.\n" ++ "\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" ++ @@ -161,13 +169,16 @@ " 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 as\n" ++ - " transactions which move stuff into or out of the account. An\n" ++ + "* 'account [rec] name [date] [desc]' records specify accounts where\n" ++ + " you 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. 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" ++ + " The optional \"rec\" mark in this case indicates that the account\n" ++ + " is to be hidden, unless it contains something. This is to indicate\n" ++ + " accounts which have been closed.\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" ++ @@ -374,7 +385,11 @@ "\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" ++ + " by whitespace: ie, both 'todo*' and 'todo *' are legal. For 'xfer',\n" ++ + " 'exch', and 'todo' records, it indicates that the given transaction\n" ++ + " has been properly reconciled with a statement, and for 'account'\n" ++ + " records, it indicates that the account is inactive and should not\n" ++ + " be printed in balance inquiries (unless there is something in it).\n" ++ "\n" ++ "* 'id' (in an 'xfer' record) is a sequence of digits: a check number\n" ++ " or other identifying number.\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.47 2010/05/09 06:24:44 uwe Exp $ -} +$Id: UMMParser.hs,v 1.49 2010/05/17 05:24:10 uwe Exp $ -} -- TODO: template := @@ -45,7 +45,8 @@ -- 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 +-- to be specified to the parser; and if the minimal acceptable prefix +-- isn't unique, bad things happen parsePrefixOf :: Int -> String -> Parser String parsePrefixOf n str = @@ -329,11 +330,12 @@ parseAccount = do string "account" + rec <- parseReconcile name <- parseName date <- option startTime (TPCP.try parseDate) desc <- parseOptionalString ival <- option Nothing (TPCP.try (parseCCSAmt >>= return . Just)) - return (AccountRec name date desc ival) + return (AccountRec name date rec desc ival) parseGroup = do string "group" @@ -448,7 +450,7 @@ parseUDate :: String -> Either ParseError Date parseUDate input = parse parseDate "umm date" (' ' : input) -parseCmdBalance, parseCmdBasis, parseCmdChange, parseCmdPrice, +parseCmdBalance, parseCmdBasis, parseCmdChange, parseCmdPlot, parseCmdPrice, parseCmdReconcile, parseCmdRegister, parseCmdToDo, parseCommand :: Date -> Parser Command parseCmdExport, parseCmdList :: Parser Command @@ -493,8 +495,15 @@ "expenses" -> COLExps _ -> intErr "parseListCmd")) +parseCmdPlot now = + do parsePrefixOf 2 "plot" + name <- parseName + (date1, date2) <- parseDateRange now + output <- option (Name "umm_plot") parseName + return (PlotCmd name date1 date2 output) + parseCmdPrice now = - do parsePrefixOf 1 "price" + do parsePrefixOf 2 "price" name <- parseName (date1, date2) <- parseDateRange now return (PriceCmd name date1 date2) @@ -520,6 +529,7 @@ do cmd <- parseCmdChange date <|> parseCmdExport <|> parseCmdList + <|> TPCP.try (parseCmdPlot date) <|> parseCmdPrice date <|> parseCmdToDo date <|> TPCP.try (parseCmdBalance date) diff --git a/UMMPlot.hs b/UMMPlot.hs new file mode 100644 --- /dev/null +++ b/UMMPlot.hs @@ -0,0 +1,72 @@ +{- Copyright 2010 Uwe Hollerbach + +This file is part of umm, Uwe's Money Manager. + +umm is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3 of the License, or (at your +option) any later version. + +umm is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +License for more details. + +You should have received a copy of the GNU General Public License +along with umm; if not, write to the Free Software Foundation, Inc., +59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +$Id: UMMPlot.hs,v 1.3 2010/06/13 23:46:16 uwe Exp $ -} + +module UMMPlot (genPlot) where +import Prelude hiding (putStr, putStrLn, print) +import Data.List +import System.IO(openFile, IOMode(..), hClose) +import System.IO.UTF8 +import System.Process +import Control.Monad + +import UMMData + +-- TODO: a lot more work! + +-- Adjust as needed: for example, for pgm output, use +-- "set terminal pbm gray medium size 800,600\n" ++ + +termo :: String -> String -> String +termo output name = + "set terminal postscript 'Times-Roman' 16\n" ++ + "set output '" ++ output ++ ".ps'\n" ++ + "set title 'Value of " ++ name ++ " over time'\n" ++ + "unset key\n" ++ + "plot '" ++ output ++ ".dat' using 1:2 with lines\n" + +genPlot :: String -> Name -> [(Date, [Amount])] -> IO () +genPlot output name pts = + do fp <- openFile (output ++ ".plot") WriteMode + hPutStr fp (termo output (show name)) + -- TODO: analyze input, generate nice xtics + hClose fp + fd <- openFile (output ++ ".dat") WriteMode + mapM_ (dP fd) pts + hClose fd + doit ("gnuplot " ++ output ++ ".plot") + where dP fp (d,vs) = + hPutStr fp (show (julianDate d)) >> + mapM_ (dY fp) vs >> hPutStrLn fp "" + dY fp r = hPutStr fp (' ' : show r) + +-- If you use the stupid version, you'll get a warning that nothing from +-- System.Process is used... that's ok. + +doit :: String -> IO () + +-- Stupid version that just says what the user needs to do next: +-- use this if you're using ghc 6.8. + +-- doit cmd = putStrLn ("now you must run '" ++ cmd ++ "'") + +-- Smart version that actually runs the command: +-- use this if you're using 6.10 or later. + +doit cmd = putStrLn ("running '" ++ cmd ++ "'") >> system cmd >> return () diff --git a/contrib/umm.vim b/contrib/umm.vim --- a/contrib/umm.vim +++ b/contrib/umm.vim @@ -11,9 +11,9 @@ syn match ummDate /\d\{4\}-\d\{1,2\}-\d\{1,2\}/ syn match String /"\([^"\\]\|\\.\)*"/ -syn match Comment /#.*$/ +syn match Comment /[#;].*$/ syn match ummAmount /\<\d\+\(\.\d*\)\?\>/ -syn match Keyword /xfer\|account\|income\|expense\|price\|ccs\|exch\|sell\|buy\|group\|todo\|split/ +syn match Keyword /account\|anniversary\|annually\|biannually\|bimonthly\|birthday\|biweekly\|buy\|ccs\|daily\|days\|exch\|expense\|group\|income\|monthly\|months\|price\|quarterly\|reconciled\|recurring\|sell\|semiannually\|semimonthly\|semiweekly\|split\|todo\|until\|weekly\|weeks\|xfer\|years/ syn match ummRec /\*/ hi link ummDate Structure