From d8eedc3e2639f0f50f0554f89dc121da4941d4d1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 4 Apr 2016 22:48:33 +0200 Subject: Rename birthday to event --- src/Model/BirthdateParser.hs | 84 -------------------------------------------- 1 file changed, 84 deletions(-) delete mode 100644 src/Model/BirthdateParser.hs (limited to 'src/Model/BirthdateParser.hs') diff --git a/src/Model/BirthdateParser.hs b/src/Model/BirthdateParser.hs deleted file mode 100644 index 9bed07a..0000000 --- a/src/Model/BirthdateParser.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Model.BirthdateParser - ( parseBirthdates - ) where - -import Control.Arrow (left) - -import Data.Text (Text) -import qualified Data.Text as T -import Data.Maybe (catMaybes) - -import Text.ParserCombinators.Parsec -import Text.Parsec.Char (endOfLine) - -import Model.Birthdate -import Model.Date - -parseBirthdates :: Text -> Either Text [Birthdate] -parseBirthdates 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 = catMaybes <$> many lineParser - -lineParser :: Parser (Maybe Birthdate) -lineParser = - (Just <$> birthdateParser <* endOfLine) - <|> (emptyLine >> return Nothing) - <|> (commentLine >> return Nothing) - -emptyLine :: Parser () -emptyLine = skipMany (char ' ') >> endOfLine >> return () - -commentLine :: Parser Text -commentLine = T.strip . T.pack <$> (spaces *> char '#' *> many (noneOf "\n") <* endOfLine) - -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