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.hs84
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)