push some more stuff down into Parse, cleanups

This commit is contained in:
Simon Michael 2008-10-01 18:53:43 +00:00
parent 8b117e1581
commit 6f83e902a8
3 changed files with 69 additions and 72 deletions

View File

@ -38,6 +38,9 @@ instance Show Ledger where
-- 1. filter based on account/description patterns, if any
-- 2. cache per-account info
-- also, figure out the precision(s) to use
cacheLedgerAndDo :: LedgerFile -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
cacheLedgerAndDo l pats cmd = do cmd $ cacheLedger l pats
cacheLedger :: LedgerFile -> (Regex,Regex) -> Ledger
cacheLedger l pats =
let

View File

@ -111,8 +111,33 @@ import System.IO
import Utils
import Models
import Options
-- utils
-- | parse the user's specified ledger file and do some action with it
-- (or report a parse error)
parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
parseLedgerAndDo opts pats cmd = do
path <- ledgerFilePath opts
parsed <- parseLedgerFile path
case parsed of Left err -> parseError err
Right l -> cacheLedgerAndDo l pats cmd
-- do some action with the ledger parse result, or report a parse error
-- withParsedLedgerOrErrorDo :: (Either ParseError LedgerFile) -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
-- withParsedLedgerOrErrorDo parsed pats cmd = do
-- case parsed of Left err -> parseError err
-- Right l -> cacheLedgerAndDo l pats cmd
parseLedgerFile :: String -> IO (Either ParseError LedgerFile)
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
parseLedgerFile f = parseFromFile ledgerfile f
parseError :: (Show a) => a -> IO ()
parseError e = do putStr "ledger parse error at "; print e
-- set up token parsing, though we're not yet using these much
ledgerLanguageDef = LanguageDef {
commentStart = ""
@ -138,7 +163,7 @@ identifier = P.identifier lexer
reserved = P.reserved lexer
reservedOp = P.reservedOp lexer
-- parsers
ledgerfile :: Parser LedgerFile
ledgerfile = ledger <|> ledgerfromtimelog
@ -274,10 +299,11 @@ whiteSpace1 :: Parser ()
whiteSpace1 = do space; whiteSpace
-- | timelog file parser
{-
timelog grammar, from timeclock.el 2.6
{-| timelog file parser
Here is the timelog grammar, from timeclock.el 2.6:
@
A timelog contains data in the form of a single entry per line.
Each entry has the form:
@ -308,7 +334,7 @@ example:
i 2007/03/10 12:26:00 hledger
o 2007/03/10 17:26:02
@
-}
ledgerfromtimelog :: Parser LedgerFile
@ -333,14 +359,3 @@ timelogentry = do
comment <- restofline
return $ TimeLogEntry code datetime comment
-- utils
parseError :: (Show a) => a -> IO ()
parseError e = do putStr "ledger parse error at "; print e
parseLedgerFile :: String -> IO (Either ParseError LedgerFile)
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
parseLedgerFile f = parseFromFile ledgerfile f

View File

@ -20,9 +20,9 @@ functions/methods. Here is the approximate module hierarchy:
@
hledger ("Main")
"Options"
"Tests"
"Parse"
"Options"
"Models"
"TimeLog"
"Ledger"
@ -36,7 +36,7 @@ hledger ("Main")
"Currency"
"Types"
"Utils"
@
-}
module Main
@ -65,20 +65,6 @@ main = do
| cmd `isPrefixOf` "balance" = balance opts pats
| otherwise = putStr usage
parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
parseLedgerAndDo opts pats cmd = do
path <- ledgerFilePath opts
parsed <- parseLedgerFile path
withParsedLedgerOrErrorDo parsed pats cmd
withParsedLedgerOrErrorDo :: (Either ParseError LedgerFile) -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
withParsedLedgerOrErrorDo parsed pats cmd = do
case parsed of Left err -> parseError err
Right l -> cacheLedgerAndDo l pats cmd
cacheLedgerAndDo :: LedgerFile -> (Regex,Regex) -> (Ledger -> IO ()) -> IO ()
cacheLedgerAndDo l pats cmd = do cmd $ cacheLedger l pats
type Command = [Flag] -> (Regex,Regex) -> IO ()
selftest :: Command
@ -116,31 +102,7 @@ balance opts pats = do
((wildcard,_), False) -> 1
otherwise -> 9999
-- helpers for interacting in ghci
-- | return a Ledger parsed from the file your LEDGER environment variable
-- points to or (WARNING) an empty one if there was a problem.
myledger :: IO Ledger
myledger = do
parsed <- ledgerFilePath [] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger ledgerfile (wildcard,wildcard)
-- | return a Ledger parsed from the given file path
ledgerfromfile :: String -> IO Ledger
ledgerfromfile f = do
parsed <- ledgerFilePath [File f] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger ledgerfile (wildcard,wildcard)
accountnamed :: AccountName -> IO Account
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)
--clearedBalanceToDate :: String -> Amount
{-
ghci examples:
{- helpers for interacting in ghci. Examples:
$ ghci hledger.hs
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
@ -160,5 +122,22 @@ $ ghci hledger.hs
> accounts l
> accountnamed "assets"
-}
-- | return a Ledger parsed from the file your LEDGER environment variable
-- points to or (WARNING) an empty one if there was a problem.
myledger :: IO Ledger
myledger = do
parsed <- ledgerFilePath [] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger ledgerfile (wildcard,wildcard)
-- | return a Ledger parsed from the given file path
ledgerfromfile :: String -> IO Ledger
ledgerfromfile f = do
parsed <- ledgerFilePath [File f] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger ledgerfile (wildcard,wildcard)
accountnamed :: AccountName -> IO Account
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)