aboutsummaryrefslogtreecommitdiff
path: root/src/Model/Mail.hs
blob: 2af2159257c27ecdfe5ca41e6f0df7437ed72ea6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
{-# LANGUAGE OverloadedStrings #-}

module Model.Mail
  ( mailSubject
  , mailBody
  ) where

import Data.Text (Text)
import qualified Data.Text as T

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 -> [Birthdate] -> [Birthdate] -> Text
mailBody currentDate birthdaysToday birthdaysNextWeek =
  T.concat
    [ if not . null $ birthdaysToday
        then mailBodySentence Today currentDate birthdaysToday
        else ""
    , if not . null $ birthdaysNextWeek
        then
          T.concat
            [ if not . null $ birthdaysToday 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 =
  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 -> (Line, Birthdate) -> Text
mailBodyPart event currDate (line, birthdate) =
  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 ageNextWeek currDate birthdate
    , " years old"
    , if line == SingleLine || line == LastLine then "." else ""
    ]