From 5375ad26dd78220185f1ffe05222250c06dc1a0c Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 21 Nov 2015 21:41:38 +0100 Subject: Get next week birthdays and send an empty mail for the moment --- src/Model/BirthdateParser.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 src/Model/BirthdateParser.hs (limited to 'src/Model/BirthdateParser.hs') 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) -- cgit v1.2.3