UMM 0.1.1 → 0.1.3
raw patch · 8 files changed
+339/−173 lines, 8 files
Files
- README +11/−13
- UMM.cabal +2/−3
- UMM.hs +46/−24
- UMMData.hs +61/−21
- UMMEval.hs +77/−31
- UMMHelp.hs +10/−5
- UMMParser.hs +107/−76
- contrib/umm.vim +25/−0
README view
@@ -1,4 +1,4 @@-$Id: README,v 1.3 2009/11/21 06:05:50 uwe Exp $+$Id: README,v 1.6 2009/11/28 16:30:16 uwe Exp $ Umm is an extremely minimal command-line program to read a plain-text ledger file and report balance and other information. Although@@ -6,11 +6,14 @@ commodities, and securities. It doesn't abolutely force you to use double-entry bookkeeping, although it tries to make it easy to do so. -Umm should have no dependencies other than a haskell compiler and-standard libraries, although I've not tested it with anything except-ghc. I've built it with ghc 6.8.3 on an iMac G3 running OSX 10.3.9,-ghc 6.10.3 on an x86 running Ubuntu, and ghc 6.10.x(1?) on an x86-running Windows XP. You should be able to build umm simply by running+Umm has only one dependency outside of a haskell compiler and standard+libraries: in order to support Unicode, it requires the utf8-string+library. I don't know of anything in either umm itself or the+utf8-string library that's specific to ghc, but I have so far only+built it with ghc. I've built it with ghc 6.8.3 on an iMac G3 running+OSX 10.3.9, ghc 6.10.3 on an x86 running Ubuntu, and ghc 6.10.x(1?) on+an x86 running Windows XP. You should be able to build umm simply by+running cabal configure && cabal build @@ -19,10 +22,5 @@ Then look at the two files sample1.dat and sample2.dat; they are very simple examples of ledgers. -If you want to use Unicode currency symbols... umm can't do that yet.-However, please have a look at the shell script ummw in this-distribution. You'll have to do a tiny bit of editing to customize-that shell script, but you should be able to make it turn your-favorite currency symbol(s) into stuff that umm can understand,-then reverse that transformation on the output of umm. Then just-use ummw as a wrapper around umm, and you should be all set!+In the contrib/ subdirectory there is a vim syntax highlighter, contributed+by Nicolas Pouillard -- many thanks!
UMM.cabal view
@@ -1,10 +1,9 @@ Name: UMM-Version: 0.1.1+Version: 0.1.3 Homepage: http://www.korgwal.com/umm/ Author: Uwe Hollerbach <uh@alumni.caltech.edu> Maintainer: Uwe Hollerbach <uh@alumni.caltech.edu>-Synopsis: A small command-line accounting tool:- hledger + bugs - features? maybe...+Synopsis: A small command-line accounting tool: hledger + bugs - features? maybe... Description: This is a very minimal command-line program to read a plain-text ledger file and display balance information and other reports. I could have used hledger or ledger
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.39 2009/11/22 22:09:08 uwe Exp $ -}+$Id: UMM.hs,v 1.43 2009/11/29 23:10:11 uwe Exp $ -} module Main where import Prelude hiding (putStr,putStrLn,readFile,getContents)@@ -34,6 +34,7 @@ import UMMParser import UMMEval +processArgs :: IO (String, Command) processArgs = do prog <- getProgName args <- getArgs@@ -53,11 +54,13 @@ -- It drops blank lines, which is perfectly fine here, but which might be -- a problem elsewhere. +mylines :: String -> [String] mylines str = filter (/= "") (ml str) where ml [] = [] ml s = let (p, s1) = break (\c -> c == '\n' || c == '\r') s in p : (if null s1 then [] else ml (tail s1)) +getLines :: String -> IO [String] getLines fp = (if fp == "-" then getContents else readFile fp) >>= (return . mylines) @@ -65,6 +68,7 @@ -- by date, newest first, and the output is the same, preferring -- explicit over implicit prices in case of a date match. +mergePrices :: [Record] -> [Record] -> [Record] mergePrices [] qs = qs mergePrices ps [] = ps mergePrices pa@(p:ps) qa@(q:qs) =@@ -76,24 +80,27 @@ -- if a suitable one can be found. If none can be found, or if the -- ccs is already in the default units, return Nothing. -equivPrice (CCSAmount n (Amount a)) dc date ps =- if n == dc then Nothing else xlat ps+equivPrice :: CCSAmt -> Name -> Date -> [Record] -> Maybe (CCSAmt, Date)+equivPrice (CCSAmt n (Amount a)) dc date p1s =+ if n == dc then Nothing else xlat p1s where xlat [] = Nothing- xlat ((PriceRec dr _ (CCSAmount nr1 (Amount ar1))- (CCSAmount nr2 (Amount ar2))):ps) =+ xlat ((PriceRec dr _ (CCSAmt nr1 (Amount ar1))+ (CCSAmt nr2 (Amount ar2))):ps) = if compare date dr /= LT && n == nr1 && nr2 == dc- then Just ((CCSAmount dc (Amount (a*ar2/ar1))), dr)+ then Just ((CCSAmt dc (Amount (a*ar2/ar1))), dr) else xlat ps xlat (_:ps) = xlat ps -- for non-PriceRec records -- Translate price if possible +reprice :: CCSAmt -> Name -> Date -> [Record] -> CCSAmt reprice ccs dc date prices = let ep = equivPrice ccs dc date prices in if isJust ep then fst (fromJust ep) else ccs -- Pretty-print accounts +ppAccts :: [(Name, [String])] -> Int -> [String] ppAccts es sp = concat (map (ppe (sp + maximum (map (length . getN . fst) es))) es) where getN (Name n) = n@@ -102,18 +109,21 @@ in zipWith gl ((take l (show m ++ isp)) : repeat (take l isp)) as gl a b = concat [a, b] +showPos :: Name -> Date -> [Record] -> AccountData -> [(Name, [String])] showPos dc da ps as = map f1 as where f1 (n1,es) = (n1, if null es then ["[empty]"] else map f2 es) f2 c2 = let sv = show c2 ep = equivPrice c2 dc da ps jep = fromJust ep- CCSAmount n (Amount a) = fst jep- jer = CCSAmount n (Amount (roundP 2 a))- sp = "\t~" ++ show jer ++ " (" ++ show (snd jep) ++ ")"+ CCSAmt n (Amount a) = fst jep+ jer = CCSAmt n (Amount (roundP 2 a))+ sd d = if d == start_time then "" else " (" ++ show d ++ ")"+ sp = "\t~" ++ show jer ++ sd (snd jep) pad = " " ++ concat (take (18 - length sv) (repeat " ")) in if isJust ep then sv ++ pad ++ sp else sv +selAccts :: [Name] -> AccountData -> AccountData selAccts names accs = (if length names == 1 && head names == noName then id@@ -123,12 +133,13 @@ -- This might not be ultimately exact, but it's for converted prices -- which might be a couple of days out of date anyway, so no big deal +roundP :: Int -> Rational -> Rational roundP np val =- if val < 0 then negate (rp np (negate val)) else rp np val- where rp np val =+ if val < 0 then negate (rp (negate val)) else rp val+ where rp v1 = let e1 = 10^(max 0 np) e2 = 10*e1- vs = (fromInteger e2)*val+ vs = (fromInteger e2)*v1 n = numerator vs d = denominator vs q1 = quot n d@@ -139,10 +150,11 @@ -- contain (names of) other account-groups, including recursively, and -- loops aren't prohibited either... need to handle all those cases. -expandGroup as gs ag =+expandGroup :: [Record] -> [Record] -> Name -> [Name]+expandGroup aas ggs ag = if ag == noName || ag == todoName then [ag]- else ff [ag] (map getRecName as) (map ggt gs) [] []+ else ff [ag] (map getRecName aas) (map ggt ggs) [] [] where ff [] _ _ am _ = am ff (q:qs) as gs am ab | elem q am || elem q ab = ff qs as gs am ab@@ -152,23 +164,28 @@ | otherwise = error ("unknown account or group! " ++ show q) ggt (GroupRec n as) = (n,as)+ ggt r = error ("internal error at expandGroup! got " ++ show r) +doList :: CmdOpt -> Name -> [Record] -> [Record] ->+ [Record] -> [Record] -> [Record] -> IO () doList w dc ccs accts grps incs exps = do when (chk w COLCCS) (putStrLn "# Currencies, Commodities, Securities\n" >> putStrLn ("# default ccs " ++ (show dc) ++ "\n") >> sh ccs)- when (chk w COLAccts) (putStrLn "\n# Accounts\n" >> sh accts)- when (chk w COLGrps) (putStrLn "\n# Groups\n" >> sh grps)- when (chk w COLIncs) (putStrLn "\n# Incomes\n" >> sh incs)- when (chk w COLExps) (putStrLn "\n# Expenses\n" >> sh exps)+ when (chk w COLAccs) (putStrLn "\n# Accounts\n" >> sh accts)+ when (chk w COLGrps) (putStrLn "\n# Groups\n" >> sh grps)+ when (chk w COLIncs) (putStrLn "\n# Incomes\n" >> sh incs)+ when (chk w COLExps) (putStrLn "\n# Expenses\n" >> sh exps) where chk w1 w2 = w1 == w2 || w1 == COLAll sh = mapM_ (putStrLn . show) +doBalance :: Date -> [Name] -> Name -> [Record] ->+ [Record] -> [Record] -> IO () doBalance date names dc accts trans prices = do final <- getBalances start_time date Nothing False accts trans let fsel = selAccts names final fp = map (\e -> reprice e dc date prices) (concat (map snd fsel))- gp = groupBy eqCCSAmountName (sortBy cmpCCSAmountName fp)+ gp = groupBy eqCCSAmtName (sortBy cmpCCSAmtName fp) sp = filter (\e -> ccsA e /= 0) (map sumCCS gp) if length names == 1 && head names == todoName then putStr ""@@ -176,16 +193,20 @@ mapM_ putStrLn (ppAccts (showPos dc date prices fsel) 8) >> putStrLn ("Grand total: ~" ++ show sp) where sumCCS cs =- CCSAmount (ccsN (head cs)) (Amount (roundP 2 (sum (map ccsA cs))))- ccsN (CCSAmount n _) = n- ccsA (CCSAmount _ (Amount a)) = a+ CCSAmt (ccsN (head cs)) (Amount (roundP 2 (sum (map ccsA cs))))+ ccsN (CCSAmt n _) = n+ ccsA (CCSAmt _ (Amount a)) = a +doRegister :: Date -> Date -> Name -> Name -> [Record] ->+ [Record] -> [Record] -> Bool -> IO () doRegister d1 d2 name dc accts trans prices dorec = do final <- getBalances d1 d2 (Just name) dorec accts trans putStrLn ((if dorec then "Reconciled" else "Account") ++ " balance as of " ++ show d2) mapM_ putStrLn (ppAccts (showPos dc d2 prices (selAccts [name] final)) 8) +doChange :: Bool -> Date -> Date -> Name -> Name ->+ [Record] -> [Record] -> IO () doChange verbose d1 d2 name dc accts trans = do let aux = if notElem name (map getRecName accts) then [AccountRec name d1 ""]@@ -198,19 +219,20 @@ putStrLn (" to " ++ show d2) mapM_ putStrLn (ppAccts (showPos dc d2 [] (selAccts [name] final)) 8) +main :: IO () main = do (file, action) <- processArgs recs <- getLines file >>= mapM (return . parseURecord) >>= validateRecs let (dc, ccs, incs, exps, accts, grps, trans, p1) = classifyRecs recs validateTransPrices ccs incs exps accts (trans ++ p1)- let p2 = generateImplicitPrices dc trans+ let p2 = generateImplicitPrices dc trans ccs prices = mergePrices (reverse p1) p2 case action of ListDataCmd w -> doList w dc ccs accts grps incs exps BalanceCmd name date -> doBalance date (expandGroup accts grps name) dc accts trans prices- BasisCmd name date ->+ BasisCmd _ _ -> putStrLn "Sorry, basis command is not implemented yet!" ToDoCmd date -> doBalance date [todoName] dc accts trans prices
UMMData.hs view
@@ -16,14 +16,14 @@ 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.30 2009/11/22 22:43:06 uwe Exp $ -}+$Id: UMMData.hs,v 1.36 2009/11/29 23:10:11 uwe Exp $ -} module UMMData (Name(..), Date(..), Amount(..), start_time, Command(..), CmdOpt(..), Record(..), genDate, getRecDate, cmpRecDate, getRecName, cmpRecName, Ledger(..), runLedger, getResult, getInfo, getErrs, recordInfo, recordErr, recordNil, BSE(..),- CCSAmt(..), cmpCCSAmountName, eqCCSAmountName,+ CCSAmt(..), cmpCCSAmtName, eqCCSAmtName, AccountData, noName, todoName, joinDrop, isLeap, validDate) where import Prelude import Data.Char@@ -37,8 +37,11 @@ instance Show Name where show (Name name) = name +noName, todoName, nilName :: Name+ noName = Name "" todoName = Name " todo "+nilName = Name " nil " data Date = Date Int Int Int deriving (Eq) @@ -52,6 +55,7 @@ dm = compare m1 m2 in if dy /= EQ then dy else if dm /= EQ then dm else compare d1 d2 +genDate :: CalendarTime -> Date genDate (CalendarTime {ctYear = y, ctMonth = m, ctDay = d}) = let m2 = case m of January -> 1@@ -68,12 +72,14 @@ December -> 12 in Date y m2 d +start_time :: Date start_time = Date (-4003) 10 23 -- 9 AM (GMT) newtype Amount = Amount Rational deriving (Eq, Ord) instance Show Amount where show (Amount amt) = if amt < 0 then "-" ++ shRat (-amt) else shRat amt +shRat :: Rational -> String shRat val = let n = numerator val d = denominator val@@ -89,21 +95,30 @@ then if e10 == 0 then show n else vsi ++ "." ++ vsf else show n ++ "/" ++ show d +divout :: Integer -> Integer -> (Int, Integer) divout n q = doit 0 n where doit e v = if rem v q == 0 then doit (e + 1) (quot v q) else (e,v) -data CCSAmt = CCSAmount Name Amount+data CCSAmt = CCSAmt Name Amount instance Show CCSAmt where- show (CCSAmount name amount) = joinDrop [show amount, show name]+ show (CCSAmt name amount) = joinDrop [show amount, show name] --- Compare two CCSAmounts by name+-- Compare two CCSAmts by name -cmpCCSAmountName (CCSAmount n1 _) (CCSAmount n2 _) = compare n1 n2-eqCCSAmountName (CCSAmount n1 _) (CCSAmount n2 _) = n1 == n2+cmpCCSAmtName :: CCSAmt -> CCSAmt -> Ordering+cmpCCSAmtName (CCSAmt n1 _) (CCSAmt n2 _) = compare n1 n2 +eqCCSAmtName :: CCSAmt -> CCSAmt -> Bool+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])]+ data CmdOpt = COLAll | COLCCS- | COLAccts+ | COLAccs | COLGrps | COLIncs | COLExps@@ -112,7 +127,7 @@ instance Show CmdOpt where show COLAll = "all" show COLCCS = "ccs"- show COLAccts = "accounts"+ show COLAccs = "accounts" show COLGrps = "groups" show COLIncs = "incomes" show COLExps = "expenses"@@ -151,13 +166,13 @@ show S = "sell" show E = "exch" -data Record = CCSRec Name String+data Record = CCSRec Name String (Maybe CCSAmt) | IncomeRec Name String | ExpenseRec Name String | AccountRec Name Date String | GroupRec Name [Name] | PriceRec Date Bool CCSAmt CCSAmt- | XferRec Date Bool Name Name CCSAmt String Int+ | XferRec Date Bool Name Name CCSAmt String String | ExchRec BSE Date Bool Name CCSAmt CCSAmt String | SplitRec Date Name Amount Amount | CommentRec String@@ -169,23 +184,32 @@ -- We use "show str" here to add quotes and escape any escapables +optStr :: String -> String optStr str = if str == "" then "" else show str +shRec :: Bool -> String shRec rec = if rec then "*" else "" +mAmt :: Maybe CCSAmt -> String+mAmt Nothing = ""+mAmt (Just a) = show a++joinDrop :: [String] -> String joinDrop ss = intercalate " " (filter (\s -> s /= "") ss) -showR (CCSRec n d) = joinDrop ["ccs", show n, optStr d]+showR :: Record -> String+showR (CCSRec n d a) = joinDrop ["ccs", show n, optStr d, mAmt a] 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) = joinDrop ["account", show n, show da, optStr de] showR (GroupRec n as) = joinDrop (["group", show n] ++ map show as) showR (PriceRec d imp c1 c2) =- joinDrop ["price", shRec imp, show d, show c1, show c2]+ (if imp then "[" else "") +++ joinDrop ["price", show d, show c1, show c2] +++ (if imp then "]" else "") -showR (XferRec d r a1 a2 c memo chknum) =- joinDrop ["xfer", shRec r, show d, show a1, show a2,- show c, optStr memo, (if chknum == 0 then "" else show chknum)]+showR (XferRec d r a1 a2 c m i) =+ joinDrop ["xfer", shRec r, show d, show a1, show a2, show c, optStr m, i] showR (ExchRec t d r a c1 c2 memo) = let hs = if t == S then [show c2, show c1] else [show c1, show c2]@@ -204,6 +228,7 @@ -- Get the date (or at any rate /some/ date) from a Record +getRecDate :: Record -> Date getRecDate (AccountRec _ d _) = d getRecDate (PriceRec d _ _ _) = d getRecDate (XferRec d _ _ _ _ _ _) = d@@ -214,19 +239,21 @@ -- Get the name (or at any rate /some/ name) from a Record -getRecName (CCSRec n _) = n+getRecName :: Record -> Name+getRecName (CCSRec n _ _) = n getRecName (IncomeRec n _) = n getRecName (ExpenseRec n _) = n getRecName (AccountRec n _ _) = n getRecName (GroupRec n _) = n-getRecName _ = Name " nil " -- so it works for every Record+getRecName _ = nilName -- so it works for every Record --- Compare two Records by date+-- Compare two Records+cmpRecDate, cmpRecName :: Record -> Record -> Ordering +-- by date cmpRecDate v1 v2 = compare (getRecDate v1) (getRecDate v2) --- Compare two Records by name-+-- by name cmpRecName v1 v2 = compare (getRecName v1) (getRecName v2) -- Ledger monad: essentially a parametrized bi-level version of the Logger@@ -237,22 +264,32 @@ newtype Ledger e i r = Ledger (r, [i], [e]) deriving (Show) +runLedger :: Ledger e i r -> (r,[i],[e]) runLedger (Ledger a) = a++getResult :: Ledger e i r -> r getResult (Ledger (r,_,_)) = r++getInfo :: Ledger e i r -> [i] getInfo (Ledger (_,i,_)) = i++getErrs :: Ledger e i r -> [e] getErrs (Ledger (_,_,e)) = e -- Record a message +recordInfo :: i -> Ledger e i () recordInfo i = Ledger ((), [i], []) -- Record an error +recordErr :: e -> Ledger e i () recordErr e = Ledger ((), [], [e]) -- Record nothing: a placeholder for conditionals: -- if someCond then recordErr "someErr" else recordNil +recordNil :: Ledger e i () recordNil = Ledger ((), [], []) -- Note that because we use append (++) for lists here, this is fairly@@ -272,8 +309,11 @@ -- Some miscellany -- divisible by 4 except if divisible by 100 except if divisible by 400++isLeap :: Int -> Bool isLeap y = rem y 4 == 0 && (rem y 100 /= 0 || rem y 400 == 0) +validDate :: Date -> Bool validDate (Date y m d) = let lim = [ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ] !! m in (m >= 1 && m <= 12 && d >= 1 &&
UMMEval.hs view
@@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMEval.hs,v 1.24 2009/11/22 22:09:08 uwe Exp $ -}+$Id: UMMEval.hs,v 1.28 2009/11/29 23:10:12 uwe Exp $ -} module UMMEval (validateRecs, classifyRecs, validateTransPrices, generateImplicitPrices, getBalances, getPrices) where@@ -28,10 +28,22 @@ import UMMData +-- Internal error: complain loudly!++intErr :: (Show i) => String -> i -> o+intErr loc w =+ error ("internal error at " ++ loc ++ "\ngot unexpected " ++ show w)++-- Add the default ccs to a CCSAmt that has a blank ccs++addDCCA :: Name -> CCSAmt -> CCSAmt+addDCCA dc c@(CCSAmt n a) = if n == noName then CCSAmt dc a else c+ -- Initial validation of records: filter out comments, highlight parse -- errors, and check that dates are valid. This is kind of a trivial -- use of runLedger, it could almost be accomplished by partition. +validateRecs :: [Record] -> IO [Record] validateRecs records = do let (_,i,e) = runLedger (chk records) if length e == 0@@ -49,20 +61,12 @@ -- Classify records by type and sort accounts and -- transaction-type records by date or name as needed -uErr v1 v2 =- error ("duplicate records\n " ++ show v1 ++ "\n " ++ show v2)--uChk [] = []-uChk s@(_:[]) = s-uChk v@(v1:v2:[]) =- if getRecName v1 == getRecName v2 then uErr v1 v2 else v-uChk (v1:v2:vs) =- if getRecName v1 == getRecName v2 then uErr v1 v2 else v1 : uChk (v2:vs)- -- TODO: should really check that there are no duplications among -- account names and account group names together, rather than -- separately (or just account groups, right now) +classifyRecs :: [Record] -> (Name, [Record], [Record], [Record],+ [Record], [Record], [Record], [Record]) classifyRecs recs = cw recs [] [] [] [] [] [] [] where cw [] c i e a g t p = let dc = if null c then Name "zorkmid" else getRecName (last c)@@ -70,7 +74,7 @@ cw (r:rs) c i e a g t p = case r of CommentRec _ -> cw rs c i e a g t p- CCSRec _ _ -> cw rs (r:c) i e a g t p+ CCSRec _ _ _ -> cw rs (r:c) i e a g t p IncomeRec _ _ -> cw rs c (r:i) e a g t p ExpenseRec _ _ -> cw rs c i (r:e) a g t p AccountRec _ _ _ -> cw rs c i e (r:a) g t p@@ -78,6 +82,13 @@ PriceRec _ _ _ _ -> cw rs c i e a g t (r:p) _ -> cw rs c i e a g (r:t) p vsN rs = uChk (sortBy cmpRecName rs)+ uChk [] = []+ uChk s@(_:[]) = s+ uChk v@(v1:v2:[]) = uc1 v1 v2 v+ uChk v@(v1:v2:_) = uc1 v1 v2 (v1 : uChk (tail v))+ uc1 v1 v2 r = if getRecName v1 == getRecName v2 then uErr v1 v2 else r+ uErr v1 v2 =+ error ("duplicate records\n " ++ show v1 ++ "\n " ++ show v2) asD dc rs = sortBy cmpRecDate (reverse (map (addDC dc) rs)) addDC dc (PriceRec d imp ccsa1 ccsa2) = PriceRec d imp ccsa1 (addDCCA dc ccsa2)@@ -86,8 +97,6 @@ addDC dc (ExchRec t d f acc ccsa1 ccsa2 m) = ExchRec t d f acc (addDCCA dc ccsa1) (addDCCA dc ccsa2) m addDC _ r = r- addDCCA dc c@(CCSAmount n a) =- if n == noName then CCSAmount dc a else c -- Second validation of transactions: check that all from & to accounts -- are valid, that splits aren't 1/0 or 0/1, etc@@ -96,6 +105,8 @@ -- through runLedger as above? then we could generate multiple output -- records for (some of) each input record +validateTransPrices :: [Record] -> [Record] -> [Record] ->+ [Record] -> [Record] -> IO () validateTransPrices ccs incs exps accts tps = do let bads = filter chk tps when (length bads > 0)@@ -103,13 +114,13 @@ >> mapM_ (putStrLn . show) bads >> error "quitting now") where chk (SplitRec _ c (Amount amt1) (Amount amt2)) = amt1 == 0 || amt2 == 0 || notIn c ccs- chk (PriceRec _ _ (CCSAmount c1 amt1) (CCSAmount c2 _)) =+ chk (PriceRec _ _ (CCSAmt c1 amt1) (CCSAmt c2 _)) = amt1 == Amount 0 || notIn c1 ccs || notIn c2 ccs- chk (XferRec _ _ af at (CCSAmount n _) _ _) =+ chk (XferRec _ _ af at (CCSAmt n _) _ _) = (notIn af incs && notIn af accts) || (notIn at exps && notIn at accts) || notIn n ccs- chk (ExchRec _ _ _ a (CCSAmount c1 _) (CCSAmount c2 _) _) =+ chk (ExchRec _ _ _ a (CCSAmt c1 _) (CCSAmt c2 _) _) = notIn a accts || notIn c1 ccs || notIn c2 ccs chk (ToDoRec _ _ _) = False chk _ = True@@ -121,22 +132,35 @@ -- want. Only generate info for transactions involving the default currency, -- other stuff is too hard to untangle at least for now. -generateImplicitPrices dc trs = gip [] trs- where gip acc [] = filter pr acc+generateImplicitPrices :: Name -> [Record] -> [Record] -> [Record]+generateImplicitPrices dc trs ccs = gip (geni ccs) trs+ where geni = (map gii) . (filter iJ) . (filter nD)+ nD r = (getRecName r /= dc)+ iJ (CCSRec _ _ ma) = isJust ma+ iJ r = intErr "generateImplicitPrices:1" r+ gii (CCSRec n _ (Just a)) =+ PriceRec start_time True (CCSAmt n (Amount 1)) (addDCCA dc a)+ gii r = intErr "generateImplicitPrices:2" r+ gip acc [] = filter pr acc gip acc (t@(ExchRec _ _ _ _ _ _ _):ts) = gip ((genp t) : acc) ts gip acc (_:ts) = gip acc ts- genp (ExchRec _ date _ _ (CCSAmount n1 a1) (CCSAmount n2 a2) _)+ genp (ExchRec _ date _ _ (CCSAmt n1 a1) (CCSAmt n2 a2) _) | n1 == dc = PriceRec date True (nC n2 a2 a2) (nC n1 a1 a2) | n2 == dc = PriceRec date True (nC n1 a1 a1) (nC n2 a2 a1) | otherwise = CommentRec "general exchange, no price generated"+ genp r = intErr "generateImplicitPrices:3" r pr (PriceRec _ _ _ _) = True pr _ = False nC n (Amount a1) (Amount a2) =- CCSAmount n (Amount (if a2 == 0 then a1 else a1/a2))+ CCSAmt n (Amount (if a2 == 0 then a1 else a1/a2)) -getCN (CCSAmount n _) = n-getCA (CCSAmount _ (Amount a)) = a+getCN :: CCSAmt -> Name+getCN (CCSAmt n _) = n +getCA :: CCSAmt -> Rational+getCA (CCSAmt _ (Amount a)) = a++addTo :: [CCSAmt] -> CCSAmt -> [CCSAmt] addTo [] n = [n] addTo (q:qs) d = let qn = getCN q@@ -145,30 +169,35 @@ dq = getCA d nq = qq + dq in if qn == dn- then if nq == 0- then qs- else (CCSAmount qn (Amount nq)) : qs+ then if nq == 0 then qs else (CCSAmt qn (Amount nq)) : qs else q : addTo qs d -subFrom acc d = addTo acc (CCSAmount (getCN d) (Amount (-(getCA d))))+subFrom :: [CCSAmt] -> CCSAmt -> [CCSAmt]+subFrom acc d = addTo acc (CCSAmt (getCN d) (Amount (-(getCA d)))) +scaleBy :: [CCSAmt] -> CCSAmt -> [CCSAmt] scaleBy qs d = map (s1 (getCN d) (getCA d)) qs where s1 dn dq q = let qn = getCN q qq = getCA q- in if qn == dn then (CCSAmount qn (Amount (qq * dq))) else q+ in if qn == dn then (CCSAmt qn (Amount (qq * dq))) else q +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 length acc > 0 then snd (head acc)- else [CCSAmount noName (Amount 0)]+ else [CCSAmt noName (Amount 0)] in if isJ && (tst rn || rn == noName) then recordInfo (record, nb) else recordNil +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 then if isrec@@ -176,6 +205,8 @@ else maybeRecord reg record newaccs tst >> return accs else maybeRecord reg record newaccs tst >> return newaccs +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)@@ -184,7 +215,10 @@ if an == n then (an, subFrom (addTo ab en) eo) : as else (an,ab) : doExch as n en eo+exchTrans _ _ r _ = intErr "exchTrans" r +xferTrans :: Maybe Name -> Bool -> Record -> AccountData ->+ Ledger e (Record, [CCSAmt]) AccountData xferTrans reg dorec record@(XferRec _ isrec from to amt _ _) accs = maybeDo reg dorec record isrec accs (doXfer accs from to amt) (\rn -> rn == from || rn == to)@@ -193,19 +227,26 @@ | an == nf = (an, subFrom ab e) : doXfer as nf nt e | an == nt = (an, addTo ab e) : doXfer as nf nt e | otherwise = a : doXfer as nf nt e+xferTrans _ _ r _ = intErr "xferTrans" r -- TODO: look into account and see if split is applicable? yeah... cleaner -- Also: does maybeDo apply here, too? I think probably it should... -- but is this a reconcilable transaction? It reaches across accounts, -- so maybe not +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 (\_ -> True) >> return newaccs- where doST (a1,a2) = (a1, scaleBy a2 (CCSAmount ccs (Amount (an/ao))))+ where doST (a1,a2) = (a1, scaleBy a2 (CCSAmt ccs (Amount (an/ao))))+splitTrans _ r _ = intErr "splitTrans" r +mkInit :: Monad m => [Record] -> m AccountData mkInit as = return (map (\a -> (getRecName a, [])) as) +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@@ -219,11 +260,15 @@ >> appTr d r f ts as _ -> recordErr t >> appTr d r f ts as +showT :: (Record, [CCSAmt]) -> IO () showT (t,_) = putStrLn (show t) +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 ->+ [Record] -> [Record] -> IO AccountData getBalances date1 date2 reg dorec accts trans = do let (r,i1,e) = runLedger (mkInit accts >>= appTr date2 reg dorec trans) i = dropWhile (\t -> compare (getRecDate (fst t)) date1 == LT) i1@@ -237,6 +282,7 @@ -- For now, we don't generate "swap prices" internally, so unless the user -- enters some, we won't see any; see also generateImplicitPrices above. +getPrices :: Name -> Name -> Date -> [Record] -> IO () getPrices nm dc date prices = do let p1 = dropWhile (\t -> compare date (getRecDate t) == LT) prices (_,i,e) = runLedger (get p1)@@ -245,7 +291,7 @@ when (length e == 0 && length i == 0) (putStrLn ("No prices known for " ++ show nm)) where get [] = return ()- get (p@(PriceRec _ _ (CCSAmount nr1 _) (CCSAmount nr2 _)):ps) =+ 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)
UMMHelp.hs view
@@ -16,14 +16,16 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMHelp.hs,v 1.16 2009/11/22 22:09:09 uwe Exp $ -}+$Id: UMMHelp.hs,v 1.19 2009/11/29 23:10:13 uwe Exp $ -} module UMMHelp (writeHdr, usageMsg) where import Prelude hiding (putStr,putStrLn) import System.IO.UTF8 -version = "0.1.1"+version :: String+version = "0.1.3" +writeHdr :: IO () writeHdr = putStrLn ("Uwe's Money Manager -- umm " ++ version ++@@ -34,6 +36,7 @@ -- TODO: store these unadorned in some separate text files, and use -- a program (Template Haskell?) to turn them into proper source code +usageMsg :: String -> String usageMsg prog = "usage is '" ++ prog ++ " <ledger-file> <command> <options>'\n" ++ "where <command> and <options> can be any of the following:\n" ++@@ -116,7 +119,7 @@ "\n" ++ "There are several kinds of records in a ledger file:\n" ++ "\n" ++- " 'ccs' name [desc]\n" +++ " 'ccs' name [desc] [amount]\n" ++ " 'income' name [desc]\n" ++ " 'expense' name [desc]\n" ++ " 'account' name [date] [desc]\n" ++@@ -149,7 +152,7 @@ "\n" ++ "The meaning of each record type is as follows:\n" ++ "\n" ++- "* 'ccs name [desc]' describes a currency or commodity or\n" +++ "* 'ccs name [desc] [amount]' describes a currency or commodity or\n" ++ " security: the things you want to keep track of. The first\n" ++ " ccs record in the ledger file is the default unit; my ledger\n" ++ " file has 'ccs US$' very near the top. However, you don't\n" ++@@ -160,7 +163,9 @@ " and 'sell') records, but they probably won't be very useful,\n" ++ " since all you can do is to trade one amount of Zorkmids for\n" ++ " another. The 'desc' field in a ccs record is currently just\n" ++- " for documentation, it's not used by the program.\n" +++ " for documentation, it's not used by the program. The optional\n" +++ " 'amount' field is for specifying the initial price of this ccs\n" +++ " in units of the default ccs.\n" ++ "\n" ++ "\n" ++ "* 'account name [date] [desc]' records specify accounts where you\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.29 2009/11/22 22:09:09 uwe Exp $ -}+$Id: UMMParser.hs,v 1.34 2009/11/29 23:10:14 uwe Exp $ -} -- TODO: template := <to be determined> @@ -28,9 +28,11 @@ import UMMData +readInt :: String -> Integer readInt s = foldl ma 0 s where ma v1 v2 = 10*v1 + (toInteger (digitToInt v2)) +readAmt :: String -> String -> Rational readAmt ip fp = let l = length fp e = 10^l@@ -38,12 +40,16 @@ fv = readInt fp in (e*iv + fv) % e +trimspace :: String -> String trimspace str = f (f str) where f = dropWhile isSpace . reverse -- Hide parsec's spaces and substitute this one: -- want "spaces" to mean an actual something there +spaces, parseString, parseOptionalString, parseXferID :: Parser String+escChar, currency_symbol, other_symbol :: Parser Char+ spaces = many1 space escChar =@@ -75,70 +81,76 @@ -- Currency symbols: do allow these as the first char of a name -- gathered from various places on the web, mainly unicode.org -currency_symbol = oneOf $- map chr [0x24, -- dollar- 0xa2, -- cent- 0xa3, -- pound- 0xa4, -- generic currency symbol- 0xa5, -- yen- 0x192, -- florin- 0x9f2, -- Bengali rupee 1- 0x9f3, -- Bengali rupee 2- 0xaf1, -- gujarati rupee- 0xbf9, -- Tamil rupee- 0xe2f, -- Thai baht- 0x17db, -- Khmer currency symbol- 0x20a0, -- euro-currency (not euro)- 0x20a1, -- colon- 0x20a2, -- Brazilian cruzeiro- 0x20a3, -- French franc- 0x20a4, -- Italian lira- 0x20a5, -- mill- 0x20a6, -- Nigerian naira- 0x20a7, -- Spanish peseta- 0x20a8, -- Indian rupee- 0x20a9, -- Korean won- 0x20aa, -- Israeli new sheqel- 0x20ab, -- Vietnamese dong- 0x20ac, -- European euro- 0x20ad, -- Laotian kip- 0x20ae, -- Mongolian tugrik- 0x20af, -- Greek drachma- 0x20b0, -- German pfennig- 0x20b1, -- Phillipine peso- 0x20b2, -- Paraguayan guarani ???- 0x20b3, -- austral ???- 0x20b4, -- Ukrainian hryvnia ???- 0x20b5, -- Ghanaian cedi ???- 0x20b6, -- livre tournois ???- 0x20b7, -- spesmilo ???- 0x20b8, -- tenge ???- 0x3350, -- yuan 1- 0x5143, -- Chinese yuan- 0x5186, -- yen 2- 0x5706, -- yen/yuan variant- 0x570e, -- yen/yuan variant- 0x5713, -- yuan variant- 0x571c, -- yuan variant- 0xa838, -- North Indic rupee ???- 0xfdfc] -- Iranian rial+currency_symbol =+ oneOf ['\x24', -- dollar+ '\xa2', -- cent+ '\xa3', -- pound+ '\xa4', -- generic currency symbol+ '\xa5', -- yen+ '\x192', -- florin+ '\x9f2', -- Bengali rupee 1+ '\x9f3', -- Bengali rupee 2+ '\xaf1', -- gujarati rupee+ '\xbf9', -- Tamil rupee+ '\xe2f', -- Thai baht+ '\x17db', -- Khmer currency symbol+ '\x20a0', -- euro-currency (not euro)+ '\x20a1', -- colon+ '\x20a2', -- Brazilian cruzeiro+ '\x20a3', -- French franc+ '\x20a4', -- Italian lira+ '\x20a5', -- mill+ '\x20a6', -- Nigerian naira+ '\x20a7', -- Spanish peseta+ '\x20a8', -- Indian rupee+ '\x20a9', -- Korean won+ '\x20aa', -- Israeli new sheqel+ '\x20ab', -- Vietnamese dong+ '\x20ac', -- European euro+ '\x20ad', -- Laotian kip+ '\x20ae', -- Mongolian tugrik+ '\x20af', -- Greek drachma+ '\x20b0', -- German pfennig+ '\x20b1', -- Phillipine peso+ '\x20b2', -- Paraguayan guarani ???+ '\x20b3', -- austral ???+ '\x20b4', -- Ukrainian hryvnia ???+ '\x20b5', -- Ghanaian cedi ???+ '\x20b6', -- livre tournois ???+ '\x20b7', -- spesmilo ???+ '\x20b8', -- tenge ???+ '\x3350', -- yuan 1+ '\x5143', -- Chinese yuan+ '\x5186', -- yen 2+ '\x5706', -- yen/yuan variant+ '\x570e', -- yen/yuan variant+ '\x5713', -- yuan variant+ '\x571c', -- yuan variant+ '\xa838', -- North Indic rupee ???+ '\xfdfc'] -- Iranian rial -- Non-currency symbols: don't allow these as the first character of a name other_symbol = oneOf "!%&*+-/:<=>?@^_~" +parseName :: Parser Name parseName = do spaces first <- letter <|> currency_symbol rest <- many (letter <|> currency_symbol <|> digit <|> other_symbol) return (Name (first:rest)) +parseOptionalName :: Parser Name parseOptionalName = option (Name "") (TPCP.try parseName) +parseInt :: Parser Integer parseInt = many1 digit >>= return . readInt +parseXferID = spaces >> many1 (digit <|> letter <|> oneOf "-/_@")+ -- Parse first alternative for amounts: \d+(\.\d*)? +parseAmt1, parseAmt2, parseAmt3 :: Parser Rational parseAmt1 = do ip <- many1 digit fp <- option "" (char '.' >> many digit)@@ -146,23 +158,18 @@ -- Parse second alternative for amounts: \.\d+ -parseAmt2 =- do char '.'- fp <- many1 digit- return (readAmt "0" fp)+parseAmt2 = char '.' >> many1 digit >>= (\fp -> return (readAmt "0" fp)) -- Parse third alternative for amounts: \d+/\d+: this is how rationals -- get displayed if they're not integers scaled by a power of 10, so -- we'd better be able to handle them... -parseAmt3 =- do n <- parseInt- char '/'- d <- parseInt- return (n%d)+parseAmt3 = parseInt >>= (\n -> char '/' >> parseInt >>= (\d -> return (n%d))) -- Parse a floating-point-formatted number as either \d+(\.\d*)? or \.\d+ +parseAmount, parseOptionalAmount :: Parser Amount+ parseAmount = do many space s <- option '+' (oneOf "+-")@@ -179,31 +186,44 @@ -- whether days come first or months, and also no implicit 19xx or 20xx -- or whatever. +parseDate :: Parser Date parseDate = do spaces y <- parseInt m <- pMS '/' <|> pMS '-' d <- parseInt return (Date (fromInteger y) (fromInteger m) (fromInteger d))- where pMS s =- do char s- m <- parseInt- char s- return m+ where pMS s = char s >> parseInt >>= (\m -> char s >> return m) +parseReconcile :: Parser Bool parseReconcile = option False (TPCP.try (many space >> char '*' >> return True)) +intErr :: String -> o+intErr loc = error ("internal error at " ++ loc ++ ", please report this")+ -- The top-level record parsers -parseCIE =- do rtype <- string "ccs" <|> string "income" <|> string "expense"+parseCCS, parseIE, parseAccount, parseGroup, parsePrice, parseXfer,+ parseEBS, parseSplit, parseTodo, parseComment, parseBlank, parseRecord ::+ Parser Record++parseCCS =+ do string "ccs" name <- parseName desc <- parseOptionalString+ ma <- option Nothing (TPCP.try (parseAmount >>=+ return . Just . (CCSAmt noName)))+ return (CCSRec name desc ma)++parseIE =+ do rtype <- string "income" <|> string "expense"+ name <- parseName+ desc <- parseOptionalString return (case rtype of- "ccs" -> CCSRec name desc "income" -> IncomeRec name desc- "expense" -> ExpenseRec name desc)+ "expense" -> ExpenseRec name desc+ _ -> intErr "parseIE") parseAccount = do string "account"@@ -224,7 +244,7 @@ name1 <- parseName amt2 <- parseAmount name2 <- parseOptionalName- return (PriceRec date False (CCSAmount name1 amt1) (CCSAmount name2 amt2))+ return (PriceRec date False (CCSAmt name1 amt1) (CCSAmt name2 amt2)) parseXfer = do string "xfer"@@ -235,9 +255,8 @@ amt <- parseAmount ccs <- parseOptionalName memo <- parseOptionalString- chknum <- option 0 (TPCP.try (spaces >> parseInt))- return (XferRec date rec acc1 acc2 (CCSAmount ccs amt)- memo (fromInteger chknum))+ ident <- option "" (TPCP.try parseXferID)+ return (XferRec date rec acc1 acc2 (CCSAmt ccs amt) memo ident) -- 'buy' and 'sell' are purely syntactic sugar for 'exch': 'buy' is -- exactly the same, and 'sell' is the same as if {amt1,ccs1} and@@ -257,8 +276,9 @@ "buy" -> B "sell" -> S "exch" -> E- ccsa1 = CCSAmount name1 amt1- ccsa2 = CCSAmount name2 amt2+ _ -> intErr "parseEBS"+ ccsa1 = CCSAmt name1 amt1+ ccsa2 = CCSAmt name2 amt2 if et == S then return (ExchRec et date rec acct ccsa2 ccsa1 memo) else return (ExchRec et date rec acct ccsa1 ccsa2 memo)@@ -291,11 +311,12 @@ do many space record <- parsePrice <|> parseXfer- <|> (TPCP.try parseCIE)+ <|> parseCCS+ <|> (TPCP.try parseIE) <|> (TPCP.try parseEBS) <|> parseSplit <|> parseTodo- <|> (TPCP.try parseAccount)+ <|> parseAccount <|> parseGroup <|> parseComment <|> parseBlank -- this must be last, as it can match nothing@@ -303,18 +324,26 @@ eof return record +parseURecord :: String -> Record parseURecord input = case parse parseRecord "umm record" input of Left _ -> ErrorRec input Right val -> val +parseUDate :: String -> Either ParseError Date parseUDate input = parse parseDate "umm date" (" " ++ input) +parsePrefixOf :: Int -> String -> Parser String parsePrefixOf n str = string (take n str) >> opts (drop n str) >> return str where opts [] = return () opts (c:cs) = optional (char c >> opts cs) +parseCmdBalance, parseCmdBasis, parseCmdChange, parseCmdPrice,+ parseCmdReconcile, parseCmdRegister, parseCmdToDo, parseCommand ::+ Date -> Parser Command+parseCmdList :: Parser Command+ parseCmdBalance now = do parsePrefixOf 3 "balance" name <- parseOptionalName@@ -351,10 +380,11 @@ return (ListDataCmd (case w of "all" -> COLAll "ccs" -> COLCCS- "accounts" -> COLAccts+ "accounts" -> COLAccs "groups" -> COLGrps "incomes" -> COLIncs- "expenses" -> COLExps))+ "expenses" -> COLExps+ _ -> intErr "parseListCmd")) parseCmdPrice now = do parsePrefixOf 1 "price"@@ -394,6 +424,7 @@ eof return cmd +parseUCommand :: Date -> String -> Command parseUCommand now input = case parse (parseCommand now) "umm command" input of Left err -> error (show err)
+ contrib/umm.vim view
@@ -0,0 +1,25 @@+" Filename: umm.vim+" Purpose: Vim syntax file+" Language: UMM+" Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+" URL: <none>++" For version 6.x: Quit when a syntax file was already loaded+if exists("b:current_syntax")+ finish+endif++syn match ummDate /\d\{4\}-\d\{1,2\}-\d\{1,2\}/+syn match String /"\([^"\\]\|\\.\)*"/+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 ummRec /\*/++hi link ummDate Structure+hi link ummAmount Number+hi link ummRec Identifier++let b:current_syntax = "umm"++" vim: ts=8