diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 2 | ||||
-rw-r--r-- | src/Model/Birthdate.hs | 11 | ||||
-rw-r--r-- | src/Model/BirthdateParser.hs | 19 | ||||
-rw-r--r-- | src/Model/Date.hs | 19 | ||||
-rw-r--r-- | src/Model/Mail.hs | 5 |
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 "" ] |