rename parseError, parsePatternArgs, fix a bug

This commit is contained in:
Simon Michael 2008-10-08 18:02:34 +00:00
parent 59f0a2fabe
commit fa1b4bdfa2
4 changed files with 16 additions and 21 deletions

View File

@ -122,8 +122,8 @@ parseLedgerFile :: String -> IO (Either ParseError RawLedger)
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
printParseError :: (Show a) => a -> IO ()
printParseError e = do putStr "ledger parse error at "; print e
-- set up token parsing, though we're not yet using these much
ledgerLanguageDef = LanguageDef {

View File

@ -5,7 +5,7 @@ parseArguments,
ledgerFilePathFromOpts,
beginDateFromOpts,
endDateFromOpts,
parsePatternArgs,
parseAccountDescriptionArgs,
regexFor,
nullpats,
wildcard,
@ -19,8 +19,6 @@ import Data.Maybe (fromMaybe)
import Ledger.Utils
import Ledger.Types
import Ledger.Parse (parseLedgerFile, parseError)
import Ledger.Ledger (cacheLedger)
usagehdr = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:"
@ -107,12 +105,11 @@ endDateFromOpts opts =
getenddate _ = []
defaultdate = ""
-- | ledger pattern arguments are: 0 or more account patterns
-- optionally followed by -- and 0 or more description patterns.
-- No arguments implies match all. Here we gather these into two lists.
-- parsePatternArgs :: [String] -> (Regex,Regex)
parsePatternArgs :: [String] -> ([String],[String])
parsePatternArgs args = (as, ds')
-- | Gather any ledger-style account/description pattern arguments into
-- two lists. These are 0 or more account patterns optionally followed by
-- 0 or more description patterns.
parseAccountDescriptionArgs :: [String] -> ([String],[String])
parseAccountDescriptionArgs args = (as, ds')
where (as, ds) = break (=="--") args
ds' = dropWhile (=="--") ds

View File

@ -14,11 +14,9 @@ assertEqual' e a = assertEqual "" e a
parse' p ts = parse p "" ts
-- | Assert a parsed thing equals some expected thing, or print a parse error.
assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
assertParseEqual expected parsed =
case parsed of
Left e -> parseError e
Right v -> assertEqual " " expected v
assertParseEqual expected parsed = either printParseError (assertEqual " " expected) parsed
-- find tests with template haskell
--

View File

@ -37,7 +37,7 @@ import qualified Data.Map as Map (lookup)
import Options
import Tests (hunit, quickcheck)
import Ledger.Parse (parseLedgerFile, parseError)
import Ledger.Parse (parseLedgerFile, printParseError)
import Ledger.Utils hiding (test)
import Ledger hiding (rawledger)
@ -75,7 +75,7 @@ balance opts args = parseLedgerAndDo opts args printbalance
printbalance l = putStr $ showLedgerAccountBalances l depth
where
showsubs = (ShowSubs `elem` opts)
pats = parsePatternArgs args
pats = parseAccountDescriptionArgs args
depth = case (pats, showsubs) of
-- when there is no -s or pattern args, show with depth 1
(([],[]), False) -> 1
@ -85,14 +85,14 @@ balance opts args = parseLedgerAndDo opts args printbalance
-- (or report a parse error). This function makes the whole thing go.
parseLedgerAndDo :: [Opt] -> [String] -> (Ledger -> IO ()) -> IO ()
parseLedgerAndDo opts args cmd =
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either parseError runthecommand
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
where
runthecommand = cmd . cacheLedger . filterLedger begin end aregex dregex
begin = beginDateFromOpts opts
end = endDateFromOpts opts
aregex = regexFor apats
dregex = regexFor dpats
(acctpats,descpats) = parsePatternArgs args
aregex = regexFor acctpats
dregex = regexFor descpats
(acctpats,descpats) = parseAccountDescriptionArgs args
-- ghci helpers