Validate birthdates and show an error message if there are invalid ones

5 files changed, 51 insertions, 5 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 2cd4c28..a9d5731 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,7 +7,7 @@ module Main
 import qualified Data.Text.IO as T
 
 import qualified RenderError
-import qualified Notification
+import Notification (notifyTodayAndNextWeek)
 
 import Model.Config
 import Model.BirthdateParser (parseBirthdates)
diff --git a/src/Model/Birthdate.hs b/src/Model/Birthdate.hs
index 32bd6a4..f871860 100644
--- a/src/Model/Birthdate.hs
+++ b/src/Model/Birthdate.hs
@@ -2,8 +2,10 @@
 
 module Model.Birthdate
   ( Birthdate(..)
+  , renderBirthdate
   , fullname
   , age
+  , ageNextWeek
   , filterBirthdayAt
   , filterBirthdayBetween
   ) where
@@ -19,6 +21,15 @@ data Birthdate = Birthdate
   , lastname :: Text
   } deriving (Eq, Show)
 
+renderBirthdate :: Birthdate -> Text
+renderBirthdate birthdate =
+  T.concat
+    [ fullname birthdate
+    , " ("
+    , renderDate (date birthdate)
+    , ")"
+    ]
+
 fullname :: Birthdate -> Text
 fullname d = T.concat [firstname d, " ", lastname d]
 
diff --git a/src/Model/BirthdateParser.hs b/src/Model/BirthdateParser.hs
index c9ac3b9..8e8489b 100644
--- a/src/Model/BirthdateParser.hs
+++ b/src/Model/BirthdateParser.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.BirthdateParser
   ( parseBirthdates
   ) where
@@ -14,9 +16,20 @@ import Model.Date
 
 parseBirthdates :: Text -> Either Text [Birthdate]
 parseBirthdates input =
-  left
-    (T.pack . show)
-    (parse birthdatesParser "" (T.unpack input))
+  left (T.pack . show) (parse birthdatesParser "" (T.unpack input)) >>= validateBirthdates
+
+validateBirthdates :: [Birthdate] -> Either Text [Birthdate]
+validateBirthdates birthdates =
+  let invalid = filter (not . isValid . date) birthdates
+  in  if null invalid
+        then
+          Right birthdates
+        else
+          Left $
+             T.concat
+               [ "Invalid birthdates: "
+               , T.intercalate ", " (map renderBirthdate invalid)
+               ]
 
 birthdatesParser :: Parser [Birthdate]
 birthdatesParser = many (many newline >> birthdateParser <* many newline)
diff --git a/src/Model/Date.hs b/src/Model/Date.hs
index e095cc6..60108e9 100644
--- a/src/Model/Date.hs
+++ b/src/Model/Date.hs
@@ -2,6 +2,7 @@
 
 module Model.Date
   ( Date(..)
+  , renderDate
   , getCurrentDate
   , getNextWeek
   , plusDays
@@ -9,12 +10,17 @@ module Model.Date
   , isBeforeOrEqualDayAndMonth
   , yearsGap
   , daysGap
+  , isValid
   ) where
 
+import Text.Printf (printf)
+
 import Data.Time.Clock
 import Data.Time.Calendar
 import Data.Time.LocalTime
+import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Maybe (isJust)
 
 import Time (formatCurrentLocale)
 
@@ -24,6 +30,16 @@ data Date = Date
   , year :: Int
   } deriving (Eq, Show)
 
+renderDate :: Date -> Text
+renderDate (Date d m y) =
+  T.concat
+    [ T.pack $ printf "%02d" d
+    , "/"
+    , T.pack $ printf "%02d" m
+    , "/"
+    , T.pack . show $ y
+    ]
+
 getCurrentDate :: IO Date
 getCurrentDate = do
   now <- getCurrentTime
@@ -69,3 +85,6 @@ yearsGap d1 d2 = abs (year d2 - year d1)
 
 daysGap :: Date -> Date -> Int
 daysGap d1 d2 = abs . fromIntegral $ (dateToDay d1) `diffDays` (dateToDay d2)
+
+isValid :: Date -> Bool
+isValid (Date d m y) = isJust $ fromGregorianValid (toInteger y) m d
diff --git a/src/Model/Mail.hs b/src/Model/Mail.hs
index 19ebaeb..2ae8df4 100644
--- a/src/Model/Mail.hs
+++ b/src/Model/Mail.hs
@@ -97,7 +97,10 @@ mailBodyPart event currDate (line, birthdate) =
           ""
     , fullname birthdate
     , if event == Today then " is " else " will be "
-    , T.pack . show $ age currDate birthdate
+    , T.pack . show $
+        if event == Today
+          then age currDate birthdate
+          else ageNextWeek currDate birthdate
     , " years old"
     , if line == SingleLine || line == LastLine then "." else ""
     ]