From 7825b27d262af7252b48e9179a5bbf86b0f30d22 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Oct 2015 11:22:03 +0200
Subject: More readable birthdates in csv file

---
 src/BirthdateParser.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 src/BirthdateParser.hs

(limited to 'src/BirthdateParser.hs')

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