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