slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Main cleanup

Browse Source
This commit is contained in:
Simon Michael 2008-10-01 12:29:51 +00:00
parent b90c015d9a
commit 9ea32d3f13
1 changed files with 33 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
hledger.hs
View File

@ -57,50 +57,62 @@ main = do
(opts, (cmd:args)) <- getArgs >>= parseOptions (opts, (cmd:args)) <- getArgs >>= parseOptions
let pats = parsePatternArgs args let pats = parsePatternArgs args
run cmd opts pats run cmd opts pats
where run cmd opts pats where run cmd opts pats
| Help `elem` opts = putStr usage | Help `elem` opts = putStr usage
| cmd `isPrefixOf` "test" = test opts pats | cmd `isPrefixOf` "selftest" = selftest opts pats
| cmd `isPrefixOf` "print" = doWithFilteredLedger opts pats printentries | cmd `isPrefixOf` "print" = print_ opts pats
| cmd `isPrefixOf` "register" = doWithFilteredLedger opts pats printregister | cmd `isPrefixOf` "register" = register opts pats
| cmd `isPrefixOf` "balance" = balance opts pats | cmd `isPrefixOf` "balance" = balance opts pats
| otherwise = putStr usage | otherwise = putStr usage
doWithFilteredLedger :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
doWithFilteredLedger opts pats cmd = do parseLedgerAndDo opts pats cmd = do
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed pats cmd path <- ledgerFilePath opts
parsed <- parseLedgerFile path
doWithParsedLedger pats cmd parsed
doWithParsed :: (Regex,Regex) -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () doWithParsedLedger :: (Regex,Regex) -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
doWithParsed pats cmd parsed = do doWithParsedLedger pats cmd parsed = do
case parsed of Left e -> parseError e case parsed of Left e -> parseError e
Right l -> cmd $ cacheLedger pats l Right l -> cacheLedgerAndDo pats l cmd
cacheLedgerAndDo :: (Regex,Regex) -> LedgerFile -> (Ledger -> IO ()) -> IO ()
cacheLedgerAndDo pats l cmd = do cmd $ cacheLedger pats l
type Command = [Flag] -> (Regex,Regex) -> IO () type Command = [Flag] -> (Regex,Regex) -> IO ()
test :: Command selftest :: Command
test opts pats = do selftest opts pats = do
Tests.hunit Tests.hunit
Tests.quickcheck Tests.quickcheck
return () return ()
print_ :: Command
print_ opts pats = parseLedgerAndDo opts pats printentries
printentries :: Ledger -> IO ()
printentries l = putStr $ showEntries $ setprecisions $ entries $ rawledger l printentries l = putStr $ showEntries $ setprecisions $ entries $ rawledger l
where setprecisions = map (entrySetPrecision (lprecision l)) where setprecisions = map (entrySetPrecision (lprecision l))
register :: Command
register opts pats = parseLedgerAndDo opts pats printregister
printregister :: Ledger -> IO ()
printregister l = putStr $ showTransactionsWithBalances printregister l = putStr $ showTransactionsWithBalances
(sortBy (comparing date) $ ledgerTransactions l) (sortBy (comparing date) $ ledgerTransactions l)
nullamt{precision=lprecision l} nullamt{precision=lprecision l}
balance :: Command balance :: Command
balance opts pats = do balance opts pats = do
doWithFilteredLedger opts pats printbalance parseLedgerAndDo opts pats printbalance
where where
printbalance l = printbalance l =
putStr $ showLedgerAccounts l depth putStr $ showLedgerAccounts l depth
where where
showsubs = (ShowSubs `elem` opts) showsubs = (ShowSubs `elem` opts)
depth = case (pats, showsubs) of depth = case (pats, showsubs) of
-- when there are no account patterns and no -s, -- when there are no account patterns and no -s, show
-- show only to depth 1. (This was clearer and more -- only to depth 1. (This was clearer when we used maybe.)
-- correct when we used maybe.)
((wildcard,_), False) -> 1 ((wildcard,_), False) -> 1
otherwise -> 9999 otherwise -> 9999
@ -112,14 +124,14 @@ myledger :: IO Ledger
myledger = do myledger = do
parsed <- ledgerFilePath [] >>= parseLedgerFile parsed <- ledgerFilePath [] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger (parsePatternArgs []) ledgerfile return $ cacheLedger (wildcard,wildcard) ledgerfile
-- | return a Ledger parsed from the given file path -- | return a Ledger parsed from the given file path
ledgerfromfile :: String -> IO Ledger ledgerfromfile :: String -> IO Ledger
ledgerfromfile f = do ledgerfromfile f = do
parsed <- ledgerFilePath [File f] >>= parseLedgerFile parsed <- ledgerFilePath [File f] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger (parsePatternArgs []) ledgerfile return $ cacheLedger (wildcard,wildcard) ledgerfile
accountnamed :: AccountName -> IO Account accountnamed :: AccountName -> IO Account
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts) accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)