From 5375ad26dd78220185f1ffe05222250c06dc1a0c Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 21 Nov 2015 21:41:38 +0100
Subject: Get next week birthdays and send an empty mail for the moment

---
 src/Birthdate.hs             | 37 ----------------------
 src/BirthdateParser.hs       | 57 ---------------------------------
 src/Config.hs                | 32 -------------------
 src/Date.hs                  | 51 ------------------------------
 src/Logger.hs                |  6 ++--
 src/Mail.hs                  | 75 --------------------------------------------
 src/Main.hs                  | 67 +++++++--------------------------------
 src/Model/Birthdate.hs       | 38 ++++++++++++++++++++++
 src/Model/BirthdateParser.hs | 57 +++++++++++++++++++++++++++++++++
 src/Model/Config.hs          | 32 +++++++++++++++++++
 src/Model/Date.hs            | 74 +++++++++++++++++++++++++++++++++++++++++++
 src/Model/Mail.hs            | 60 +++++++++++++++++++++++++++++++++++
 src/Model/Path.hs            | 10 ++++++
 src/Notification.hs          | 49 +++++++++++++++++++++++++++++
 src/RenderError.hs           | 34 ++++++++++++++++++++
 src/Time.hs                  | 12 +++++++
 16 files changed, 381 insertions(+), 310 deletions(-)
 delete mode 100644 src/Birthdate.hs
 delete mode 100644 src/BirthdateParser.hs
 delete mode 100644 src/Config.hs
 delete mode 100644 src/Date.hs
 delete mode 100644 src/Mail.hs
 create mode 100644 src/Model/Birthdate.hs
 create mode 100644 src/Model/BirthdateParser.hs
 create mode 100644 src/Model/Config.hs
 create mode 100644 src/Model/Date.hs
 create mode 100644 src/Model/Mail.hs
 create mode 100644 src/Model/Path.hs
 create mode 100644 src/Notification.hs
 create mode 100644 src/RenderError.hs
 create mode 100644 src/Time.hs

(limited to 'src')

diff --git a/src/Birthdate.hs b/src/Birthdate.hs
deleted file mode 100644
index 48d3a4e..0000000
--- a/src/Birthdate.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Birthdate
-  ( Birthdate(..)
-  , fullname
-  , age
-  , filterBirthdayAt
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Date
-
-data Birthdate = Birthdate
-  { date :: Date
-  , firstname :: Text
-  , lastname :: Text
-  } deriving (Eq, Show)
-
-fullname :: Birthdate -> Text
-fullname d = T.concat [firstname d, " ", lastname d]
-
-age :: Date -> Birthdate -> Int
-age currentDate birthdate = yearsGap currentDate (date birthdate)
-
-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/BirthdateParser.hs b/src/BirthdateParser.hs
deleted file mode 100644
index 9fa7c50..0000000
--- a/src/BirthdateParser.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-module BirthdateParser
-  ( parseBirthdates
-  ) where
-
-import Control.Arrow (left)
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Text.ParserCombinators.Parsec
-
-import Birthdate
-import Date
-
-parseBirthdates :: Text -> Either Text [Birthdate]
-parseBirthdates input =
-  left
-    (T.pack . show)
-    (parse birthdatesParser "" (T.unpack input))
-
-birthdatesParser :: Parser [Birthdate]
-birthdatesParser = many (many newline >> birthdateParser <* many newline)
-
-birthdateParser :: Parser Birthdate
-birthdateParser =
-  Birthdate <$>
-    dateParser <* spaces <* char ',' <*>
-    valueParser <* char ',' <*>
-    valueParser
-
-valueParser :: Parser Text
-valueParser = T.strip . T.pack <$> many (noneOf ",\n")
-
-dateParser :: Parser Date
-dateParser =
-  Date <$>
-    integerParser <* spaces <*>
-    monthParser <* spaces <*>
-    integerParser
-
-integerParser :: Parser Int
-integerParser = (read :: String -> Int) <$> many1 digit
-
-monthParser :: Parser Int
-monthParser =
-      (try $ string "Jan" >> return 1)
-  <|> (try $ string "Feb" >> return 2)
-  <|> (try $ string "Mar" >> return 3)
-  <|> (try $ string "Apr" >> return 4)
-  <|> (try $ string "May" >> return 5)
-  <|> (try $ string "Jun" >> return 6)
-  <|> (try $ string "Jul" >> return 7)
-  <|> (try $ string "Aug" >> return 8)
-  <|> (try $ string "Sep" >> return 9)
-  <|> (try $ string "Oct" >> return 10)
-  <|> (try $ string "Nov" >> return 11)
-  <|> (try $ string "Dec" >> return 12)
diff --git a/src/Config.hs b/src/Config.hs
deleted file mode 100644
index c01bbe1..0000000
--- a/src/Config.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-module Config
-  ( getConfig
-  , Config(..)
-  ) where
-
-import Data.ConfigFile
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Control.Monad.Trans.Error (runErrorT)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad (join)
-import Control.Arrow (left)
-import Control.Applicative (liftA2)
-
-data Config = Config
-  { mailTo :: Text
-  , mailFrom :: Text
-  } deriving (Read, Eq, Show)
-
-getConfig :: FilePath -> IO (Either Text Config)
-getConfig filePath =
-  left (T.pack . show) <$> (runErrorT $ do
-    cp <- join $ liftIO $ readfile emptyCP filePath
-    liftA2
-      Config
-      (T.pack <$> get cp "DEFAULT" "mail-to")
-      (T.pack <$> get cp "DEFAULT" "mail-from")
-  )
diff --git a/src/Date.hs b/src/Date.hs
deleted file mode 100644
index 63830d3..0000000
--- a/src/Date.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-module Date
-  ( Date(..)
-  , getCurrentDate
-  , sameDayAndMonth
-  , isBeforeOrEqualDayAndMonth
-  , isAfterOrEqualDayAndMonth
-  , yearsGap
-  ) where
-
-import Data.Time.Clock
-import Data.Time.Calendar
-import Data.Time.LocalTime
-
-data Date = Date
-  { day :: Int
-  , month :: Int
-  , year :: Int
-  } deriving (Eq, Show)
-
-getCurrentDate :: IO Date
-getCurrentDate = do
-  now <- getCurrentTime
-  timezone <- getCurrentTimeZone
-  let zoneNow = utcToLocalTime timezone now
-  let (y, m, d) = toGregorian $ localDay zoneNow
-  return $ Date d m (fromIntegral y)
-
-sameDayAndMonth :: Date -> Date -> Bool
-sameDayAndMonth d1 d2 =
-  (  day d1 == day 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/Logger.hs b/src/Logger.hs
index 4be55be..6faa482 100644
--- a/src/Logger.hs
+++ b/src/Logger.hs
@@ -7,12 +7,12 @@ module Logger
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T (appendFile)
-import Data.Time.LocalTime (getZonedTime)
-import Data.Time.Format (formatTime, defaultTimeLocale)
+
+import Time (formatCurrentLocale)
 
 info :: Text -> IO ()
 info message = do
-  time <- T.pack <$> formatTime defaultTimeLocale "[%d/%m/%Y, %H:%M]" <$> getZonedTime
+  time <- formatCurrentLocale "[%d/%m/%Y, %H:%M]"
   T.appendFile "logs" $
     T.concat
       [ time
diff --git a/src/Mail.hs b/src/Mail.hs
deleted file mode 100644
index dc533ef..0000000
--- a/src/Mail.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Mail
-  ( mailSubject
-  , mailBody
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Date
-import Birthdate
-
-mailSubject :: [Birthdate] -> Text
-mailSubject birthdates =
-  let count = length birthdates
-  in  T.concat
-        [ "Hey, "
-        , if count > 1 then "there are" else "there is"
-        , " "
-        , T.pack . show $ count
-        , " birthday"
-        , if count > 1 then "s" else ""
-        , " today!"
-        ]
-
-mailBody :: Date -> [Birthdate] -> Text
-mailBody currentDate birthdates =
-  let count = length birthdates
-      birthdatesWithLines = map (mapFst lineKind) . zip [1..] $ birthdates
-      lineKind 1 = if count == 1 then SingleLine else FirstLine
-      lineKind line = if line == count then LastLine else MiddleLine
-  in  T.concat $ map (mailLine currentDate) birthdatesWithLines
-
-mapFst :: (a -> c) -> (a, b) -> (c, b)
-mapFst f (x, y) = (f x, y)
-
-data Line =
-  SingleLine
-  | FirstLine
-  | MiddleLine
-  | LastLine
-  deriving (Eq, Show)
-
-mailLine :: Date -> (Line, Birthdate) -> Text
-mailLine currDate (SingleLine, birthdate) =
-  T.concat
-    [ fullname birthdate
-    , " is now "
-    , T.pack . show $ age currDate birthdate
-    , " years old."
-    ]
-mailLine currDate (FirstLine, birthdate) =
-  T.concat
-    [ fullname birthdate
-    , " is now "
-    , T.pack . show $ age currDate birthdate
-    , " years old"
-    ]
-mailLine currDate (MiddleLine, birthdate) =
-  T.concat
-    [ ", "
-    , fullname birthdate
-    , " is "
-    , T.pack . show $ age currDate birthdate
-    , " years old"
-    ]
-mailLine currDate (LastLine, birthdate) =
-  T.concat
-    [ " and "
-    , fullname birthdate
-    , " is "
-    , T.pack . show $ age currDate birthdate
-    , " years old."
-    ]
diff --git a/src/Main.hs b/src/Main.hs
index 0aa2910..e3bd0ce 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,67 +4,24 @@ module Main
   ( main
   ) where
 
-import System.IO (stderr)
-
-import Data.Text (Text)
-import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
-import Date (getCurrentDate)
-import Birthdate (Birthdate, filterBirthdayAt)
-import BirthdateParser (parseBirthdates)
-import Mail (mailSubject, mailBody)
-import SendMail (sendMail)
-import Config
-
-birthdatePath :: FilePath
-birthdatePath = "birthdates.csv"
+import qualified RenderError
+import qualified Notification
 
-configPath :: FilePath
-configPath = "config.txt"
+import Model.Config
+import Model.BirthdateParser (parseBirthdates)
+import qualified Model.Path as Path
 
 main :: IO ()
 main = do
-  eitherBirthdates <- parseBirthdates <$> T.readFile birthdatePath
-  eitherConfig <- getConfig configPath
+  eitherBirthdates <- parseBirthdates <$> T.readFile Path.birthdate
+  eitherConfig <- getConfig Path.config
   case (eitherBirthdates, eitherConfig) of
     (Left err, _) ->
-      birthdateError err
+      RenderError.birthdate err
     (_, Left err) ->
-      configError err
-    (Right birthdates, Right config) ->
-      sendNotificationForBirthdayToday birthdates config
-
-birthdateError :: Text -> IO ()
-birthdateError err =
-  T.hPutStr stderr $
-    T.concat
-      [ "Error while parsing file "
-      , T.pack birthdatePath
-      , ":\n"
-      , err
-      ]
-
-configError :: Text -> IO ()
-configError err =
-  T.hPutStr stderr $
-    T.concat
-      [ "Error while parsing config file "
-      , T.pack configPath
-      , ":\n"
-      , err
-      ]
-
-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 ()
+      RenderError.config err
+    (Right birthdates, Right config) -> do
+      Notification.today birthdates config
+      Notification.nextWeek birthdates config
diff --git a/src/Model/Birthdate.hs b/src/Model/Birthdate.hs
new file mode 100644
index 0000000..d135419
--- /dev/null
+++ b/src/Model/Birthdate.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.Birthdate
+  ( Birthdate(..)
+  , fullname
+  , age
+  , filterBirthdayAt
+  , filterBirthdayBetween
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Model.Date
+
+data Birthdate = Birthdate
+  { date :: Date
+  , firstname :: Text
+  , lastname :: Text
+  } deriving (Eq, Show)
+
+fullname :: Birthdate -> Text
+fullname d = T.concat [firstname d, " ", lastname d]
+
+age :: Date -> Birthdate -> Int
+age currentDate birthdate = yearsGap currentDate (date birthdate)
+
+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/Model/BirthdateParser.hs b/src/Model/BirthdateParser.hs
new file mode 100644
index 0000000..c9ac3b9
--- /dev/null
+++ b/src/Model/BirthdateParser.hs
@@ -0,0 +1,57 @@
+module Model.BirthdateParser
+  ( parseBirthdates
+  ) where
+
+import Control.Arrow (left)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Text.ParserCombinators.Parsec
+
+import Model.Birthdate
+import Model.Date
+
+parseBirthdates :: Text -> Either Text [Birthdate]
+parseBirthdates input =
+  left
+    (T.pack . show)
+    (parse birthdatesParser "" (T.unpack input))
+
+birthdatesParser :: Parser [Birthdate]
+birthdatesParser = many (many newline >> birthdateParser <* many newline)
+
+birthdateParser :: Parser Birthdate
+birthdateParser =
+  Birthdate <$>
+    dateParser <* spaces <* char ',' <*>
+    valueParser <* char ',' <*>
+    valueParser
+
+valueParser :: Parser Text
+valueParser = T.strip . T.pack <$> many (noneOf ",\n")
+
+dateParser :: Parser Date
+dateParser =
+  Date <$>
+    integerParser <* spaces <*>
+    monthParser <* spaces <*>
+    integerParser
+
+integerParser :: Parser Int
+integerParser = (read :: String -> Int) <$> many1 digit
+
+monthParser :: Parser Int
+monthParser =
+      (try $ string "Jan" >> return 1)
+  <|> (try $ string "Feb" >> return 2)
+  <|> (try $ string "Mar" >> return 3)
+  <|> (try $ string "Apr" >> return 4)
+  <|> (try $ string "May" >> return 5)
+  <|> (try $ string "Jun" >> return 6)
+  <|> (try $ string "Jul" >> return 7)
+  <|> (try $ string "Aug" >> return 8)
+  <|> (try $ string "Sep" >> return 9)
+  <|> (try $ string "Oct" >> return 10)
+  <|> (try $ string "Nov" >> return 11)
+  <|> (try $ string "Dec" >> return 12)
diff --git a/src/Model/Config.hs b/src/Model/Config.hs
new file mode 100644
index 0000000..b583048
--- /dev/null
+++ b/src/Model/Config.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Model.Config
+  ( getConfig
+  , Config(..)
+  ) where
+
+import Data.ConfigFile
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Control.Monad.Trans.Error (runErrorT)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (join)
+import Control.Arrow (left)
+
+data Config = Config
+  { mailTo :: Text
+  , mailFrom :: Text
+  , dayForNextWeekNotification :: Text
+  } deriving (Read, Eq, Show)
+
+getConfig :: FilePath -> IO (Either Text Config)
+getConfig filePath =
+  left (T.pack . show) <$> (runErrorT $ do
+    cp <- join $ liftIO $ readfile emptyCP filePath
+    Config <$>
+      (T.pack <$> get cp "DEFAULT" "mail-to") <*>
+      (T.pack <$> get cp "DEFAULT" "mail-from") <*>
+      (T.pack <$> get cp "DEFAULT" "day-for-next-week-notification")
+  )
diff --git a/src/Model/Date.hs b/src/Model/Date.hs
new file mode 100644
index 0000000..96c15e9
--- /dev/null
+++ b/src/Model/Date.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.Date
+  ( Date(..)
+  , getCurrentDate
+  , getNextWeek
+  , plusDays
+  , sameDayAndMonth
+  , isBeforeOrEqualDayAndMonth
+  , isAfterOrEqualDayAndMonth
+  , yearsGap
+  ) where
+
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.Time.LocalTime
+import qualified Data.Text as T
+
+import Time (formatCurrentLocale)
+
+data Date = Date
+  { day :: Int
+  , month :: Int
+  , year :: Int
+  } deriving (Eq, Show)
+
+getCurrentDate :: IO Date
+getCurrentDate = do
+  now <- getCurrentTime
+  timezone <- getCurrentTimeZone
+  let zoneNow = utcToLocalTime timezone now
+  return . dateFromDay $ localDay zoneNow
+
+getNextWeek :: IO (Date, Date)
+getNextWeek = do
+  currentDate <- getCurrentDate
+  currentDayNumberOfWeek <- (read . T.unpack <$> formatCurrentLocale "%u") :: IO Int
+  let begin = currentDate `plusDays` (8 - currentDayNumberOfWeek)
+  let end = begin `plusDays` 6
+  return (begin, end)
+
+plusDays :: Date -> Int -> Date
+plusDays (Date d m y) n =
+  dateFromDay . addDays (toInteger n) $ fromGregorian (toInteger y) m d
+
+dateFromDay :: Day -> Date
+dateFromDay dayTime =
+  let (y, m, d) = toGregorian dayTime
+  in  Date d m (fromIntegral y)
+
+sameDayAndMonth :: Date -> Date -> Bool
+sameDayAndMonth d1 d2 =
+  (  day d1 == day 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/Model/Mail.hs b/src/Model/Mail.hs
new file mode 100644
index 0000000..e730e32
--- /dev/null
+++ b/src/Model/Mail.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.Mail
+  ( mailSubject
+  , mailBody
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Model.Date
+import Model.Birthdate
+
+mailSubject :: [Birthdate] -> Text
+mailSubject birthdates =
+  let count = length birthdates
+  in  T.concat
+        [ "Hey, "
+        , if count > 1 then "there are" else "there is"
+        , " "
+        , T.pack . show $ count
+        , " birthday"
+        , if count > 1 then "s" else ""
+        , " today!"
+        ]
+
+mailBody :: Date -> [Birthdate] -> Text
+mailBody currentDate birthdates =
+  T.concat $ map (mailLine 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)
+
+mailLine :: Date -> (Line, Birthdate) -> Text
+mailLine currDate (line, birthdate) =
+  T.concat
+    [ case line of
+        MiddleLine -> ", "
+        LastLine -> " and "
+        _ -> ""
+    , fullname birthdate
+    , case line of
+        x | x `elem` [SingleLine, FirstLine] -> " is now "
+        _ -> " is "
+    , T.pack . show $ age currDate birthdate
+    , " years old"
+    , if line == LastLine then "." else ""
+    ]
diff --git a/src/Model/Path.hs b/src/Model/Path.hs
new file mode 100644
index 0000000..d34716c
--- /dev/null
+++ b/src/Model/Path.hs
@@ -0,0 +1,10 @@
+module Model.Path
+  ( birthdate
+  , config
+  ) where
+
+birthdate :: FilePath
+birthdate = "birthdates.csv"
+
+config :: FilePath
+config = "config.txt"
diff --git a/src/Notification.hs b/src/Notification.hs
new file mode 100644
index 0000000..de4a591
--- /dev/null
+++ b/src/Notification.hs
@@ -0,0 +1,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 ()
diff --git a/src/RenderError.hs b/src/RenderError.hs
new file mode 100644
index 0000000..9b9732f
--- /dev/null
+++ b/src/RenderError.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module RenderError
+  ( birthdate
+  , config
+  ) where
+
+import System.IO (stderr)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import qualified Model.Path as Path
+
+birthdate :: Text -> IO ()
+birthdate err =
+  T.hPutStr stderr $
+    T.concat
+      [ "Error while parsing file "
+      , T.pack Path.birthdate
+      , ":\n"
+      , err
+      ]
+
+config :: Text -> IO ()
+config err =
+  T.hPutStr stderr $
+    T.concat
+      [ "Error while parsing config file "
+      , T.pack Path.config
+      , ":\n"
+      , err
+      ]
diff --git a/src/Time.hs b/src/Time.hs
new file mode 100644
index 0000000..97a9317
--- /dev/null
+++ b/src/Time.hs
@@ -0,0 +1,12 @@
+module Time
+  ( formatCurrentLocale
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.LocalTime (getZonedTime)
+import Data.Time.Format (formatTime, defaultTimeLocale)
+
+formatCurrentLocale :: Text -> IO Text
+formatCurrentLocale format =
+  T.pack <$> formatTime defaultTimeLocale (T.unpack format) <$> getZonedTime
-- 
cgit v1.2.3