slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: fix error triggered by upper-case day in period expression (#847)

Browse Source
This commit is contained in:
Simon Michael 2018-07-24 14:36:45 +01:00
parent da8047d286
commit aab7d2d964
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
hledger-lib/Hledger/Data/Dates.hs
View File

@ -625,10 +625,12 @@ nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameM
-- | Advance to nth weekday wd after given start day s -- | Advance to nth weekday wd after given start day s
advancetonthweekday :: Int -> WeekDay -> Day -> Day advancetonthweekday :: Int -> WeekDay -> Day -> Day
advancetonthweekday n wd s = addWeeks (n-1) . firstMatch (>=s) . iterate (addWeeks 1) $ firstweekday s advancetonthweekday n wd s =
where maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s
where
err = error' "advancetonthweekday: should not happen"
addWeeks k = addDays (7 * fromIntegral k) addWeeks k = addDays (7 * fromIntegral k)
firstMatch p = head . dropWhile (not . p) firstMatch p = headMay . dropWhile (not . p)
firstweekday = addDays (fromIntegral wd-1) . startofweek firstweekday = addDays (fromIntegral wd-1) . startofweek
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -827,6 +829,7 @@ md = do
failIfInvalidDay d failIfInvalidDay d
return ("",m,d) return ("",m,d)
-- These are compared case insensitively, and should all be kept lower case.
months = ["january","february","march","april","may","june", months = ["january","february","march","april","may","june",
"july","august","september","october","november","december"] "july","august","september","october","november","december"]
monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
@ -850,9 +853,11 @@ mon = do
weekday :: TextParser m Int weekday :: TextParser m Int
weekday = do weekday = do
wday <- choice . map string' $ weekdays ++ weekdayabbrevs wday <- T.toLower <$> (choice . map string' $ weekdays ++ weekdayabbrevs)
let i = head . catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] case catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] of
return (i+1) (i:_) -> return (i+1)
[] -> fail $ "weekday: should not happen: attempted to find " <>
show wday <> " in " <> show (weekdays ++ weekdayabbrevs)
today,yesterday,tomorrow :: TextParser m SmartDate today,yesterday,tomorrow :: TextParser m SmartDate
today = string' "today" >> return ("","","today") today = string' "today" >> return ("","","today")