aboutsummaryrefslogtreecommitdiff
path: root/src/Notification.hs
diff options
context:
space:
mode:
authorJoris2015-11-29 14:43:06 +0100
committerJoris2015-11-29 14:43:06 +0100
commite6269b6750d50c2f72bf534e32c020f0554705a7 (patch)
tree5247f2f6a8f207a8ee022b02614ba01b7488849c /src/Notification.hs
parentb0f00782ebc9ca6825a6c87b41e5c4888c009a65 (diff)
downloadevents-e6269b6750d50c2f72bf534e32c020f0554705a7.tar.gz
events-e6269b6750d50c2f72bf534e32c020f0554705a7.tar.bz2
events-e6269b6750d50c2f72bf534e32c020f0554705a7.zip
Use next week range to compute next week age and next week day of birthdates
Diffstat (limited to 'src/Notification.hs')
-rw-r--r--src/Notification.hs32
1 files changed, 13 insertions, 19 deletions
diff --git a/src/Notification.hs b/src/Notification.hs
index 18cd260..6e6677e 100644
--- a/src/Notification.hs
+++ b/src/Notification.hs
@@ -9,37 +9,31 @@ import qualified Data.Text as T
import SendMail (sendMail)
import Time (formatCurrentLocale)
-import Model.Date (getCurrentDate, getNextWeek)
-import Model.Birthdate (Birthdate, filterBirthdayAt, filterBirthdayBetween)
+import Model.Date (getCurrentDate, getNextWeek, SuccessiveDates)
+import Model.Birthdate (Birthdate, filterBirthdayAt, filterBirthdayInside)
import Model.Mail (mailSubject, mailBody)
import Model.Config
notifyTodayAndNextWeek :: [Birthdate] -> Config -> IO ()
notifyTodayAndNextWeek birthdates config = do
currentDate <- getCurrentDate
- birthdaysToday <- filterBirthdaysToday birthdates
- birthdaysNextWeek <- filterBirthdaysNextWeek birthdates config
+ let birthdaysToday = filterBirthdayAt currentDate birthdates
+ nextWeek <- getNextWeek
+ birthdaysNextWeek <- filterBirthdaysNextWeek config nextWeek birthdates
if length birthdaysToday > 0 || length birthdaysNextWeek > 0
then
sendMail
(mailTo config)
(mailFrom config)
(mailSubject birthdaysToday birthdaysNextWeek)
- (mailBody currentDate birthdaysToday birthdaysNextWeek)
+ (mailBody currentDate nextWeek birthdaysToday birthdaysNextWeek)
else
return ()
-filterBirthdaysToday :: [Birthdate] -> IO [Birthdate]
-filterBirthdaysToday birthdates = do
- currentDate <- getCurrentDate
- return (filterBirthdayAt currentDate birthdates)
-
-filterBirthdaysNextWeek :: [Birthdate] -> Config -> IO [Birthdate]
-filterBirthdaysNextWeek birthdates config = do
- currentDayOfWeek <- formatCurrentLocale "%A"
- if T.toLower currentDayOfWeek == T.toLower (dayForNextWeekNotification config)
- then do
- (begin, end) <- getNextWeek
- return (filterBirthdayBetween begin end birthdates)
- else
- return []
+filterBirthdaysNextWeek :: Config -> SuccessiveDates -> [Birthdate] -> IO [Birthdate]
+filterBirthdaysNextWeek config nextWeek birthdates =
+ (\currentDayOfWeek ->
+ if T.toLower currentDayOfWeek == T.toLower (dayForNextWeekNotification config)
+ then filterBirthdayInside nextWeek birthdates
+ else []
+ ) <$> formatCurrentLocale "%A"