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 "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
parseLedgerFile f = parseFromFile ledgerfile f parseLedgerFile f = parseFromFile ledgerfile f
parseError :: (Show a) => a -> IO () printParseError :: (Show a) => a -> IO ()
parseError e = do putStr "ledger parse error at "; print e printParseError e = do putStr "ledger parse error at "; print e
-- set up token parsing, though we're not yet using these much -- set up token parsing, though we're not yet using these much
ledgerLanguageDef = LanguageDef { ledgerLanguageDef = LanguageDef {

View File

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

View File

@ -14,11 +14,9 @@ assertEqual' e a = assertEqual "" e a
parse' p ts = parse p "" ts 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 :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
assertParseEqual expected parsed = assertParseEqual expected parsed = either printParseError (assertEqual " " expected) parsed
case parsed of
Left e -> parseError e
Right v -> assertEqual " " expected v
-- find tests with template haskell -- find tests with template haskell
-- --

View File

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