rename parseError, parsePatternArgs, fix a bug
This commit is contained in:
parent
59f0a2fabe
commit
fa1b4bdfa2
@ -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 {
|
||||||
|
|||||||
15
Options.hs
15
Options.hs
@ -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
|
||||||
|
|
||||||
|
|||||||
6
Tests.hs
6
Tests.hs
@ -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
|
||||||
--
|
--
|
||||||
|
|||||||
12
hledger.hs
12
hledger.hs
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user