summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorUweHollerbach <>2010-06-13 23:50:32 (GMT)
committerLuite Stegeman <luite@luite.com>2010-06-13 23:50:32 (GMT)
commit1c8a0f95bb1ca51406341df775ea9a22317809b7 (patch)
tree7650c7451e4c94015c50c1eef5d06a215170c361
parentcbe321d79a9e5e8eb524cb32771acf8d47505b59 (diff)
version 0.2.20.2.2
-rw-r--r--UMM.cabal5
-rw-r--r--UMM.hs64
-rw-r--r--UMMData.hs25
-rw-r--r--UMMEval.hs139
-rw-r--r--UMMHelp.hs31
-rw-r--r--UMMParser.hs20
-rw-r--r--UMMPlot.hs72
-rw-r--r--contrib/umm.vim4
8 files changed, 257 insertions, 103 deletions
diff --git a/UMM.cabal b/UMM.cabal
index 2997213..5f285e0 100644
--- 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 <uh@alumni.caltech.edu>
Maintainer: Uwe Hollerbach <uh@alumni.caltech.edu>
@@ -16,7 +16,8 @@ Build-Type: Simple
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
index 66eb003..bdb5c9e 100644
--- a/UMM.hs
+++ b/UMM.hs
@@ -16,7 +16,7 @@ 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: 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 @@ ppAccts es sp =
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 @@ showPos dc ccs da ps as = map f1 as
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 :: Bool -> Date -> [Name] -> Name -> [Record] ->
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 @@ main =
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
index eccaeef..b24db11 100644
--- a/UMMData.hs
+++ b/UMMData.hs
@@ -16,7 +16,7 @@ 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: 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 @@ eqCCSAmtName (CCSAmt n1 _) (CCSAmt n2 _) = n1 == n2
-- 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 @@ data Command = ListDataCmd CmdOpt
| 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 @@ instance Show Command where
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 @@ instance Show Period where
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 @@ showR (CCSRec n d ma nb) =
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 @@ showExp r = error ("internal error at showExp! got " ++ show r)
-- 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 @@ getRecDate _ = startTime -- so it works for every Record
-- 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
index 3697447..243e268 100644
--- a/UMMEval.hs
+++ b/UMMEval.hs
@@ -16,11 +16,12 @@ 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: 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 System.IO.UTF8
import Control.Monad
import UMMData
+import UMMPlot
-- Internal error: complain loudly!
@@ -92,10 +94,11 @@ validateAccts dc ccs accts =
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 @@ classifyRecs rs = cw rs [] [] [] [] [] [] [] []
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 @@ scaleBy qs d = map (s1 (getCN d) (getCA d)) qs
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 @@ maybeDo reg dorec record isrec accs newaccs tst =
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 @@ xferTrans _ _ r _ = intErr "xferTrans" r
-- 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 @@ splitTrans _ r _ = intErr "splitTrans" r
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 @@ appTr d r f (t:ts) as =
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 :: (Record, [CCSAmt]) -> IO ()
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 @@ getBalances date1 date2 reg dorec accts trans =
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
index 4afcd76..3446220 100644
--- a/UMMHelp.hs
+++ b/UMMHelp.hs
@@ -16,13 +16,13 @@ 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: 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 @@ usageMsg prog =
" '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 @@ usageMsg prog =
"* '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 @@ usageMsg prog =
" '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 @@ usageMsg prog =
"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 @@ usageMsg prog =
" 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 @@ usageMsg prog =
"\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
index 2e0d519..2aeda0d 100644
--- a/UMMParser.hs
+++ b/UMMParser.hs
@@ -16,7 +16,7 @@ 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: 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 := <to be determined>
@@ -45,7 +45,8 @@ readAmt ip fp =
-- 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 @@ parseIE =
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 @@ parseURecord input =
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 @@ parseCmdList =
"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 @@ parseCommand date =
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
index 0000000..201eee2
--- /dev/null
+++ b/UMMPlot.hs
@@ -0,0 +1,72 @@
+{- Copyright 2010 Uwe Hollerbach <uh@alumni.caltech.edu>
+
+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
index 13bff25..d3f9e86 100644
--- a/contrib/umm.vim
+++ b/contrib/umm.vim
@@ -11,9 +11,9 @@ endif
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