journal: limit scope of directives backtracking
Effectively improves error reporting for directives. Resolves simonmichael/hledger#402
This commit is contained in:
		
							parent
							
								
									48623b4ceb
								
							
						
					
					
						commit
						53ad035b24
					
				| @ -81,6 +81,8 @@ import Control.Monad.State.Strict | |||||||
| import qualified Data.Map.Strict as M | import qualified Data.Map.Strict as M | ||||||
| import Data.Monoid | import Data.Monoid | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
|  | import Data.String | ||||||
|  | import Data.List | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Data.Time.LocalTime | import Data.Time.LocalTime | ||||||
| @ -157,7 +159,7 @@ addJournalItemP = | |||||||
| directivep :: MonadIO m => ErroringJournalParser m () | directivep :: MonadIO m => ErroringJournalParser m () | ||||||
| directivep = (do | directivep = (do | ||||||
|   optional $ char '!' |   optional $ char '!' | ||||||
|   choiceInState [ |   choice [ | ||||||
|     includedirectivep |     includedirectivep | ||||||
|    ,aliasdirectivep |    ,aliasdirectivep | ||||||
|    ,endaliasesdirectivep |    ,endaliasesdirectivep | ||||||
| @ -292,9 +294,19 @@ formatdirectivep expectedsym = do | |||||||
|     else parserErrorAt pos $ |     else parserErrorAt pos $ | ||||||
|          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity |          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity | ||||||
| 
 | 
 | ||||||
|  | keywordp :: String -> JournalParser m () | ||||||
|  | keywordp = (() <$) . string . fromString | ||||||
|  | 
 | ||||||
|  | spacesp :: JournalParser m () | ||||||
|  | spacesp = () <$ lift (some spacenonewline) | ||||||
|  | 
 | ||||||
|  | -- | Backtracking parser similar to string, but allows varying amount of space between words | ||||||
|  | keywordsp :: String -> JournalParser m () | ||||||
|  | keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words | ||||||
|  | 
 | ||||||
| applyaccountdirectivep :: JournalParser m () | applyaccountdirectivep :: JournalParser m () | ||||||
| applyaccountdirectivep = do | applyaccountdirectivep = do | ||||||
|   string "apply" >> lift (some spacenonewline) >> string "account" |   keywordsp "apply account" <?> "apply account directive" | ||||||
|   lift (some spacenonewline) |   lift (some spacenonewline) | ||||||
|   parent <- lift accountnamep |   parent <- lift accountnamep | ||||||
|   newline |   newline | ||||||
| @ -302,7 +314,7 @@ applyaccountdirectivep = do | |||||||
| 
 | 
 | ||||||
| endapplyaccountdirectivep :: JournalParser m () | endapplyaccountdirectivep :: JournalParser m () | ||||||
| endapplyaccountdirectivep = do | endapplyaccountdirectivep = do | ||||||
|   string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account" |   keywordsp "end apply account" <?> "end apply account directive" | ||||||
|   popParentAccount |   popParentAccount | ||||||
| 
 | 
 | ||||||
| aliasdirectivep :: JournalParser m () | aliasdirectivep :: JournalParser m () | ||||||
| @ -338,7 +350,7 @@ regexaliasp = do | |||||||
| 
 | 
 | ||||||
| endaliasesdirectivep :: JournalParser m () | endaliasesdirectivep :: JournalParser m () | ||||||
| endaliasesdirectivep = do | endaliasesdirectivep = do | ||||||
|   string "end aliases" |   keywordsp "end aliases" <?> "end aliases directive" | ||||||
|   clearAccountAliases |   clearAccountAliases | ||||||
| 
 | 
 | ||||||
| tagdirectivep :: JournalParser m () | tagdirectivep :: JournalParser m () | ||||||
| @ -351,7 +363,7 @@ tagdirectivep = do | |||||||
| 
 | 
 | ||||||
| endtagdirectivep :: JournalParser m () | endtagdirectivep :: JournalParser m () | ||||||
| endtagdirectivep = do | endtagdirectivep = do | ||||||
|   (string "end tag" <|> string "pop") <?> "end tag or pop directive" |   (keywordsp "end tag" <|> keywordp "pop") <?> "end tag or pop directive" | ||||||
|   lift restofline |   lift restofline | ||||||
|   return () |   return () | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -16,3 +16,20 @@ a:b | |||||||
| aa:b | aa:b | ||||||
| c | c | ||||||
| >>>=0 | >>>=0 | ||||||
|  | 
 | ||||||
|  | # empty multi-line commodity directive | ||||||
|  | hledger -f - reg | ||||||
|  | <<< | ||||||
|  | commodity BTC | ||||||
|  | >>> | ||||||
|  | >>>2 | ||||||
|  | >>>=0 | ||||||
|  | 
 | ||||||
|  | # unsupported commodity sub-directive | ||||||
|  | hledger -f - reg | ||||||
|  | <<< | ||||||
|  | commodity BTC | ||||||
|  |   note Bitcoin | ||||||
|  | >>> | ||||||
|  | >>>2 /expecting "format"/ | ||||||
|  | >>>=1 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user