aboutsummaryrefslogtreecommitdiff
path: root/src/Notification.hs
diff options
context:
space:
mode:
authorJoris2015-11-22 01:56:20 +0100
committerJoris2015-11-22 01:56:20 +0100
commitb977bb5ba3d5ad8f8008aa4ceb60d1f988a82a0a (patch)
treeb27b15ea4ea6e7f983259d9c9708ac200e562251 /src/Notification.hs
parent5375ad26dd78220185f1ffe05222250c06dc1a0c (diff)
downloadevents-b977bb5ba3d5ad8f8008aa4ceb60d1f988a82a0a.tar.gz
events-b977bb5ba3d5ad8f8008aa4ceb60d1f988a82a0a.tar.bz2
events-b977bb5ba3d5ad8f8008aa4ceb60d1f988a82a0a.zip
Generate a mail that contains both birthdays today and birthdays next week
Diffstat (limited to 'src/Notification.hs')
-rw-r--r--src/Notification.hs38
1 files changed, 17 insertions, 21 deletions
diff --git a/src/Notification.hs b/src/Notification.hs
index de4a591..e5abe45 100644
--- a/src/Notification.hs
+++ b/src/Notification.hs
@@ -1,8 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Notification
- ( today
- , nextWeek
+ ( todayAndNextWeek
) where
import qualified Data.Text as T
@@ -15,35 +14,32 @@ import Model.Birthdate (Birthdate, filterBirthdayAt, filterBirthdayBetween)
import Model.Mail (mailSubject, mailBody)
import Model.Config
-today :: [Birthdate] -> Config -> IO ()
-today birthdates config = do
+todayAndNextWeek :: [Birthdate] -> Config -> IO ()
+todayAndNextWeek birthdates config = do
currentDate <- getCurrentDate
- let birthdays = filterBirthdayAt currentDate birthdates
- if not (null birthdays)
+ birthdaysToday <- filterBirthdaysToday birthdates
+ birthdaysNextWeek <- filterBirthdaysNextWeek birthdates config
+ if length birthdaysToday > 0 || length birthdaysNextWeek > 0
then
sendMail
(mailTo config)
(mailFrom config)
- (mailSubject birthdays)
- (mailBody currentDate birthdays)
+ (mailSubject birthdaysToday birthdaysNextWeek)
+ (mailBody currentDate birthdaysToday birthdaysNextWeek)
else
return ()
-nextWeek :: [Birthdate] -> Config -> IO ()
-nextWeek birthdates config = do
+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
- let birthdays = filterBirthdayBetween begin end birthdates
- if not (null birthdays)
- then
- sendMail
- (mailTo config)
- (mailFrom config)
- ""
- ""
- else
- return ()
+ return (filterBirthdayBetween begin end birthdates)
else
- return ()
+ return []