UMM 0.1.3 → 0.1.4
raw patch · 7 files changed
+177/−135 lines, 7 files
Files
- README +10/−6
- UMM.cabal +2/−2
- UMM.hs +62/−46
- UMMData.hs +29/−9
- UMMEval.hs +34/−35
- UMMHelp.hs +15/−12
- UMMParser.hs +25/−25
README view
@@ -1,4 +1,4 @@-$Id: README,v 1.6 2009/11/28 16:30:16 uwe Exp $+$Id: README,v 1.8 2009/12/06 18:54:10 uwe Exp $ Umm is an extremely minimal command-line program to read a plain-text ledger file and report balance and other information. Although@@ -11,16 +11,20 @@ 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+OSX 10.3.9, ghc 6.10.{1,3,4} on an x86 running Ubuntu, and ghc 6.10.3+on an x86 running Windows XP. You should be able to build umm simply+by running cabal configure && cabal build +or alternately++ ghc --make -O2 -o umm UMM*.hs+ For more information, build umm, then run "umm --help", and read the output of that. Arguably, that info should be in this file... later. Then look at the two files sample1.dat and sample2.dat; they are very simple examples of ledgers. -In the contrib/ subdirectory there is a vim syntax highlighter, contributed-by Nicolas Pouillard -- many thanks!+In the contrib/ subdirectory there is a vim syntax highlighter,+contributed by Nicolas Pouillard -- many thanks!
UMM.cabal view
@@ -1,9 +1,9 @@ Name: UMM-Version: 0.1.3+Version: 0.1.4 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 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,10 +16,10 @@ 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.43 2009/11/29 23:10:11 uwe Exp $ -}+$Id: UMM.hs,v 1.47 2009/12/05 22:31:37 uwe Exp $ -} module Main where-import Prelude hiding (putStr,putStrLn,readFile,getContents)+import Prelude hiding (putStr,putStrLn,print,readFile,getContents) import Control.Monad import Data.List import Data.Maybe@@ -45,10 +45,12 @@ cmd = if argc < 2 then BalanceCmd (Name "") nd else parseUCommand nd (intercalate " " (tail args))- writeHdr- if argc < 1 || fname == "-h" || fname == "-help" || fname == "--help"- then putStr (usageMsg prog) >> exitWith ExitSuccess- else return (fname, cmd)+ putStrLn writeHdr+ when (argc < 1 || fname == "-h" || fname == "-help" || fname == "--help")+ (putStr (usageMsg prog) >> exitWith ExitSuccess)+ when (fname == "-v" || fname == "-version" || fname == "--version")+ (exitWith ExitSuccess)+ return (fname, cmd) -- A version of 'lines' which deals with all combinations of '\r' and '\n'. -- It drops blank lines, which is perfectly fine here, but which might be@@ -86,7 +88,7 @@ where xlat [] = Nothing xlat ((PriceRec dr _ (CCSAmt nr1 (Amount ar1)) (CCSAmt nr2 (Amount ar2))):ps) =- if compare date dr /= LT && n == nr1 && nr2 == dc+ if date >= dr && n == nr1 && nr2 == dc then Just ((CCSAmt dc (Amount (a*ar2/ar1))), dr) else xlat ps xlat (_:ps) = xlat ps -- for non-PriceRec records@@ -102,11 +104,11 @@ ppAccts :: [(Name, [String])] -> Int -> [String] ppAccts es sp =- concat (map (ppe (sp + maximum (map (length . getN . fst) es))) es)+ concatMap (ppe (sp + maximum (map (length . getN . fst) es))) es where getN (Name n) = n ppe l (m,as) = let isp = concat (repeat " ")- in zipWith gl ((take l (show m ++ isp)) : repeat (take l isp)) as+ 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])]@@ -118,16 +120,16 @@ jep = fromJust ep CCSAmt n (Amount a) = fst jep jer = CCSAmt n (Amount (roundP 2 a))- sd d = if d == start_time then "" else " (" ++ show d ++ ")"+ sd d = if d == startTime then "" else " (" ++ show d ++ ")" sp = "\t~" ++ show jer ++ sd (snd jep)- pad = " " ++ concat (take (18 - length sv) (repeat " "))+ pad = ' ' : concat (replicate (18 - length sv) " ") 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- else filter (\a -> elem (fst a) names)) accs+selAccts :: Bool -> [Name] -> AccountData -> AccountData+selAccts keep names accs = f2 (f1 accs)+ where f0 = filter (\a -> elem (fst a) names)+ f1 = if length names == 1 && head names == noName then id else f0+ f2 = if keep then id else filter (\a -> not (null (snd a))) -- Round a rational number val to np decimal places -- This might not be ultimately exact, but it's for converted prices@@ -137,9 +139,9 @@ roundP np val = if val < 0 then negate (rp (negate val)) else rp val where rp v1 =- let e1 = 10^(max 0 np)+ let e1 = 10 ^ max 0 np e2 = 10*e1- vs = (fromInteger e2)*v1+ vs = v1 * fromInteger e2 n = numerator vs d = denominator vs q1 = quot n d@@ -159,7 +161,7 @@ ff (q:qs) as gs am ab | elem q am || elem q ab = ff qs as gs am ab | elem q as = ff qs as gs (q:am) ab- | isJust (lookup q gs) = ff (qs ++ fromJust(lookup q gs))+ | isJust (lookup q gs) = ff (qs ++ fromJust (lookup q gs)) as gs am (q:ab) | otherwise = error ("unknown account or group! " ++ show q)@@ -171,20 +173,20 @@ 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 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)+ putStrLn ("# default ccs " ++ show dc ++ "\n") >> sh ccs)+ 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)+ sh = mapM_ print -doBalance :: Date -> [Name] -> Name -> [Record] ->+doBalance :: Bool -> 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))+doBalance ke date names dc accts trans prices =+ do final <- getBalances startTime date Nothing False accts trans+ let fsel = selAccts ke names final+ fp = map (\e -> reprice e dc date prices) (concatMap snd fsel) gp = groupBy eqCCSAmtName (sortBy cmpCCSAmtName fp) sp = filter (\e -> ccsA e /= 0) (map sumCCS gp) if length names == 1 && head names == todoName@@ -203,7 +205,8 @@ 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)+ mapM_ putStrLn (ppAccts (showPos dc d2 prices+ (selAccts True [name] final)) 8) doChange :: Bool -> Date -> Date -> Name -> Name -> [Record] -> [Record] -> IO ()@@ -211,14 +214,24 @@ do let aux = if notElem name (map getRecName accts) then [AccountRec name d1 ""] else []- trs = dropWhile (\t -> compare (getRecDate t) d1 /= GT) trans+ trs = dropWhile (\t -> getRecDate t <= d1) trans mn = if verbose then Just name else Nothing final <- getBalances d1 d2 mn False (aux ++ accts) trs putStr "Change"- when (d1 /= start_time) (putStr (" from " ++ show d1))+ when (d1 /= startTime) (putStr (" from " ++ show d1)) putStrLn (" to " ++ show d2)- mapM_ putStrLn (ppAccts (showPos dc d2 [] (selAccts [name] final)) 8)+ mapM_ putStrLn (ppAccts (showPos dc d2 [] (selAccts True [name] final)) 8) +-- Filter predicate for computing basis: want to only consider transactions+-- which involve ccs "n0"++hasCur :: Name -> Record -> Bool+hasCur c (XferRec _ _ _ _ (CCSAmt n1 _) _ _) = c == n1+hasCur c (ExchRec _ _ _ _ (CCSAmt n1 _) (CCSAmt n2 _) _) = c == n1 || c == n2+hasCur c (SplitRec _ n1 _ _) = c == n1+hasCur _ (ToDoRec _ _ _) = False+hasCur _ r = error ("internal error at hasCur! got " ++ show r)+ main :: IO () main = do (file, action) <- processArgs@@ -227,24 +240,27 @@ validateTransPrices ccs incs exps accts (trans ++ p1) let p2 = generateImplicitPrices dc trans ccs prices = mergePrices (reverse p1) p2+ pse r = putStrLn (showExp r) >> putStrLn "" 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 _ _ ->- putStrLn "Sorry, basis command is not implemented yet!"- ToDoCmd date ->- doBalance date [todoName] dc accts trans prices- RegisterCmd name date1 date2 ->- doRegister date1 date2 name dc accts trans prices False- ReconcileCmd name date ->- doRegister start_time date name dc accts trans prices True ChangeCmd verbose name date1 date2 -> doChange verbose date1 date2 name dc accts trans+ BalanceCmd name date ->+ doBalance True date (expandGroup accts grps name)+ dc accts trans prices+ BasisCmd name date ->+ doBalance False date [noName] dc accts (filter (hasCur name) trans) []+ ExportCmd -> mapM_ pse trans+ ListDataCmd w ->+ doList w dc ccs accts grps incs exps PriceCmd name date -> if name == dc then putStrLn ("Price of " ++ show name ++ " is always 1!") else if notElem name (map getRecName ccs) then putStrLn ("Error! unknown CCS " ++ show name) else getPrices name dc date prices+ RegisterCmd name date1 date2 ->+ doRegister date1 date2 name dc accts trans prices False+ ReconcileCmd name date ->+ doRegister startTime date name dc accts trans prices True+ ToDoCmd date ->+ doBalance True date [todoName] dc accts trans prices
UMMData.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: UMMData.hs,v 1.36 2009/11/29 23:10:11 uwe Exp $ -}+$Id: UMMData.hs,v 1.39 2009/12/05 20:30:42 uwe Exp $ -} -module UMMData (Name(..), Date(..), Amount(..), start_time,+module UMMData (Name(..), Date(..), Amount(..), startTime, Command(..), CmdOpt(..), Record(..), genDate, getRecDate, cmpRecDate, getRecName, cmpRecName, Ledger(..), runLedger, getResult, getInfo, getErrs,- recordInfo, recordErr, recordNil, BSE(..),+ recordInfo, recordErr, recordNil, showExp, BSE(..), CCSAmt(..), cmpCCSAmtName, eqCCSAmtName, AccountData, noName, todoName, joinDrop, isLeap, validDate) where import Prelude@@ -72,12 +72,12 @@ December -> 12 in Date y m2 d -start_time :: Date-start_time = Date (-4003) 10 23 -- 9 AM (GMT)+startTime :: Date+startTime = 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+ show (Amount amt) = if amt < 0 then '-' : shRat (-amt) else shRat amt shRat :: Rational -> String shRat val =@@ -140,6 +140,7 @@ | ReconcileCmd Name Date | PriceCmd Name Date | ChangeCmd Bool Name Date Date+ | ExportCmd instance Show Command where show (ListDataCmd opt) = joinDrop ["list", show opt]@@ -153,6 +154,7 @@ show (ChangeCmd verbose name date1 date2) = joinDrop ["change", (if verbose then "verbose" else ""), show name, show date1, show date2]+ show ExportCmd = "export" -- No, not bovine spongiform encephalitis! Disambiguate buy, sell, and -- exch records: internally, they are all treated as exch, because@@ -195,7 +197,7 @@ mAmt (Just a) = show a joinDrop :: [String] -> String-joinDrop ss = intercalate " " (filter (\s -> s /= "") ss)+joinDrop = intercalate " " . filter (/= "") showR :: Record -> String showR (CCSRec n d a) = joinDrop ["ccs", show n, optStr d, mAmt a]@@ -226,6 +228,24 @@ showR (ErrorRec str) = joinDrop ["#err", str] +showExp :: Record -> String+showExp (XferRec d r a1 a2 c m i) =+ let l1 = joinDrop [show d, shRec r, i, if m == "" then "transfer" else m]+ l2 = joinDrop [show a2, show c]+ l3 = joinDrop [show a1]+ in intercalate "\n " [l1, l2, l3]++showExp (ExchRec _ d r a c1 (CCSAmt n2 (Amount a2)) m) =+ let l1 = joinDrop [show d, shRec r, if m == "" then "exchange" else m]+ l2 = joinDrop [show a, show c1]+ l3 = joinDrop [show a, show (CCSAmt n2 (Amount (-a2)))]+ l4 = "the:world"+ in intercalate "\n " [l1, l2, l3, l4]++showExp (SplitRec _ _ _ _) = "# Split to be implemented"+showExp (PriceRec _ _ _ _) = "# Price to be implemented"+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@@ -235,7 +255,7 @@ getRecDate (ExchRec _ d _ _ _ _ _) = d getRecDate (SplitRec d _ _ _) = d getRecDate (ToDoRec d _ _) = d-getRecDate _ = start_time -- so it works for every Record+getRecDate _ = startTime -- so it works for every Record -- Get the name (or at any rate /some/ name) from a Record @@ -304,7 +324,7 @@ n = k a (b,li2,le2) = runLedger n in Ledger (b, li1 ++ li2, le1 ++ le2)- (>>) a f = a >>= \_ -> f+ (>>) a f = a >>= const f -- Some miscellany
UMMEval.hs view
@@ -16,11 +16,11 @@ 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.28 2009/11/29 23:10:12 uwe Exp $ -}+$Id: UMMEval.hs,v 1.30 2009/12/03 15:17:14 uwe Exp $ -} module UMMEval (validateRecs, classifyRecs, validateTransPrices, generateImplicitPrices, getBalances, getPrices) where-import Prelude hiding (putStr,putStrLn)+import Prelude hiding (putStr,putStrLn,print) import Data.List import Data.Maybe import System.IO.UTF8@@ -34,6 +34,11 @@ intErr loc w = error ("internal error at " ++ loc ++ "\ngot unexpected " ++ show w) +showErrs :: (Show i) => String -> [i] -> IO o+showErrs msg errs =+ putStrLn ("There were " ++ msg ++ " in the input:") >>+ mapM_ print errs >> error "quitting now"+ -- Add the default ccs to a CCSAmt that has a blank ccs addDCCA :: Name -> CCSAmt -> CCSAmt@@ -46,11 +51,9 @@ validateRecs :: [Record] -> IO [Record] validateRecs records = do let (_,i,e) = runLedger (chk records)- if length e == 0+ if null e then return i- else putStrLn "There were parse or date errors in the input:"- >> mapM_ (putStrLn . show) e- >> error "quitting now"+ else showErrs "parse or date errors" e where chk [] = return () chk (r@(ErrorRec _):rs) = recordErr r >> chk rs chk ((CommentRec _):rs) = chk rs@@ -81,7 +84,7 @@ GroupRec _ _ -> cw rs c i e a (r:g) t p 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)+ vsN = uChk . sortBy cmpRecName uChk [] = [] uChk s@(_:[]) = s uChk v@(v1:v2:[]) = uc1 v1 v2 v@@ -89,7 +92,7 @@ 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))+ asD dc = sortBy cmpRecDate . reverse . map (addDC dc) addDC dc (PriceRec d imp ccsa1 ccsa2) = PriceRec d imp ccsa1 (addDCCA dc ccsa2) addDC dc (XferRec d f a1 a2 ccsa m c) =@@ -109,9 +112,7 @@ [Record] -> [Record] -> IO () validateTransPrices ccs incs exps accts tps = do let bads = filter chk tps- when (length bads > 0)- (putStrLn "There were bad transactions in the input:"- >> mapM_ (putStrLn . show) bads >> error "quitting now")+ unless (null bads) (showErrs "bad transactions" bads) where chk (SplitRec _ c (Amount amt1) (Amount amt2)) = amt1 == 0 || amt2 == 0 || notIn c ccs chk (PriceRec _ _ (CCSAmt c1 amt1) (CCSAmt c2 _)) =@@ -134,15 +135,15 @@ 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)+ 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)+ PriceRec startTime 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 (t@(ExchRec _ _ _ _ _ _ _):ts) = gip (genp t : acc) ts gip acc (_:ts) = gip acc ts genp (ExchRec _ date _ _ (CCSAmt n1 a1) (CCSAmt n2 a2) _) | n1 == dc = PriceRec date True (nC n2 a2 a2) (nC n1 a1 a2)@@ -169,7 +170,7 @@ dq = getCA d nq = qq + dq in if qn == dn- then if nq == 0 then qs else (CCSAmt qn (Amount nq)) : qs+ then if nq == 0 then qs else CCSAmt qn (Amount nq) : qs else q : addTo qs d subFrom :: [CCSAmt] -> CCSAmt -> [CCSAmt]@@ -180,7 +181,7 @@ where s1 dn dq q = let qn = getCN q qq = getCA q- in if qn == dn then (CCSAmt 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]) ()@@ -188,9 +189,9 @@ let isJ = isJust reg rn = fromJust reg acc = filter (\a -> fst a == rn) newaccs- nb = if length acc > 0- then snd (head acc)- else [CCSAmt noName (Amount 0)]+ nb = if null acc+ then [CCSAmt noName (Amount 0)]+ else snd (head acc) in if isJ && (tst rn || rn == noName) then recordInfo (record, nb) else recordNil@@ -209,7 +210,7 @@ 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)+ (doExch accs acc amtn amto) (== acc) where doExch [] _ _ _ = [] doExch ((an,ab):as) n en eo = if an == n@@ -238,7 +239,7 @@ 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+ in maybeRecord reg record newaccs (const True) >> return newaccs where doST (a1,a2) = (a1, scaleBy a2 (CCSAmt ccs (Amount (an/ao)))) splitTrans _ r _ = intErr "splitTrans" r @@ -261,22 +262,20 @@ _ -> recordErr t >> appTr d r f ts as showT :: (Record, [CCSAmt]) -> IO ()-showT (t,_) = putStrLn (show t)+showT (t,_) = print t showTB :: (Record, [CCSAmt]) -> IO () showTB e@(_,b) = showT e >> mapM_ sB b- where sB ccsa = putStrLn ("\t" ++ show ccsa)+ 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+ i = dropWhile (\t -> getRecDate (fst t) < date1) i1 ss = if dorec then showT else showTB- when (length e > 0)- (putStrLn "There were processing errors in the input:"- >> mapM_ (putStrLn . show) e >> error "quitting now")- when (length i > 0) (putStrLn "Notes:" >> mapM_ ss i >> putStrLn "")+ unless (null e) (showErrs "processing errors" e)+ unless (null i) (putStrLn "Notes:" >> mapM_ ss i >> putStrLn "") return r -- For now, we don't generate "swap prices" internally, so unless the user@@ -284,18 +283,18 @@ getPrices :: Name -> Name -> Date -> [Record] -> IO () getPrices nm dc date prices =- do let p1 = dropWhile (\t -> compare date (getRecDate t) == LT) prices+ do let p1 = dropWhile (\t -> date < getRecDate t) prices (_,i,e) = runLedger (get p1)- when (length e > 0) (doShow "Swap \"Prices\"" e >> putStrLn "")- when (length i > 0) (doShow "Ordinary Prices" i)- when (length e == 0 && length i == 0)+ 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)+ else if nr1 == nm || nr2 == nm then recordErr p >> get ps else get ps get _ = recordNil- doShow t p = putStrLn t >> mapM_ (putStrLn . show) (reverse p)+ doShow t p = putStrLn t >> mapM_ print (reverse p)
UMMHelp.hs view
@@ -16,22 +16,20 @@ 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.19 2009/11/29 23:10:13 uwe Exp $ -}+$Id: UMMHelp.hs,v 1.21 2009/12/05 22:45:21 uwe Exp $ -} module UMMHelp (writeHdr, usageMsg) where-import Prelude hiding (putStr,putStrLn)-import System.IO.UTF8+import Prelude version :: String-version = "0.1.3"+version = "0.1.4" -writeHdr :: IO ()+writeHdr :: String writeHdr =- putStrLn- ("Uwe's Money Manager -- umm " ++ version ++- "\nCopyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>\n" ++- "Available under GPL V3 or later. Share and enjoy!\n" ++- "http://www.korgwal.com/umm/\n")+ "Uwe's Money Manager -- umm " ++ version +++ "\nCopyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>\n" +++ "Available under GPL V3 or later. Share and enjoy!\n" +++ "http://www.korgwal.com/umm/\n" -- TODO: store these unadorned in some separate text files, and use -- a program (Template Haskell?) to turn them into proper source code@@ -49,6 +47,7 @@ " 'reconcile' [account] [date]\n" ++ " 'todo' [date]\n" ++ " 'basis' ccs [date]\n" +++ " 'export'\n" ++ "\n" ++ "The commands may be shortened to the unique prefixes or anything\n" ++ "longer: 'b', 'ba', 'bala' etc, 'reg', 'regi' etc, but not 'r'.\n" ++@@ -112,8 +111,12 @@ " income and expense categories, accounts, and groups\n" ++ "\n" ++ "\n" ++- "* 'basis' will eventually show the cost basis for a given currency\n" ++- " or commodity or security. It is not yet implemented.\n" +++ "* 'basis' shows the cost basis for a given currency or commodity\n" +++ " or security.\n" +++ "\n" +++ "\n" +++ "* 'export' will eventually export the data in ledger/hledger\n" +++ " format. It is only partially implemented.\n" ++ "\n" ++ "--------\n" ++ "\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.34 2009/11/29 23:10:14 uwe Exp $ -}+$Id: UMMParser.hs,v 1.36 2009/12/03 15:17:14 uwe Exp $ -} -- TODO: template := <to be determined> @@ -30,7 +30,7 @@ readInt :: String -> Integer readInt s = foldl ma 0 s- where ma v1 v2 = 10*v1 + (toInteger (digitToInt v2))+ where ma v1 v2 = 10*v1 + toInteger (digitToInt v2) readAmt :: String -> String -> Rational readAmt ip fp =@@ -48,7 +48,7 @@ -- want "spaces" to mean an actual something there spaces, parseString, parseOptionalString, parseXferID :: Parser String-escChar, currency_symbol, other_symbol :: Parser Char+escChar, currencySymbol, otherSymbol :: Parser Char spaces = many1 space @@ -70,7 +70,7 @@ parseString = do spaces char '"'- str <- many (escChar <|> (noneOf "\""))+ str <- many (escChar <|> noneOf "\"") char '"' return str @@ -81,7 +81,7 @@ -- Currency symbols: do allow these as the first char of a name -- gathered from various places on the web, mainly unicode.org -currency_symbol =+currencySymbol = oneOf ['\x24', -- dollar '\xa2', -- cent '\xa3', -- pound@@ -131,13 +131,13 @@ -- Non-currency symbols: don't allow these as the first character of a name -other_symbol = oneOf "!%&*+-/:<=>?@^_~"+otherSymbol = oneOf "!%&*+-/:<=>?@^_~" parseName :: Parser Name parseName = do spaces- first <- letter <|> currency_symbol- rest <- many (letter <|> currency_symbol <|> digit <|> other_symbol)+ first <- letter <|> currencySymbol+ rest <- many (letter <|> currencySymbol <|> digit <|> otherSymbol) return (Name (first:rest)) parseOptionalName :: Parser Name@@ -152,13 +152,12 @@ parseAmt1, parseAmt2, parseAmt3 :: Parser Rational parseAmt1 =- do ip <- many1 digit- fp <- option "" (char '.' >> many digit)- return (readAmt ip fp)+ many1 digit >>=+ (\ip -> option "" (char '.' >> many digit) >>= return . readAmt ip) -- Parse second alternative for amounts: \.\d+ -parseAmt2 = char '.' >> many1 digit >>= (\fp -> return (readAmt "0" fp))+parseAmt2 = char '.' >> many1 digit >>= return . readAmt "0" -- 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@@ -173,9 +172,7 @@ parseAmount = do many space s <- option '+' (oneOf "+-")- v <- (TPCP.try parseAmt3) <|>- parseAmt1 <|>- parseAmt2+ v <- TPCP.try parseAmt3 <|> parseAmt1 <|> parseAmt2 return (Amount (if s == '+' then v else negate v)) parseOptionalAmount = option (Amount 1) (TPCP.try parseAmount)@@ -213,7 +210,7 @@ name <- parseName desc <- parseOptionalString ma <- option Nothing (TPCP.try (parseAmount >>=- return . Just . (CCSAmt noName)))+ return . Just . CCSAmt noName)) return (CCSRec name desc ma) parseIE =@@ -228,7 +225,7 @@ parseAccount = do string "account" name <- parseName- date <- option start_time (TPCP.try parseDate)+ date <- option startTime (TPCP.try parseDate) desc <- parseOptionalString return (AccountRec name date desc) @@ -312,8 +309,8 @@ record <- parsePrice <|> parseXfer <|> parseCCS- <|> (TPCP.try parseIE)- <|> (TPCP.try parseEBS)+ <|> TPCP.try parseIE+ <|> TPCP.try parseEBS <|> parseSplit <|> parseTodo <|> parseAccount@@ -331,7 +328,7 @@ Right val -> val parseUDate :: String -> Either ParseError Date-parseUDate input = parse parseDate "umm date" (" " ++ input)+parseUDate input = parse parseDate "umm date" (' ' : input) parsePrefixOf :: Int -> String -> Parser String parsePrefixOf n str =@@ -342,7 +339,7 @@ parseCmdBalance, parseCmdBasis, parseCmdChange, parseCmdPrice, parseCmdReconcile, parseCmdRegister, parseCmdToDo, parseCommand :: Date -> Parser Command-parseCmdList :: Parser Command+parseCmdExport, parseCmdList :: Parser Command parseCmdBalance now = do parsePrefixOf 3 "balance"@@ -356,6 +353,8 @@ date <- option now (TPCP.try parseDate) return (BasisCmd name date) +parseCmdExport = parsePrefixOf 1 "export" >> return ExportCmd+ -- TODO: make verbose/nonverbose work... somehow add optional verbosity -- ok, this is really cheesy! make it better! @@ -363,8 +362,8 @@ do parsePrefixOf 1 "change" name <- parseName date1 <- option now parseDate- date2 <- option start_time parseDate- if compare date2 date1 == LT+ date2 <- option startTime parseDate+ if date2 < date1 then return (ChangeCmd True name date2 date1) else return (ChangeCmd False name date1 date2) @@ -402,8 +401,8 @@ do parsePrefixOf 3 "register" name <- parseName date1 <- option now (TPCP.try parseDate)- date2 <- option start_time (TPCP.try parseDate)- if compare date2 date1 == LT+ date2 <- option startTime (TPCP.try parseDate)+ if date2 < date1 then return (RegisterCmd name date2 date1) else return (RegisterCmd name date1 date2) @@ -414,6 +413,7 @@ parseCommand date = do cmd <- parseCmdChange date+ <|> parseCmdExport <|> parseCmdList <|> parseCmdPrice date <|> parseCmdToDo date