{-# LANGUAGE TypeFamilies #-}
module Parsers (parseFromCmdLine, parseFromFile) where

import TypesAndConstants
import BasicParsers as B

import System.IO
import Control.Applicative as A
import Data.Void (Void)
import qualified Data.Char as C
import Data.Either (rights, isLeft)
import Text.Megaparsec as M (parse, runParser, try, eof, MonadParsec, Token)
import Text.Megaparsec.Char as MC (newline, eol)
import Text.Megaparsec.Error (ParseError, parseErrorPretty, parseErrorPretty')



space = B.sc


{-|
  parseFromCmdLine str stackIsNull:

  Si stackIsNull es True significa que no hay comandos para completar,
  por lo tanto se puede parsear tanto un comando gráfico como uno de control.
  En cambio, si es False, necesariamente se deben seguir parseando comandos
  gráficos hasta que se completen los comandos anteriores
-}
parseFromCmdLine :: String -> Bool -> Either (ParseError Char Void) GeneralCommand
parseFromCmdLine input stackIsNull =
  if stackIsNull
  then parse (space *> generalCmd <* eof) "" input
  else (\lor -> case lor of
                  Left err -> Left err
                  Right ast -> Right (GraphicCmd ast)) (parse (space *> parseCompCommand <* eof) "" input)


parseFromFile :: String -> IO (Either (ParseError Char Void) [CompCom])
parseFromFile filePath = 
  do content <- readFile filePath
     case content of
       [] -> return $ Right []
       _  -> return $ runParser (space *> (many (space *> parseCompCommand)) <* eof) filePath content


{-|
  generalCmd ::= ':help' | ':save' | ':load' | ':exit' | parseCompCommand
-}
generalCmd :: Parser GeneralCommand
generalCmd = try (do B.symbol ":help"
                     return (CtrlCmd Help))
             <|> try (do B.symbol ":save"
                         filePath <- some anyChar
                         return (CtrlCmd (Save filePath)))
                 <|> try (do B.symbol ":load"
                             filePath <- some anyChar
                             return (CtrlCmd (Load filePath)))
                     <|> try (do B.symbol ":exit"
                                 return (CtrlCmd Exit))
                         <|> do gCmd <- parseCompCommand
                                return (GraphicCmd gCmd)


{-|
  parseCompCommand ::= atomic ')'+ (';' (parseCompCommand | vacio) | vacio)
                     | atomic (';' (parseCompCommand | vacio) | vacio)
                     | newIncRep
-}
parseCompCommand :: Parser CompCom
parseCompCommand = try (do cc <- atomic
                           parList <- some (B.symbol ")")
                           let count = length parList
                               finalParCC = repeatFinalPar count cc
                           (do B.symbol ";"
                               (do seq' <- parseCompCommand
                                   return $ joinCmds finalParCC seq'
                                <|> return (IncCompCom finalParCC))
                            <|> return finalParCC))
                   <|> try (do cc <- atomic
                               (do B.symbol ";"
                                   (do seq <- parseCompCommand
                                       return $ joinCmds cc seq
                                    <|> return (IncCompCom cc))
                                <|> return cc))
                       <|> try newIncRep
                   

{-|
  newIncRep ::= 'rep' integer '(' incComm
-}
newIncRep :: Parser CompCom
newIncRep = do B.symbol "rep"
               n <- integer
               B.symbol "("
               inc <- incComm
               return $ simplifyIncRep n inc


{-|
  incComm ::= atomic ';' (incComm | vacio) | newIncRep
-}
incComm :: Parser CompCom
incComm = try (do cc <- atomic
                  B.symbol ";"
                  (do seq <- incComm
                      return $ joinCmds cc seq
                   <|> return (IncCompCom cc)))
          <|> newIncRep


{-|
  atomic ::= parseCommand | 'rep' integer '(' seqWithoutIncRep ')' | '(' seqWithoutIncRep ')'
-}
atomic :: Parser CompCom
atomic = try (do c <- parseCommand
                 return $ Cmd c)
         <|> try (do B.symbol "rep"
                     n <- integer
                     B.symbol "("
                     noIncRep <- seqWithoutIncRep
                     B.symbol ")"
                     return $ Rep n noIncRep)
             <|> do B.symbol "("
                    c <- seqWithoutIncRep
                    B.symbol ")"
                    return $ c


{-
  Parser de comandos simples
  parseCommand ::= 'fw' integer | 'rot' integer | 'chg' parseColor | 'clear' | 'reset'
-}
parseCommand :: Parser Command
parseCommand = try (do B.symbol "fw"
                       n <- double
                       return (Fw n))
               <|> try (do B.symbol "rot"
                           n <- double
                           return (Rot n))
                   <|> try (do B.symbol "chg"
                               c <- parseColor
                               return (Chg (stringToColor c)))
                       <|> try (do B.symbol "clear"
                                   return Clear)
                           <|> do B.symbol "reset"
                                  return Reset


{-|
  parseColor ::= 'rojo' | 'verde' | 'azul' | 'amarillo' | 'negro'
-}
parseColor :: Parser String
parseColor = try (B.symbol "rojo") <|> try (B.symbol "verde")
             <|> try (B.symbol "azul") <|> try (B.symbol "amarillo")
                 <|> B.symbol "negro"


{-
  seqWithoutIncRep ::= atomic (';' seqWithoutIncRep | vacio)
-}
seqWithoutIncRep :: Parser CompCom
seqWithoutIncRep = do cc <- atomic
                      (do B.symbol ";"
                          seq <- seqWithoutIncRep
                          return $ joinCmds cc seq
                       <|> return cc)


repeatFinalPar :: Int -> CompCom -> CompCom
repeatFinalPar 1 cc = FinalCompCom cc
repeatFinalPar n cc = FinalCompCom (repeatFinalPar (n-1) cc)


stringToColor :: String -> Color
stringToColor "rojo"      = Rojo
stringToColor "verde"     = Verde
stringToColor "azul"      = Azul
stringToColor "amarillo"  = Amarillo
stringToColor "negro"     = Negro


joinCmds :: CompCom -> CompCom -> CompCom
joinCmds (CCSeq xs) (CCSeq ys) = CCSeq (xs++ys)
joinCmds comm (CCSeq ys)       = CCSeq (comm:ys)
joinCmds (CCSeq xs) comm       = CCSeq (xs++[comm])
joinCmds comm comm'            = CCSeq [comm,comm']


simplifyIncRep :: Int -> CompCom -> CompCom
simplifyIncRep n (CCSeq xs)        = case last xs of
                                       IncCompCom comm -> IncRep n ((init xs) ++ [comm])
                                       _               -> IncRep n xs
simplifyIncRep n (IncCompCom comm) = IncRep n [comm]
simplifyIncRep n comm              = IncRep n [comm]