lib: fix error triggered by upper-case day in period expression (#847)
This commit is contained in:
parent
da8047d286
commit
aab7d2d964
@ -625,10 +625,12 @@ nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameM
|
||||
|
||||
-- | Advance to nth weekday wd after given start day s
|
||||
advancetonthweekday :: Int -> WeekDay -> Day -> Day
|
||||
advancetonthweekday n wd s = addWeeks (n-1) . firstMatch (>=s) . iterate (addWeeks 1) $ firstweekday s
|
||||
where
|
||||
advancetonthweekday n wd s =
|
||||
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)
|
||||
firstMatch p = head . dropWhile (not . p)
|
||||
firstMatch p = headMay . dropWhile (not . p)
|
||||
firstweekday = addDays (fromIntegral wd-1) . startofweek
|
||||
|
||||
----------------------------------------------------------------------
|
||||
@ -827,6 +829,7 @@ md = do
|
||||
failIfInvalidDay d
|
||||
return ("",m,d)
|
||||
|
||||
-- These are compared case insensitively, and should all be kept lower case.
|
||||
months = ["january","february","march","april","may","june",
|
||||
"july","august","september","october","november","december"]
|
||||
monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
|
||||
@ -850,9 +853,11 @@ mon = do
|
||||
|
||||
weekday :: TextParser m Int
|
||||
weekday = do
|
||||
wday <- choice . map string' $ weekdays ++ weekdayabbrevs
|
||||
let i = head . catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs]
|
||||
return (i+1)
|
||||
wday <- T.toLower <$> (choice . map string' $ weekdays ++ weekdayabbrevs)
|
||||
case catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] of
|
||||
(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 = string' "today" >> return ("","","today")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user