diff options
Diffstat (limited to 'src/Model')
-rw-r--r-- | src/Model/Birthdate.hs | 6 | ||||
-rw-r--r-- | src/Model/Date.hs | 19 | ||||
-rw-r--r-- | src/Model/Mail.hs | 77 |
3 files changed, 73 insertions, 29 deletions
diff --git a/src/Model/Birthdate.hs b/src/Model/Birthdate.hs index d135419..32bd6a4 100644 --- a/src/Model/Birthdate.hs +++ b/src/Model/Birthdate.hs @@ -25,6 +25,10 @@ fullname d = T.concat [firstname d, " ", lastname d] age :: Date -> Birthdate -> Int age currentDate birthdate = yearsGap currentDate (date birthdate) +ageNextWeek :: Date -> Birthdate -> Int +ageNextWeek currentDate birthdate = + (+1) $ (daysGap currentDate (date birthdate)) `div` 365 + filterBirthdayAt :: Date -> [Birthdate] -> [Birthdate] filterBirthdayAt d = filter (sameDayAndMonth d . date) @@ -32,7 +36,7 @@ filterBirthdayBetween :: Date -> Date -> [Birthdate] -> [Birthdate] filterBirthdayBetween begin end = filter (\bd -> let d = date bd - in ( d `isAfterOrEqualDayAndMonth` begin + in ( begin `isBeforeOrEqualDayAndMonth` d && d `isBeforeOrEqualDayAndMonth` end ) ) diff --git a/src/Model/Date.hs b/src/Model/Date.hs index 96c15e9..e095cc6 100644 --- a/src/Model/Date.hs +++ b/src/Model/Date.hs @@ -7,8 +7,8 @@ module Model.Date , plusDays , sameDayAndMonth , isBeforeOrEqualDayAndMonth - , isAfterOrEqualDayAndMonth , yearsGap + , daysGap ) where import Data.Time.Clock @@ -40,8 +40,10 @@ getNextWeek = do return (begin, end) plusDays :: Date -> Int -> Date -plusDays (Date d m y) n = - dateFromDay . addDays (toInteger n) $ fromGregorian (toInteger y) m d +plusDays date n = dateFromDay . addDays (toInteger n) . dateToDay $ date + +dateToDay :: Date -> Day +dateToDay (Date d m y) = fromGregorian (toInteger y) m d dateFromDay :: Day -> Date dateFromDay dayTime = @@ -62,13 +64,8 @@ isBeforeOrEqualDayAndMonth d1 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) + +daysGap :: Date -> Date -> Int +daysGap d1 d2 = abs . fromIntegral $ (dateToDay d1) `diffDays` (dateToDay d2) diff --git a/src/Model/Mail.hs b/src/Model/Mail.hs index e730e32..19ebaeb 100644 --- a/src/Model/Mail.hs +++ b/src/Model/Mail.hs @@ -11,22 +11,62 @@ import qualified Data.Text as T import Model.Date import Model.Birthdate -mailSubject :: [Birthdate] -> Text -mailSubject birthdates = +data Event = + Today + | NextWeek + deriving (Eq, Show) + +mailSubject :: [Birthdate] -> [Birthdate] -> Text +mailSubject birthdaysToday birthdaysNextWeek = + T.concat + [ "Hey, " + , if length birthdaysToday > 0 + then mailSubjectSentence Today birthdaysToday + else "" + , if length birthdaysNextWeek > 0 + then + T.concat + [ if length birthdaysToday > 0 then " and " else "" + , mailSubjectSentence NextWeek birthdaysNextWeek + ] + else + "" + , "!" + ] + +mailSubjectSentence :: Event -> [Birthdate] -> Text +mailSubjectSentence event birthdates = let count = length birthdates in T.concat - [ "Hey, " - , if count > 1 then "there are" else "there is" + [ case event of + Today -> if count > 1 then "there are" else "there is" + NextWeek -> "there will be" , " " , T.pack . show $ count , " birthday" , if count > 1 then "s" else "" - , " today!" + , " " + , if event == Today then "today" else "next week" ] -mailBody :: Date -> [Birthdate] -> Text -mailBody currentDate birthdates = - T.concat $ map (mailLine currentDate) (attachLines birthdates) +mailBody :: Date -> [Birthdate] -> [Birthdate] -> Text +mailBody currentDate birthdaysToday birthdaysNextWeek = + T.concat + [ if length birthdaysToday > 0 + then mailBodySentence Today currentDate birthdaysToday + else "" + , if length birthdaysNextWeek > 0 + then + T.concat + [ if length birthdaysToday > 0 then " " else "" + , mailBodySentence NextWeek currentDate birthdaysNextWeek + ] + else "" + ] + +mailBodySentence :: Event -> Date -> [Birthdate] -> Text +mailBodySentence event currentDate birthdates = + T.concat $ map (mailBodyPart event currentDate) (attachLines birthdates) attachLines :: [Birthdate] -> [(Line, Birthdate)] attachLines birthdates = @@ -43,18 +83,21 @@ data Line = | LastLine deriving (Eq, Show) -mailLine :: Date -> (Line, Birthdate) -> Text -mailLine currDate (line, birthdate) = +mailBodyPart :: Event -> Date -> (Line, Birthdate) -> Text +mailBodyPart event currDate (line, birthdate) = T.concat [ case line of - MiddleLine -> ", " - LastLine -> " and " - _ -> "" + x | x `elem` [SingleLine, FirstLine] -> + if event == Today then "Today, " else "Next week, " + MiddleLine -> + ", " + LastLine -> + " and " + _ -> + "" , fullname birthdate - , case line of - x | x `elem` [SingleLine, FirstLine] -> " is now " - _ -> " is " + , if event == Today then " is " else " will be " , T.pack . show $ age currDate birthdate , " years old" - , if line == LastLine then "." else "" + , if line == SingleLine || line == LastLine then "." else "" ] |