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