diff options
Diffstat (limited to 'src/Model/Date.hs')
| -rw-r--r-- | src/Model/Date.hs | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/src/Model/Date.hs b/src/Model/Date.hs index 081dccc..dd8a09f 100644 --- a/src/Model/Date.hs +++ b/src/Model/Date.hs @@ -2,12 +2,14 @@ module Model.Date ( Date(..) + , SuccessiveDates , renderDate , getCurrentDate , getNextWeek , getWeekDay , plusDays , sameDayAndMonth + , dayAndMonthInRange , isBeforeOrEqualDayAndMonth , yearsGap , daysGap @@ -22,7 +24,7 @@ import Data.Time.LocalTime import Data.Time.Format (formatTime, defaultTimeLocale) import Data.Text (Text) import qualified Data.Text as T -import Data.Maybe (isJust) +import Data.Maybe (isJust, listToMaybe) import Time (formatCurrentLocale) @@ -49,13 +51,13 @@ getCurrentDate = do let zoneNow = utcToLocalTime timezone now return . dateFromDay $ localDay zoneNow -getNextWeek :: IO (Date, Date) +type SuccessiveDates = [Date] + +getNextWeek :: IO SuccessiveDates getNextWeek = do currentDate <- getCurrentDate currentDayNumberOfWeek <- (read . T.unpack <$> formatCurrentLocale "%u") :: IO Int - let begin = currentDate `plusDays` (8 - currentDayNumberOfWeek) - let end = begin `plusDays` 6 - return (begin, end) + return $ map (plusDays currentDate) $ take 7 [(8 - currentDayNumberOfWeek)..] getWeekDay :: Date -> Text getWeekDay = T.toLower . T.pack . formatTime defaultTimeLocale "%A" . dateToDay @@ -93,3 +95,6 @@ daysGap d1 d2 = abs . fromIntegral $ (dateToDay d1) `diffDays` (dateToDay d2) isValid :: Date -> Bool isValid (Date d m y) = isJust $ fromGregorianValid (toInteger y) m d + +dayAndMonthInRange :: [Date] -> Date -> Maybe Date +dayAndMonthInRange dates date = listToMaybe . filter (sameDayAndMonth date) $ dates |