diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 0e2337821..8752acf63 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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) -periodexpr rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [ - intervalanddateperiodexpr rdate, - (,) NoInterval <$> periodexprdatespan rdate +periodexprp :: Day -> SimpleTextParser (Interval, DateSpan) +periodexprp rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [ + intervalanddateperiodexprp rdate, + (,) NoInterval <$> periodexprdatespanp rdate ] -intervalanddateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan) -intervalanddateperiodexpr rdate = do - i <- reportinginterval +intervalanddateperiodexprp :: Day -> SimpleTextParser (Interval, DateSpan) +intervalanddateperiodexprp rdate = do + i <- reportingintervalp s <- option def . try $ do skipMany spacenonewline - periodexprdatespan rdate + periodexprdatespanp rdate return (i,s) -- Parse a reporting interval. -reportinginterval :: SimpleTextParser Interval -reportinginterval = choice' [ +reportingintervalp :: SimpleTextParser Interval +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 -periodexprdatespan rdate = choice $ map try [ - doubledatespan rdate, - fromdatespan rdate, - todatespan rdate, - justdatespan rdate +periodexprdatespanp :: Day -> SimpleTextParser DateSpan +periodexprdatespanp rdate = choice $ map try [ + doubledatespanp rdate, + fromdatespanp rdate, + todatespanp rdate, + justdatespanp rdate ] -- | -- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804" -- Right DateSpan 2018/01/01-2018/04/01 -doubledatespan :: Day -> SimpleTextParser DateSpan -doubledatespan rdate = do +doubledatespanp :: Day -> SimpleTextParser DateSpan +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 -fromdatespan rdate = do +fromdatespanp :: Day -> SimpleTextParser DateSpan +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 -todatespan rdate = do +todatespanp :: Day -> SimpleTextParser DateSpan +todatespanp rdate = do choice [string "to", string "-"] >> skipMany spacenonewline e <- smartdate return $ DateSpan Nothing (Just $ fixSmartDate rdate e) -justdatespan :: Day -> SimpleTextParser DateSpan -justdatespan rdate = do +justdatespanp :: Day -> SimpleTextParser DateSpan +justdatespanp rdate = do optional (string "in" >> skipMany spacenonewline) d <- smartdate return $ spanFromSmartDate rdate d diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index a6af98953..45f4b6712 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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. - | JournalSourcePos FilePath (Int, Int) -- ^ file name, inclusive range of 1-based line numbers (first, last). +data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ file path, 1-based line number and 1-based column number. + | 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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b680320cd..bcac13127 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/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 --- have single spaces inside them, and are terminated by two or more --- spaces (or end of input). Also they have one or more components of --- at least one character, separated by the account separator char. --- (This parser will also consume one following space, if present.) +-- | Parse an account name, plus one following space if present. +-- Account names start with a non-space, may have single spaces inside them, +-- and are terminated by two or more spaces (or end of input). +-- (Also they have one or more components of at least one character, +-- 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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 9e4be5425..36f7b9ddf 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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 - let sourcepos = journalSourcePos pos pos' + endpos <- getPosition + let sourcepos = journalSourcePos startpos endpos return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings "" #ifdef TESTS