aboutsummaryrefslogtreecommitdiff
path: root/src/Notification.hs
blob: de4a591437aff6e239a8fda4f0f67028515e8856 (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
{-# LANGUAGE OverloadedStrings #-}

module Notification
  ( today
  , nextWeek
  ) where

import qualified Data.Text as T

import SendMail (sendMail)
import Time (formatCurrentLocale)

import Model.Date (getCurrentDate, getNextWeek)
import Model.Birthdate (Birthdate, filterBirthdayAt, filterBirthdayBetween)
import Model.Mail (mailSubject, mailBody)
import Model.Config

today :: [Birthdate] -> Config -> IO ()
today 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 ()

nextWeek :: [Birthdate] -> Config -> IO ()
nextWeek 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 ()
    else
      return ()