diff --git a/README b/README --- a/README +++ b/README @@ -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! diff --git a/UMM.cabal b/UMM.cabal --- a/UMM.cabal +++ b/UMM.cabal @@ -1,9 +1,9 @@ Name: UMM -Version: 0.1.3 +Version: 0.1.4 Homepage: http://www.korgwal.com/umm/ Author: Uwe Hollerbach Maintainer: Uwe Hollerbach -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 diff --git a/UMM.hs b/UMM.hs --- a/UMM.hs +++ b/UMM.hs @@ -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 diff --git a/UMMData.hs b/UMMData.hs --- a/UMMData.hs +++ b/UMMData.hs @@ -16,13 +16,13 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: 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 diff --git a/UMMEval.hs b/UMMEval.hs --- a/UMMEval.hs +++ b/UMMEval.hs @@ -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) diff --git a/UMMHelp.hs b/UMMHelp.hs --- a/UMMHelp.hs +++ b/UMMHelp.hs @@ -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 \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 \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" ++ diff --git a/UMMParser.hs b/UMMParser.hs --- a/UMMParser.hs +++ b/UMMParser.hs @@ -16,7 +16,7 @@ along with umm; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -$Id: UMMParser.hs,v 1.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 := @@ -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