diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 7425dec35..1eac11e2d 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -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 { diff --git a/Options.hs b/Options.hs index f2d284b24..2649670eb 100644 --- a/Options.hs +++ b/Options.hs @@ -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 diff --git a/Tests.hs b/Tests.hs index 5b6ee6761..d19034f14 100644 --- a/Tests.hs +++ b/Tests.hs @@ -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 -- diff --git a/hledger.hs b/hledger.hs index 216400fa2..af666f289 100644 --- a/hledger.hs +++ b/hledger.hs @@ -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