parse Y default year lines in a ledger, so they don't break it (ignoring them)
This commit is contained in:
		
							parent
							
								
									b12e4e3ac2
								
							
						
					
					
						commit
						16e33b50e6
					
				| @ -61,6 +61,12 @@ popParentAccount = do ctx0 <- getState | ||||
| getParentAccount :: GenParser tok LedgerFileCtx String | ||||
| getParentAccount = liftM (concat . reverse . ctxAccount) getState | ||||
| 
 | ||||
| setYear :: Integer -> GenParser tok LedgerFileCtx () | ||||
| setYear y = updateState (\ctx -> ctx{ctxYear=Just y}) | ||||
| 
 | ||||
| getYear :: GenParser tok LedgerFileCtx (Maybe Integer) | ||||
| getYear = liftM ctxYear getState | ||||
| 
 | ||||
| parseLedger :: FilePath -> String -> ErrorT String IO RawLedger | ||||
| parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of | ||||
|                              Right m  -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty) | ||||
| @ -79,6 +85,7 @@ ledgerFile = do entries <- many1 ledgerAnyEntry | ||||
|                                   , liftM (return . addModifierEntry) ledgerModifierEntry | ||||
|                                   , liftM (return . addPeriodicEntry) ledgerPeriodicEntry | ||||
|                                   , liftM (return . addHistoricalPrice) ledgerHistoricalPrice | ||||
|                                   , ledgerDefaultYear | ||||
|                                   , emptyLine >> return (return id) | ||||
|                                   , liftM (return . addTimeLogEntry)  timelogentry | ||||
|                                   ] | ||||
| @ -271,6 +278,17 @@ ledgerHistoricalPrice = do | ||||
|   restofline | ||||
|   return $ HistoricalPrice date symbol1 (symbol c) price | ||||
| 
 | ||||
| -- like ledgerAccountBegin, updates the LedgerFileCtx | ||||
| ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger)) | ||||
| ledgerDefaultYear = do | ||||
|   char 'Y' <?> "default year" | ||||
|   many spacenonewline | ||||
|   y <- many1 digit | ||||
|   let y' = read y | ||||
|   guard (y' >= 1000) | ||||
|   setYear y' | ||||
|   return $ return id | ||||
| 
 | ||||
| ledgerEntry :: GenParser Char LedgerFileCtx Entry | ||||
| ledgerEntry = do | ||||
|   date <- ledgerdate <?> "entry" | ||||
|  | ||||
							
								
								
									
										5
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										5
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -227,6 +227,11 @@ misc_tests = TestList [ | ||||
|   , | ||||
|   "ledgerentry"        ~: do | ||||
|     assertparseequal price1 (parseWithCtx ledgerHistoricalPrice price1_str) | ||||
|   , | ||||
|   "ledgerDefaultYear" ~: do | ||||
|     -- something to check default year parsing doesn't blow up | ||||
|     rl <- rawledgerfromstring "Y2009\n" | ||||
| 
 | ||||
|   ] | ||||
| 
 | ||||
| newparse_tests = TestList [ sameParseTests ] | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user