diff options
author | Joris | 2016-04-04 22:48:33 +0200 |
---|---|---|
committer | Joris | 2016-04-04 22:48:33 +0200 |
commit | d8eedc3e2639f0f50f0554f89dc121da4941d4d1 (patch) | |
tree | 81bd4d0a261b0550a0501ad2f70fa52b4ee21000 /src/Model/BirthdateParser.hs | |
parent | e66ea0b49c8f7202114df366668598026f211eba (diff) |
Rename birthday to event
Diffstat (limited to 'src/Model/BirthdateParser.hs')
-rw-r--r-- | src/Model/BirthdateParser.hs | 84 |
1 files changed, 0 insertions, 84 deletions
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) |