#!/usr/bin/env runhaskell -- hledger - ledger-compatible money management utilities (& haskell study) -- GPLv3, (c) Simon Michael & contributors, -- John Wiegley's ledger is at http://newartisans.com/ledger.html -- application logic & most IO module Main where import System import System.Environment (withArgs) -- for testing in old hugs import Test.HUnit (runTestTT) import Test.QuickCheck (quickCheck) import Text.ParserCombinators.Parsec (ParseError) import Options import Models import Parse import Tests import Utils main :: IO () main = do (opts, args) <- (getArgs >>= getOptions) if args == [] then register [] [] else let (command, args') = (head args, tail args) in if "reg" `isPrefixOf` command then (register opts args') else if "bal" `isPrefixOf` command then balance opts args' else if "test" `isPrefixOf` command then test else putStr $ usageInfo usageHeader options -- commands test :: IO () test = do hcounts <- runTestTT tests qcounts <- mapM quickCheck props return () where showHunitCounts c = reverse $ tail $ reverse ("passed " ++ (unwords $ drop 5 $ words (show c))) register :: [Flag] -> [String] -> IO () register opts args = do getLedgerFilePath >>= parseLedgerFile >>= doWithParsed (printRegister opts args) balance :: [Flag] -> [String] -> IO () balance opts args = do getLedgerFilePath >>= parseLedgerFile >>= doWithParsed (printBalance opts args) -- utils -- doWithLedgerFile = -- getLedgerFilePath >>= parseLedgerFile >>= doWithParsed doWithParsed :: (a -> IO ()) -> (Either ParseError a) -> IO () doWithParsed a p = do case p of Left e -> parseError e Right v -> a v printRegister :: [Flag] -> [String] -> Ledger -> IO () printRegister opts args ledger = do putStr $ showTransactionsWithBalances (ledgerTransactionsMatching (acctpats,descpats) ledger) 0 where (acctpats,descpats) = ledgerPatternArgs args printBalance :: [Flag] -> [String] -> Ledger -> IO () printBalance opts args ledger = do -- putStr $ showLedgerAccounts ledger acctpats depth -- where -- (acctpats,_) = ledgerPatternArgs args -- showsubs = (ShowSubs `elem` opts) -- depth = case showsubs of -- True -> 999 -- False -> depthOption opts putStr $ case showsubs of True -> showLedgerAccounts ledger 999 False -> showLedgerAccounts ledger (getDepth opts) where showsubs = (ShowSubs `elem` opts) (acctpats,_) = ledgerPatternArgs args