From 53ad035b24d80b4362db23a9cea6de9ec2f5a09c Mon Sep 17 00:00:00 2001
From: Mykola Orliuk <virkony@gmail.com>
Date: Fri, 3 Nov 2017 01:53:37 +0100
Subject: [PATCH] journal: limit scope of directives backtracking

Effectively improves error reporting for directives.

Resolves simonmichael/hledger#402
---
 hledger-lib/Hledger/Read/JournalReader.hs | 22 +++++++++++++++++-----
 tests/journal/directives.test             | 17 +++++++++++++++++
 2 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index a41539bfc..4d1a5e0d5 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -81,6 +81,8 @@ import Control.Monad.State.Strict
 import qualified Data.Map.Strict as M
 import Data.Monoid
 import Data.Text (Text)
+import Data.String
+import Data.List
 import qualified Data.Text as T
 import Data.Time.Calendar
 import Data.Time.LocalTime
@@ -157,7 +159,7 @@ addJournalItemP =
 directivep :: MonadIO m => ErroringJournalParser m ()
 directivep = (do
   optional $ char '!'
-  choiceInState [
+  choice [
     includedirectivep
    ,aliasdirectivep
    ,endaliasesdirectivep
@@ -292,9 +294,19 @@ formatdirectivep expectedsym = do
     else parserErrorAt pos $
          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 = do
-  string "apply" >> lift (some spacenonewline) >> string "account"
+  keywordsp "apply account" <?> "apply account directive"
   lift (some spacenonewline)
   parent <- lift accountnamep
   newline
@@ -302,7 +314,7 @@ applyaccountdirectivep = do
 
 endapplyaccountdirectivep :: JournalParser m ()
 endapplyaccountdirectivep = do
-  string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account"
+  keywordsp "end apply account" <?> "end apply account directive"
   popParentAccount
 
 aliasdirectivep :: JournalParser m ()
@@ -338,7 +350,7 @@ regexaliasp = do
 
 endaliasesdirectivep :: JournalParser m ()
 endaliasesdirectivep = do
-  string "end aliases"
+  keywordsp "end aliases" <?> "end aliases directive"
   clearAccountAliases
 
 tagdirectivep :: JournalParser m ()
@@ -351,7 +363,7 @@ tagdirectivep = do
 
 endtagdirectivep :: JournalParser m ()
 endtagdirectivep = do
-  (string "end tag" <|> string "pop") <?> "end tag or pop directive"
+  (keywordsp "end tag" <|> keywordp "pop") <?> "end tag or pop directive"
   lift restofline
   return ()
 
diff --git a/tests/journal/directives.test b/tests/journal/directives.test
index 372408ea8..b0fc314ec 100644
--- a/tests/journal/directives.test
+++ b/tests/journal/directives.test
@@ -16,3 +16,20 @@ a:b
 aa:b
 c
 >>>=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