From 6850159bf998a209ad7b6d7103d113a54659937e Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 21 Nov 2015 17:32:28 +0100 Subject: Add filter birthday between function --- README.md | 2 +- src/Birthdate.hs | 17 +++++++++++++---- src/Date.hs | 18 ++++++++++++++++++ src/Main.hs | 30 +++++++++++++++++------------- 4 files changed, 49 insertions(+), 18 deletions(-) diff --git a/README.md b/README.md index ec643c7..5fa517b 100644 --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ birthdates.csv: … ``` -Mail contacts are given in config.txt: +Create config.txt: ``` mail-to = john.dupont@mail.com diff --git a/src/Birthdate.hs b/src/Birthdate.hs index c9d0bda..48d3a4e 100644 --- a/src/Birthdate.hs +++ b/src/Birthdate.hs @@ -4,13 +4,13 @@ module Birthdate ( Birthdate(..) , fullname , age - , filterBirthday + , filterBirthdayAt ) where import Data.Text (Text) import qualified Data.Text as T -import Date (Date, sameDayAndMonth, yearsGap) +import Date data Birthdate = Birthdate { date :: Date @@ -24,5 +24,14 @@ fullname d = T.concat [firstname d, " ", lastname d] age :: Date -> Birthdate -> Int age currentDate birthdate = yearsGap currentDate (date birthdate) -filterBirthday :: Date -> [Birthdate] -> [Birthdate] -filterBirthday d = filter (sameDayAndMonth d . date) +filterBirthdayAt :: Date -> [Birthdate] -> [Birthdate] +filterBirthdayAt d = filter (sameDayAndMonth d . date) + +filterBirthdayBetween :: Date -> Date -> [Birthdate] -> [Birthdate] +filterBirthdayBetween begin end = + filter (\bd -> + let d = date bd + in ( d `isAfterOrEqualDayAndMonth` begin + && d `isBeforeOrEqualDayAndMonth` end + ) + ) diff --git a/src/Date.hs b/src/Date.hs index 8ab9fd2..63830d3 100644 --- a/src/Date.hs +++ b/src/Date.hs @@ -2,6 +2,8 @@ module Date ( Date(..) , getCurrentDate , sameDayAndMonth + , isBeforeOrEqualDayAndMonth + , isAfterOrEqualDayAndMonth , yearsGap ) where @@ -29,5 +31,21 @@ sameDayAndMonth d1 d2 = && month d1 == month d2 ) +isBeforeOrEqualDayAndMonth :: Date -> Date -> Bool +isBeforeOrEqualDayAndMonth d1 d2 = + ( month d1 < month d2 + || ( month d1 == month d2 + && day d1 <= day d2 + ) + ) + +isAfterOrEqualDayAndMonth :: Date -> Date -> Bool +isAfterOrEqualDayAndMonth d1 d2 = + ( month d1 > month d2 + || ( month d1 == month d2 + && day d1 >= day d2 + ) + ) + yearsGap :: Date -> Date -> Int yearsGap d1 d2 = abs (year d2 - year d1) diff --git a/src/Main.hs b/src/Main.hs index 29e9698..d72bd95 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Date (getCurrentDate) -import Birthdate (filterBirthday) +import Birthdate (Birthdate, filterBirthdayAt) import BirthdateParser (parseBirthdates) import Mail (mailSubject, mailBody) import SendMail (sendMail) @@ -43,15 +43,19 @@ main = do , ":\n" , err ] - (Right birthdates, Right config) -> do - currentDate <- getCurrentDate - let birthdays = filterBirthday currentDate birthdates - if not (null birthdays) - then - sendMail - (mailTo config) - (mailFrom config) - (mailSubject birthdays) - (mailBody currentDate birthdays) - else - return () + (Right birthdates, Right config) -> + sendNotificationForBirthdayToday birthdates config + +sendNotificationForBirthdayToday :: [Birthdate] -> Config -> IO () +sendNotificationForBirthdayToday birthdates config = do + currentDate <- getCurrentDate + let birthdays = filterBirthdayAt currentDate birthdates + if not (null birthdays) + then + sendMail + (mailTo config) + (mailFrom config) + (mailSubject birthdays) + (mailBody currentDate birthdays) + else + return () -- cgit v1.2.3