aboutsummaryrefslogtreecommitdiff
path: root/src/Model/BirthdateParser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Model/BirthdateParser.hs')
-rw-r--r--src/Model/BirthdateParser.hs57
1 files changed, 57 insertions, 0 deletions
diff --git a/src/Model/BirthdateParser.hs b/src/Model/BirthdateParser.hs
new file mode 100644
index 0000000..c9ac3b9
--- /dev/null
+++ b/src/Model/BirthdateParser.hs
@@ -0,0 +1,57 @@
+module Model.BirthdateParser
+ ( parseBirthdates
+ ) where
+
+import Control.Arrow (left)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Text.ParserCombinators.Parsec
+
+import Model.Birthdate
+import Model.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 "Jan" >> return 1)
+ <|> (try $ string "Feb" >> return 2)
+ <|> (try $ string "Mar" >> return 3)
+ <|> (try $ string "Apr" >> return 4)
+ <|> (try $ string "May" >> return 5)
+ <|> (try $ string "Jun" >> return 6)
+ <|> (try $ string "Jul" >> return 7)
+ <|> (try $ string "Aug" >> return 8)
+ <|> (try $ string "Sep" >> return 9)
+ <|> (try $ string "Oct" >> return 10)
+ <|> (try $ string "Nov" >> return 11)
+ <|> (try $ string "Dec" >> return 12)