{-# LANGUAGE OverloadedStrings #-} module Model.Mail ( mailSubject , mailBody ) where import Data.Text (Text) import qualified Data.Text as T import Data.Maybe (fromMaybe) import Model.Date import Model.Birthdate data Event = Today | NextWeek deriving (Eq, Show) mailSubject :: [Birthdate] -> [Birthdate] -> Text mailSubject birthdaysToday birthdaysNextWeek = T.concat [ "Hey, " , if not . null $ birthdaysToday then mailSubjectSentence Today birthdaysToday else "" , if not . null $ birthdaysNextWeek then T.concat [ if not . null $ birthdaysToday then " and " else "" , mailSubjectSentence NextWeek birthdaysNextWeek ] else "" , "!" ] mailSubjectSentence :: Event -> [Birthdate] -> Text mailSubjectSentence event birthdates = let count = length birthdates in T.concat [ 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 "" , " " , if event == Today then "today" else "next week" ] mailBody :: Date -> SuccessiveDates -> [Birthdate] -> [Birthdate] -> Text mailBody currentDate nextWeek birthdaysToday birthdaysNextWeek = T.concat [ if not . null $ birthdaysToday then mailBodySentence Today currentDate nextWeek birthdaysToday else "" , if not . null $ birthdaysNextWeek then T.concat [ if not . null $ birthdaysToday then " " else "" , mailBodySentence NextWeek currentDate nextWeek birthdaysNextWeek ] else "" ] mailBodySentence :: Event -> Date -> SuccessiveDates -> [Birthdate] -> Text mailBodySentence event currentDate nextWeek birthdates = T.concat $ map (mailBodyPart event currentDate nextWeek) (attachLines birthdates) attachLines :: [Birthdate] -> [(Line, Birthdate)] attachLines birthdates = let count = length birthdates lineKind 1 = if count == 1 then SingleLine else FirstLine lineKind line = if line == count then LastLine else MiddleLine mapFst f (x, y) = (f x, y) in map (mapFst lineKind) . zip [1..] $ birthdates data Line = SingleLine | FirstLine | MiddleLine | LastLine deriving (Eq, Show) mailBodyPart :: Event -> Date -> SuccessiveDates -> (Line, Birthdate) -> Text mailBodyPart event currDate nextWeek (line, birthdate) = let nextWeekDay = dayAndMonthInRange nextWeek (date birthdate) in T.concat [ case line of x | x `elem` [SingleLine, FirstLine] -> if event == Today then "Today, " else "Next week, " MiddleLine -> ", " LastLine -> " and " _ -> "" , fullname birthdate , if event == Today then " is " else " will be " , T.pack . show $ if event == Today then age currDate birthdate else fromMaybe 0 $ (\d -> year d - year (date birthdate)) <$> nextWeekDay , " years old" , if event == NextWeek then fromMaybe "" $ (\d -> T.concat [" on " , getWeekDay d]) <$> nextWeekDay else "" , if line == SingleLine || line == LastLine then "." else "" ]