packages feed

UMM 0.2.1 → 0.2.2

raw patch · 8 files changed

+257/−103 lines, 8 filesdep +process

Dependencies added: process

Files

UMM.cabal view
@@ -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 @@ 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
UMM.hs view
@@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMM.hs,v 1.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)
UMMData.hs view
@@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: 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
UMMEval.hs view
@@ -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
UMMHelp.hs view
@@ -16,13 +16,13 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: 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" ++
UMMParser.hs view
@@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMParser.hs,v 1.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 @@  -- 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)
+ UMMPlot.hs view
@@ -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 ()
contrib/umm.vim view
@@ -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