{-# LANGUAGE OverloadedStrings #-}

module Model.EventParser
  ( parseEvents
  ) 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.Event (Event, Event(Event))
import qualified Model.Event as Event
import Model.Date (Date(Date))
import qualified Model.Date as Date

parseEvents :: Text -> Either Text [Event]
parseEvents input =
  left (T.pack . show) (parse eventsParser "" (T.unpack input)) >>= validateEvents

validateEvents :: [Event] -> Either Text [Event]
validateEvents events =
  let invalid = filter (not . Date.isValid . Event.date) events
  in  if null invalid
        then
          Right events
        else
          Left $
             T.concat
               [ "Invalid events: "
               , T.intercalate ", " (map Event.renderEvent invalid)
               ]

eventsParser :: Parser [Event]
eventsParser = concat <$> many monthSection

monthSection :: Parser [Event]
monthSection = do
  month <- monthSectionTitle
  spaces
  events <- catMaybes <$> many lineParser
  return $
    map (\(day, year, name) ->
      Event (Date day month year) name
    ) events

lineParser :: Parser (Maybe (Int, Int, Text))
lineParser =
  (Just <$> eventParser <* endOfLine)
  <|> (comment >> return Nothing)
  <|> (emptyLine >> return Nothing)

monthSectionTitle :: Parser Int
monthSectionTitle = char '[' *> monthParser <* char ']'

monthParser :: Parser Int
monthParser =
      (try $ string "January" >> return 1)
  <|> (try $ string "February" >> return 2)
  <|> (try $ string "March" >> return 3)
  <|> (try $ string "April" >> return 4)
  <|> (try $ string "May" >> return 5)
  <|> (try $ string "June" >> return 6)
  <|> (try $ string "July" >> return 7)
  <|> (try $ string "August" >> return 8)
  <|> (try $ string "September" >> return 9)
  <|> (try $ string "October" >> return 10)
  <|> (try $ string "November" >> return 11)
  <|> (try $ string "December" >> return 12)

eventParser :: Parser (Int, Int, Text)
eventParser =
  (,,) <$>
    integerParser <* separator ',' <*>
    integerParser <* separator ':' <*>
    (T.strip . T.pack <$> many (noneOf "\n"))

separator :: Char -> Parser ()
separator c = many (char ' ') >> char c >> many (char ' ') >> return ()

integerParser :: Parser Int
integerParser = (read :: String -> Int) <$> many1 digit

emptyLine :: Parser ()
emptyLine = skipMany (char ' ') >> endOfLine >> return ()

comment :: Parser ()
comment = char '#' >> many (noneOf "\n") >> endOfLine >> return ()