{-# 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)