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/Date.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

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

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