hledger/hledger.hs
2007-05-02 07:37:08 +00:00

100 lines
2.6 KiB
Haskell

#!/usr/bin/env runhaskell
{-
hledger - ledger-compatible money management tool (& haskell study)
GPLv3, (c) Simon Michael & contributors
A port of John Wiegley's ledger at http://newartisans.com/ledger.html
Here is a rough overview of the module/model hierarchy:
hledger
Options
Tests
Parse
Models
TimeLog
TimeLogEntry
Account
Ledger
EntryTransaction
Entry
Transaction
AccountName
Amount
BasicTypes
Utils
-}
module Main
where
import System
import Text.ParserCombinators.Parsec (ParseError)
import Options
import Models
import Parse
import Tests
import Utils
main :: IO ()
main = do
(opts, (cmd:args)) <- getArgs >>= parseOptions
let (acctpats, descpats) = parseLedgerPatternArgs args
run cmd opts acctpats descpats
where run cmd opts acctpats descpats
| Help `elem` opts = putStr usage
| cmd `isPrefixOf` "register" = register opts acctpats descpats
| cmd `isPrefixOf` "balance" = balance opts acctpats descpats
| cmd `isPrefixOf` "test" = selftest
| otherwise = putStr usage
-- commands
register :: [Flag] -> [String] -> [String] -> IO ()
register opts acctpats descpats = do
doWithLedger opts printRegister
where
printRegister ledger =
putStr $ showTransactionsWithBalances
(ledgerTransactionsMatching (acctpats,descpats) ledger)
0
balance :: [Flag] -> [String] -> [String] -> IO ()
balance opts acctpats _ = do
doWithLedger opts printBalance
where
printBalance ledger =
putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
where
showsubs = (ShowSubs `elem` opts)
maxdepth = case (acctpats, showsubs) of
([],False) -> 1
otherwise -> 9999
selftest :: IO ()
selftest = do
Tests.tests
Tests.props
-- Amount.tests
return ()
-- utils
doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
doWithLedger opts cmd = do
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
doWithParsed :: Show a => (a -> IO ()) -> (Either ParseError a) -> IO ()
doWithParsed action parsed = do
case parsed of Left e -> parseError e
Right l -> action l
-- interactive testing:
--
-- p <- ledgerFilePath [] >>= parseLedgerFile
-- let l = either (\_ -> Ledger [] [] []) id p
-- let ant = ledgerAccountNameTree l
-- let at = ledgerAccountTreeMatching l [] True 999
-- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999