lib: restore previous period expression parser behaviour (PR #807)

- parse a period expression by first extracting words separated by
  single spaces, then by "re-parsing" this text with 'periodexprp'
- this way, the period expression parsers do not need to know about
  the single- or double-space rules

hledger-lib/Hledger/Read/Common.hs

@@ -93,6 +93,7 @@ module Hledger.Read.Common (
 
   -- ** misc
   singlespacedtextp,
+  singlespacedtextsatisfyingp,
   singlespacep,
 
   -- * tests
@@ -568,17 +569,24 @@ modifiedaccountnamep = do
 accountnamep :: TextParser m AccountName
 accountnamep = singlespacedtextp
 
--- | Parse any text beginning with a non-whitespace character, until a double space or the end of input.
+
--- Consumes one of the following spaces, if present.
+-- | Parse any text beginning with a non-whitespace character, until a
+-- double space or the end of input.
 singlespacedtextp :: TextParser m T.Text
-singlespacedtextp = do
+singlespacedtextp = singlespacedtextsatisfyingp (const True)
-  firstPart <- part
+
-  otherParts <- many $ try $ singlespacep *> part
+-- | Similar to 'singlespacedtextp', except that the text must only contain
+-- characters satisfying the given predicate.
+singlespacedtextsatisfyingp :: (Char -> Bool) -> TextParser m T.Text
+singlespacedtextsatisfyingp pred = do
+  firstPart <- partp
+  otherParts <- many $ try $ singlespacep *> partp
   pure $! T.unwords $ firstPart : otherParts
   where
-    part = takeWhile1P Nothing (not . isSpace)
+    partp = takeWhile1P Nothing (\c -> pred c && not (isSpace c))
 
 -- | Parse one non-newline whitespace character that is not followed by another one.
+singlespacep :: TextParser m ()
 singlespacep = void spacenonewline *> notFollowedBy spacenonewline
 
 --- ** amounts

hledger-lib/Hledger/Read/JournalReader.hs

@@ -68,7 +68,6 @@ import qualified Control.Exception as C
 import Control.Monad
 import Control.Monad.Except (ExceptT(..))
 import Control.Monad.State.Strict
-import Data.Bifunctor (first)
 import Data.Maybe
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -510,7 +509,23 @@ periodictransactionp = do
   let refdate = case mdefaultyear of
                   Nothing -> today 
                   Just y  -> fromGregorian y 1 1
-  (periodtxt, (interval, span)) <- lift $ first T.strip <$> match (periodexprp refdate)
+  periodExcerpt <- lift $ excerpt_ $
+                    singlespacedtextsatisfyingp (\c -> c /= ';' && c /= '\n')
+  let periodtxt = T.strip $ getExcerptText periodExcerpt
+
+  -- first parsing with 'singlespacedtextp', then "re-parsing" with
+  -- 'periodexprp' saves 'periodexprp' from having to respect the single-
+  -- and double-space parsing rules
+  (interval, span) <- lift $ reparseExcerpt periodExcerpt $ do
+    pexp <- periodexprp refdate
+    (<|>) eof $ do
+      offset1 <- getOffset
+      void takeRest
+      offset2 <- getOffset
+      customFailure $ parseErrorAtRegion offset1 offset2 $
+           "remainder of period expression cannot be parsed"
+        <> "\nperhaps you need to terminate the period expression with a double space?"
+    pure pexp
 
   -- In periodic transactions, the period expression has an additional constraint:
   case checkPeriodicTransactionStartDate interval span periodtxt of
@@ -657,40 +672,28 @@ tests_JournalReader = tests "JournalReader" [
          ptperiodexpr  = "monthly from 2018/6"
         ,ptinterval    = Months 1
         ,ptspan        = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
-        ,ptstatus      = Unmarked
-        ,ptcode        = ""
         ,ptdescription = ""
         ,ptcomment     = "In 2019 we will change this\n"
-        ,pttags        = []
-        ,ptpostings    = []
         }
 
-     -- TODO some weaknesses in periodic transaction parsing, https://github.com/simonmichael/hledger/pull/807#issuecomment-396994403
+    ,test "more period text in description after two spaces" $ expectParseEq periodictransactionp
-    ,_test "more period text in description after two spaces" $ expectParseEq periodictransactionp 
       "~ monthly from 2018/6   In 2019 we will change this\n" 
       nullperiodictransaction {
          ptperiodexpr  = "monthly from 2018/6"
         ,ptinterval    = Months 1
         ,ptspan        = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
-        ,ptdescription = "In 2019 we will change this\n"
+        ,ptdescription = "In 2019 we will change this"
+        ,ptcomment     = ""
         }
 
-    ,_test "more period text in description after one space" $ expectParseEq periodictransactionp
+    ,test "Next year in description" $ expectParseEq periodictransactionp
-      "~ monthly from 2018/6 In 2019 we will change this\n" 
-      nullperiodictransaction {
-         ptperiodexpr  = "monthly from 2018/6"
-        ,ptinterval    = Months 1
-        ,ptspan        = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
-        ,ptdescription = "In 2019 we will change this\n"
-        }
-
-    ,_test "Next year in description" $ expectParseEq periodictransactionp
       "~ monthly  Next year blah blah\n"
       nullperiodictransaction {
          ptperiodexpr  = "monthly"
         ,ptinterval    = Months 1
         ,ptspan        = DateSpan Nothing Nothing
-        ,ptdescription = "Next year blah blah\n"
+        ,ptdescription = "Next year blah blah"
+        ,ptcomment     = ""
         }
 
     ]

tests/budget/forecast.test

@@ -111,7 +111,7 @@ hledger -f - print --forecast desc:forecast
 <<<
 Y 2000
 
-~ 2/1 forecast
+~ 2/1  forecast
 
 ; a real transaction to set the start of the forecast window
 2000/1/1 real
@@ -128,7 +128,7 @@ hledger -f - print --forecast desc:forecast
 <<<
 Y 2000
 
-~ 15 forecast
+~ 15  forecast
 
 ; a real transaction to set the start of the forecast window
 2000/1/1 real
@@ -145,7 +145,7 @@ hledger -f - print --forecast desc:forecast
 <<<
 Y 2000
 
-~ next month forecast
+~ next month  forecast
 
 ; a real transaction to set the start of the forecast window
 2000/1/1 real