From e6269b6750d50c2f72bf534e32c020f0554705a7 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 29 Nov 2015 14:43:06 +0100
Subject: Use next week range to compute next week age and next week day of
 birthdates

---
 src/Model/Date.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'src/Model/Date.hs')

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
-- 
cgit v1.2.3