More readable birthdates in csv file

5 files changed, 78 insertions, 68 deletions

diff --git a/src/Birthdate.hs b/src/Birthdate.hs
index 2ef1bcb..4c6e398 100644
--- a/src/Birthdate.hs
+++ b/src/Birthdate.hs
@@ -4,17 +4,13 @@ module Birthdate
   ( Birthdate(..)
   , fullname
   , age
-  , readBirthdates
   , filterBirthday
   ) where
 
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import qualified Data.Text.Read as T
-import Data.Either (partitionEithers)
 
-import Date (Date(Date), sameDayAndMonth, yearsGap)
+import Date (Date, sameDayAndMonth, yearsGap)
 
 data Birthdate = Birthdate
   { date :: Date
@@ -28,49 +24,5 @@ fullname d = T.concat [firstname d, " ", lastname d]
 age :: Date -> Birthdate -> Int
 age currentDate birthdate = yearsGap currentDate (date birthdate)
 
-readBirthdates :: FilePath -> IO (Either Text [Birthdate])
-readBirthdates path = do
-  eitherBirthdates <- map parseBirthdate . zip [1..] . T.lines <$> T.readFile path
-  return $
-    case partitionEithers eitherBirthdates of
-      ([], birthdates) ->
-        Right birthdates
-      (errors, _) ->
-        Left $ T.intercalate "\n" errors
-
-parseBirthdate :: (Int, Text) -> Either Text Birthdate
-parseBirthdate (line, text) =
-  case map T.strip $ T.splitOn "," text of
-    [date, lastname, firstname] ->
-      case map T.decimal $ T.splitOn "/" date of
-        [Right (day, ""), Right (month, ""), Right (year, "")] ->
-          Right Birthdate
-            { date = Date year month day
-            , lastname = lastname
-            , firstname = firstname
-            }
-        _ ->
-          Left $ T.concat
-            [ lineOutput line
-            , " birthdate: "
-            , date
-            , ". (Required: year/month/day)"
-            ]
-    _ ->
-      Left $ T.concat
-        [ lineOutput line
-        , " line: "
-        , text
-        , ". (Required: date, lastname, firstname)"
-        ]
-
-lineOutput :: Int -> Text
-lineOutput line =
-  T.concat
-    [ "[L"
-    , T.pack . show $ line
-    , "]"
-    ]
-
 filterBirthday :: Date -> [Birthdate] -> [Birthdate]
 filterBirthday d = filter (sameDayAndMonth d . date)
diff --git a/src/BirthdateParser.hs b/src/BirthdateParser.hs
new file mode 100644
index 0000000..1e4051b
--- /dev/null
+++ b/src/BirthdateParser.hs
@@ -0,0 +1,57 @@
+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 "Janvier" >> return 1)
+  <|> (try $ string "Février" >> return 2)
+  <|> (try $ string "Mars" >> return 3)
+  <|> (try $ string "Avril" >> return 4)
+  <|> (try $ string "Mai" >> return 5)
+  <|> (try $ string "Juin" >> return 6)
+  <|> (try $ string "Juillet" >> return 7)
+  <|> (try $ string "Août" >> return 8)
+  <|> (try $ string "Septembre" >> return 9)
+  <|> (try $ string "Octobre" >> return 10)
+  <|> (try $ string "Novembre" >> return 11)
+  <|> (try $ string "Décembre" >> return 12)
diff --git a/src/Date.hs b/src/Date.hs
index efbef8c..07f0672 100644
--- a/src/Date.hs
+++ b/src/Date.hs
@@ -20,8 +20,8 @@ getCurrentDate = do
   now <- getCurrentTime
   timezone <- getCurrentTimeZone
   let zoneNow = utcToLocalTime timezone now
-  let (year, month, day) = toGregorian $ localDay zoneNow
-  return $ Date (fromIntegral year) month day
+  let (y, m, d) = toGregorian $ localDay zoneNow
+  return $ Date (fromIntegral y) m d
 
 sameDayAndMonth :: Date -> Date -> Bool
 sameDayAndMonth (Date _ m1 d1) (Date _ m2 d2) = m1 == m2 && d1 == d2
diff --git a/src/Mail.hs b/src/Mail.hs
index 7bb6814..dc533ef 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -27,9 +27,9 @@ mailSubject birthdates =
 mailBody :: Date -> [Birthdate] -> Text
 mailBody currentDate birthdates =
   let count = length birthdates
-      birthdatesWithLines = map (mapFst getLine) . zip [1..] $ birthdates
-      getLine 1 = if count == 1 then SingleLine else FirstLine
-      getLine line = if line == count then LastLine else MiddleLine
+      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)
@@ -43,33 +43,33 @@ data Line =
   deriving (Eq, Show)
 
 mailLine :: Date -> (Line, Birthdate) -> Text
-mailLine date (SingleLine, birthdate) =
+mailLine currDate (SingleLine, birthdate) =
   T.concat
     [ fullname birthdate
     , " is now "
-    , T.pack . show $ age date birthdate
+    , T.pack . show $ age currDate birthdate
     , " years old."
     ]
-mailLine date (FirstLine, birthdate) =
+mailLine currDate (FirstLine, birthdate) =
   T.concat
     [ fullname birthdate
     , " is now "
-    , T.pack . show $ age date birthdate
+    , T.pack . show $ age currDate birthdate
     , " years old"
     ]
-mailLine date (MiddleLine, birthdate) =
+mailLine currDate (MiddleLine, birthdate) =
   T.concat
     [ ", "
     , fullname birthdate
     , " is "
-    , T.pack . show $ age date birthdate
+    , T.pack . show $ age currDate birthdate
     , " years old"
     ]
-mailLine date (LastLine, birthdate) =
+mailLine currDate (LastLine, birthdate) =
   T.concat
     [ " and "
     , fullname birthdate
     , " is "
-    , T.pack . show $ age date birthdate
+    , T.pack . show $ age currDate birthdate
     , " years old."
     ]
diff --git a/src/Main.hs b/src/Main.hs
index 9debfe1..9b5541c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,7 +10,8 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
 import Date (getCurrentDate)
-import Birthdate (readBirthdates, filterBirthday)
+import Birthdate (filterBirthday)
+import BirthdateParser (parseBirthdates)
 import Mail (mailSubject, mailBody)
 import SendMail (sendMail)
 import Config
@@ -23,24 +24,24 @@ configPath = "config.txt"
 
 main :: IO ()
 main = do
-  eitherBirthdates <- readBirthdates birthdatePath
+  eitherBirthdates <- parseBirthdates <$> T.readFile birthdatePath
   eitherConfig <- getConfig configPath
   case (eitherBirthdates, eitherConfig) of
-    (Left error, _) ->
+    (Left err, _) ->
       T.hPutStr stderr $
         T.concat
           [ "Error while parsing file "
           , T.pack birthdatePath
           , ":\n"
-          , error
+          , err
           ]
-    (_, Left error) ->
+    (_, Left err) ->
       T.hPutStr stderr $
         T.concat
           [ "Error while parsing config file "
           , T.pack birthdatePath
           , ":\n"
-          , error
+          , err
           ]
     (Right birthdates, Right config) -> do
       currentDate <- getCurrentDate