lib: refactor some journal, period expression parsers

hledger-lib/Hledger/Data/Dates.hs

@@ -45,6 +45,7 @@ module Hledger.Data.Dates (
   elapsedSeconds,
   prevday,
   parsePeriodExpr,
+  parsePeriodExpr',
   nulldatespan,
   failIfInvalidYear,
   failIfInvalidMonth,
@@ -313,7 +314,13 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
 -- | Parse a period expression to an Interval and overall DateSpan using
 -- the provided reference date, or return a parse error.
 parsePeriodExpr :: Day -> Text -> Either (ParseError Char CustomErr) (Interval, DateSpan)
-parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s)
+parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
+
+-- | Like parsePeriodExpr, but call error' on failure.
+parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
+parsePeriodExpr' refdate s =
+  either (error' . ("failed to parse:" ++) . parseErrorPretty) id $
+  parsePeriodExpr refdate s
 
 maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
 maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
@@ -910,23 +917,23 @@ lastthisnextthing = do
 -- Right (DayOfMonth 2,DateSpan 2009/01/01-)
 -- >>> p "every 2nd day of month 2009-"
 -- Right (DayOfMonth 2,DateSpan 2009/01/01-)
-periodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
+periodexprp :: Day -> SimpleTextParser (Interval, DateSpan)
-periodexpr rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [
+periodexprp rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [
-                    intervalanddateperiodexpr rdate,
+                    intervalanddateperiodexprp rdate,
-                    (,) NoInterval <$> periodexprdatespan rdate
+                    (,) NoInterval <$> periodexprdatespanp rdate
                    ]
 
-intervalanddateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
+intervalanddateperiodexprp :: Day -> SimpleTextParser (Interval, DateSpan)
-intervalanddateperiodexpr rdate = do
+intervalanddateperiodexprp rdate = do
-  i <- reportinginterval
+  i <- reportingintervalp
   s <- option def . try $ do
       skipMany spacenonewline
-      periodexprdatespan rdate
+      periodexprdatespanp rdate
   return (i,s)
 
 -- Parse a reporting interval.
-reportinginterval :: SimpleTextParser Interval
+reportingintervalp :: SimpleTextParser Interval
-reportinginterval = choice' [
+reportingintervalp = choice' [
                        tryinterval "day"     "daily"     Days,
                        tryinterval "week"    "weekly"    Weeks,
                        tryinterval "month"   "monthly"   Months,
@@ -1007,19 +1014,19 @@ reportinginterval = choice' [
           singular' = T.pack singular
           plural'   = T.pack $ singular ++ "s"
 
-periodexprdatespan :: Day -> SimpleTextParser DateSpan
+periodexprdatespanp :: Day -> SimpleTextParser DateSpan
-periodexprdatespan rdate = choice $ map try [
+periodexprdatespanp rdate = choice $ map try [
-                            doubledatespan rdate,
+                            doubledatespanp rdate,
-                            fromdatespan rdate,
+                            fromdatespanp rdate,
-                            todatespan rdate,
+                            todatespanp rdate,
-                            justdatespan rdate
+                            justdatespanp rdate
                            ]
 
 -- |
 -- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804"
 -- Right DateSpan 2018/01/01-2018/04/01
-doubledatespan :: Day -> SimpleTextParser DateSpan
+doubledatespanp :: Day -> SimpleTextParser DateSpan
-doubledatespan rdate = do
+doubledatespanp rdate = do
   optional (string "from" >> skipMany spacenonewline)
   b <- smartdate
   skipMany spacenonewline
@@ -1027,8 +1034,8 @@ doubledatespan rdate = do
   e <- smartdate
   return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
 
-fromdatespan :: Day -> SimpleTextParser DateSpan
+fromdatespanp :: Day -> SimpleTextParser DateSpan
-fromdatespan rdate = do
+fromdatespanp rdate = do
   b <- choice [
     do
       string "from" >> skipMany spacenonewline
@@ -1041,14 +1048,14 @@ fromdatespan rdate = do
     ]
   return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
 
-todatespan :: Day -> SimpleTextParser DateSpan
+todatespanp :: Day -> SimpleTextParser DateSpan
-todatespan rdate = do
+todatespanp rdate = do
   choice [string "to", string "-"] >> skipMany spacenonewline
   e <- smartdate
   return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
 
-justdatespan :: Day -> SimpleTextParser DateSpan
+justdatespanp :: Day -> SimpleTextParser DateSpan
-justdatespan rdate = do
+justdatespanp rdate = do
   optional (string "in" >> skipMany spacenonewline)
   d <- smartdate
   return $ spanFromSmartDate rdate d

hledger-lib/Hledger/Data/Types.hs

@@ -223,8 +223,8 @@ instance Eq Posting where
 
 -- TODO: needs renaming, or removal if no longer needed. See also TextPosition in Hledger.UI.Editor
 -- | The position of parse errors (eg), like parsec's SourcePos but generic.
-data GenericSourcePos = GenericSourcePos FilePath Int Int    -- ^ name, 1-based line number and 1-based column number.
+data GenericSourcePos = GenericSourcePos FilePath Int Int    -- ^ file path, 1-based line number and 1-based column number.
-                      | JournalSourcePos FilePath (Int, Int) -- ^ file name, inclusive range of 1-based line numbers (first, last).
+                      | JournalSourcePos FilePath (Int, Int) -- ^ file path, inclusive range of 1-based line numbers (first, last).
   deriving (Eq, Read, Show, Ord, Data, Generic, Typeable)
 
 instance NFData GenericSourcePos

hledger-lib/Hledger/Read/Common.hs

@@ -86,7 +86,11 @@ module Hledger.Read.Common (
   postingcommentp,
 
   -- ** bracketed dates
-  bracketeddatetagsp
+  bracketeddatetagsp,
+
+  -- ** misc
+  singlespacedtextp,
+  singlespacep
 )
 where
 --- * imports
@@ -193,6 +197,7 @@ rjp = runJournalParser
 genericSourcePos :: SourcePos -> GenericSourcePos
 genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
 
+-- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's. 
 journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos
 journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p, fromIntegral $ line')
     where line'
@@ -438,19 +443,26 @@ modifiedaccountnamep = do
     joinAccountNames parent
     a
 
--- | Parse an account name. Account names start with a non-space, may
+-- | Parse an account name, plus one following space if present. 
--- have single spaces inside them, and are terminated by two or more
+-- Account names start with a non-space, may have single spaces inside them, 
--- spaces (or end of input). Also they have one or more components of
+-- and are terminated by two or more spaces (or end of input). 
--- at least one character, separated by the account separator char.
+-- (Also they have one or more components of at least one character, 
--- (This parser will also consume one following space, if present.)
+-- separated by the account separator character, but we don't check that here.) 
 accountnamep :: TextParser m AccountName
-accountnamep = do
+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.
+singlespacedtextp :: TextParser m T.Text
+singlespacedtextp = do
   firstPart <- part
-  otherParts <- many $ try $ singleSpace *> part
+  otherParts <- many $ try $ singlespacep *> part
   pure $! T.unwords $ firstPart : otherParts
   where
     part = takeWhile1P Nothing (not . isSpace)
-    singleSpace = void spacenonewline *> notFollowedBy spacenonewline
+
+-- | Parse one non-newline whitespace character that is not followed by another one.
+singlespacep = void spacenonewline *> notFollowedBy spacenonewline
 
 --- ** amounts
 

hledger-lib/Hledger/Read/JournalReader.hs

@@ -470,7 +470,7 @@ periodictransactionp = do
 transactionp :: JournalParser m Transaction
 transactionp = do
   -- ptrace "transactionp"
-  pos <- getPosition
+  startpos <- getPosition
   date <- datep <?> "transaction"
   edate <- optional (lift $ secondarydatep date) <?> "secondary date"
   lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
@@ -480,8 +480,8 @@ transactionp = do
   (comment, tags) <- lift transactioncommentp
   let year = first3 $ toGregorian date
   postings <- postingsp (Just year)
-  pos' <- getPosition
+  endpos <- getPosition
-  let sourcepos = journalSourcePos pos pos'
+  let sourcepos = journalSourcePos startpos endpos
   return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
 
 #ifdef TESTS