From 09d822d47218141bf655d40a6f6f0395cfae69f0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 22 Nov 2015 12:15:41 +0100
Subject: Validate birthdates and show an error message if there are invalid
 ones

---
 src/Model/BirthdateParser.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

(limited to 'src/Model/BirthdateParser.hs')

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)
-- 
cgit v1.2.3