module Stack
(emptyStack,
 combineStacks,
 makeStack,
 modifyStack,
 cmdStackState)
where

import TypesAndConstants
import PrettyPrinting
import Control.Monad.State


emptyStack :: [CompCom]
emptyStack = []


{-|
  Setea newStack como el stack del estado del programa
-}
modifyStack :: [CompCom] -> State ProgramState ()
modifyStack newStack = setStack newStack


{-|
  A partir de 2 stacks genera un único stack e indica si se debe
  seguir esperando comandos o ya se puede dibujar.

  Esta función toma
    - Stack actual del programa
    - Stack generado a partir del último comando ingresado por el usuario
  y genera un nuevo stack e indica si se puede dibujar o hay que seguir
  pidiendo comandos para completar los anteriores incompletos
-}
combineStacks :: [CompCom] -> [CompCom] -> Either String ([CompCom], Bool)
combineStacks stack oldStack = genNewStack stack oldStack False


genNewStack :: [CompCom] -> [CompCom] -> Bool -> Either String ([CompCom], Bool)
genNewStack stack@(_:css) oldStack b =
  case cmdStackState css of
    Complete -> genNewStack' stack oldStack False
    _        -> genNewStack' stack oldStack True
genNewStack stack oldStack b = genNewStack' stack oldStack b


{-|
  genNewStack' stack oldStack okToAdd:

    - okToAdd: Es útil en la función unifyStackCmds, ver comentario de dicha función
-}
genNewStack' :: [CompCom] -> [CompCom] -> Bool -> Either String ([CompCom], Bool)
genNewStack' stack [] b =
  let revStack = reverse stack
  in case cmdStackState stack of
       IncompleteComm -> Right (removeIncCompCom revStack, False)
       IncompleteRep  -> Right (revStack, False)
       Complete       -> 
         case stack of
           [x]      -> Right (stack, True)
           (_:_:_) -> Right (joinCompleteCmds revStack,True)
       _              -> Left "Queriendo completar un comando inexistente o cerrando mas repeticiones de las debidas."

genNewStack' [] oldStack _ = case cmdStackState oldStack of
                              Complete -> Right (oldStack, True)
                              _        -> Right (oldStack, False)

genNewStack' stack@(cc:ccs) oldStack@(cc':ccs') okToAdd =
  let cState = cmdState cc
      eitherMiddleCmd = case cState of
                          IncompleteRep -> Right cc' -- En este caso se devuelve cc' ya que si se trata de una repetición incompleta
                                                     -- todos comandos que se escribieron son parte de la misma
                          _             -> unifyStackCmds cc' cc cState okToAdd
  in case eitherMiddleCmd of
       Right middleCmd ->
         case cState of
           IncompleteRep  -> Right (reverse stack ++ oldStack, False)
           IncompleteComm -> Right (middleCmd:ccs', False)            -- Si el comando que agregué terminaba en ';' entonces
                                                                      -- a la derecha no podía haber ningún comando más
           Complete       -> genNewStack' ccs (middleCmd:ccs') False
           IncompleteFin  -> genNewStack' (middleCmd:ccs) ccs' True   -- Cuando cc tiene estado IncompleteFin y unifyStackCmds no
                                                                      -- devuelve error, el comando lo genera el proceso, por eso
                                                                      -- la llamada recursiva se hace con True
           Completing     ->
             case cmdState middleCmd of
               Complete -> case ccs of
                             [] -> case ccs' of                         -- No hay más comandos ingresados
                                     []  -> Right $ ([middleCmd], True)
                                     x:_ -> if cmdState x == Complete
                                            then Right $ ([joinCmds x middleCmd], True) -- Llegado este caso solo va a quedar
                                                                                        -- un comando en el stack a completar
                                            else Left "Intentando finalizar comando cuando aún quedan comandos para completar."
                             _  -> if null ccs'
                                   then genNewStack' ccs [middleCmd] False
                                   else genNewStack' (middleCmd:ccs) ccs' True
               _        -> genNewStack' (middleCmd:ccs) ccs' True
       Left err -> Left err


{-|
  Une los comandos de un stack.
  Cuando todos los comandos de un stack son completos,
  se llama a esta función para generar uno único
-}
joinCompleteCmds :: [CompCom] -> [CompCom]
joinCompleteCmds [x] = [x]
joinCompleteCmds (x:y:xs) = joinCompleteCmds ((joinCmds y x) : xs)


{-|

  Esta función se usa para combinar un comando del stack anterior y un comando que se genera a partir
  de la siguiente línea ingresada por el usuario.
  
  unifyStackCmds cmdToComplete cmdToAdd cmdState okToAdd

  - cmdToComplete: Comando a completar (tomado del tope del stack anterior)

  - cmdToAdd: Comando a agregar a cmdToComplete (último elemento del nuevo stack)

  - cmdState: Indica el estado de cmdToAdd

              - Repetición incompleta

              - Incompleto sin repetición incompleta

              - Comando para completar uno previo

  - okToAdd: Con True indica que el comando fue generado por una iteración del proceso.

             En el caso de ser un comando completo, es correcto agregarlo al comando
             a completar.
             No permite que se ingrese un comando como el siguiente:
               cmd1; rep n ( cmd2;
               cmd3
            ya que este caso no es correcto porque las repeticiones deben continuarse con comandos 
            incompletos o cerrarse.

  ------------------------------------------------------------------------------------

      Stack generado a partir del último comando ingresado            Stack actual   

                                                                      |   OldCmd5   |
                                                                      |   OldCmd4   |
                       |    NewCmd3    |                              |   OldCmd3   |
                       |    NewCmd2    |                              |   OldCmd2   |
                       |    NewCmd1    |                              |   OldCmd1   |

    Por como se generan los stacks, el comando menos anidado se ubica en la parte inferior y el más anidado
    en la parte superior. Por lo tanto, en la siguiente iteración los 2 comandos a combinar serán OldCmd5 y
    NewCmd1 ya que OldCmd5 es el último comando que se ingresó antes de presionar enter y NewCmd1 es el primer
    comando (ó secuencia) que se escribió en la siguiente línea
-}

unifyStackCmds :: CompCom -> CompCom -> CmdState -> Bool -> Either String CompCom
unifyStackCmds (IncRep n ccs') (IncCompCom cc)       IncompleteComm _ = Right $ IncRep n (ccs'++[cc])
unifyStackCmds (CCSeq ccs')    (IncCompCom cc)       IncompleteComm _ = Right $ CCSeq (ccs'++[cc])
unifyStackCmds (Cmd cc')       (IncCompCom cc)       IncompleteComm _ = Right $ CCSeq [Cmd cc',cc]
unifyStackCmds rep@(Rep n seq) (IncCompCom cc)       IncompleteComm _ = Right $ CCSeq [rep,cc]
unifyStackCmds (IncCompCom cc) (IncCompCom cc')      IncompleteComm _ = Right $ CCSeq [cc,cc']
unifyStackCmds (IncRep n ccs') (CCSeq ccs)           IncompleteComm _ = Right $ IncRep n (ccs'++(removeIncCompCom ccs))
unifyStackCmds (CCSeq ccs')    (CCSeq ccs)           IncompleteComm _ = Right $ CCSeq (ccs'++(removeIncCompCom ccs))
unifyStackCmds (Cmd cc)        (CCSeq ccs)           IncompleteComm _ = Right $ CCSeq (Cmd cc:(removeIncCompCom ccs))
unifyStackCmds rep@(Rep n seq) (CCSeq ccs)           IncompleteComm _ = Right $ CCSeq (rep:(removeIncCompCom ccs))
unifyStackCmds (IncCompCom cc) (CCSeq ccs)           IncompleteComm _ = Right $ CCSeq (cc:(removeIncCompCom ccs))
unifyStackCmds _               _                     IncompleteComm _ = error "Solo puede haber secuencias o repeticiones incompletas para completar."


unifyStackCmds (IncRep n ccs)  cls@(IncCompCom fcc)  IncompleteFin  _ = Right $ replaceCmd cls (Rep n (CCSeq (ccs++[getCmd fcc])))
unifyStackCmds (IncRep n ccs') (CCSeq ccs)           IncompleteFin  _ = let s = init ccs
                                                                            cc = last ccs
                                                                        in Right $ replaceCmd cc (Rep n (CCSeq (ccs'++s++[getCmd cc])))
unifyStackCmds _               icc                   IncompleteFin  _ = Left $ (showCompComm icc) ++ " intenta completar una repetición incompleta inexistente."


unifyStackCmds (IncRep n ccs') cls@(FinalCompCom cc) Completing     _ = Right $ replaceCmd cls (Rep n (CCSeq (ccs'++[getCmd cc])))
unifyStackCmds (IncRep n ccs') (CCSeq ccs)           Completing     _ = let s = init ccs
                                                                            cc = last ccs
                                                                        in Right $ replaceCmd cc (Rep n (CCSeq (ccs'++s++[getCmd cc])))
unifyStackCmds _               cc                    Completing     _ = Left $ (showCompComm cc) ++ " intenta completar una repetición incompleta inexistente."


unifyStackCmds (Cmd cc)        cc'                   Complete       _     = Right $ CCSeq [Cmd cc, cc']
unifyStackCmds (CCSeq ccs')    cc                    Complete       _     = Right $ CCSeq (ccs'++[cc])
unifyStackCmds (Rep n seq)     cc                    Complete       _     = Right $ CCSeq [Rep n seq, cc]
unifyStackCmds (IncRep n ccs') cc                    Complete       True  = Right $ IncRep n (ccs'++[cc])
unifyStackCmds (IncRep n ccs') cc                    Complete       False = Left $ "Se ingreso el comando\n" ++ showCompComm cc ++ "\npero debe continuar con comandos incompletos o completar la repetición."
unifyStackCmds _               _                     Complete       _     = error "Solo puede haber secuencias o repeticiones incompletas en el stack."

unifyStackCmds _               _                     _              _     = error "Intentando completar comandos con comandos o secuencias de comandos incorrectas."


{-|
  Obtiene el comando mas anidado correspondiente al constructor FinalCompCom o IncCompCom.

  Por ejemplo:

    - getCmd (FinalCompCom (FinalCompCom (FinalCompCom (Cmd (Fw 10))))) -----> Cmd (Fw 10)

    - getCmd (IncCompCom (FinalCompCom (FinalCompCom (Cmd (Rot 30)))))  -----> Cmd (Rot 30)
-}

getCmd :: CompCom -> CompCom
getCmd (FinalCompCom (Cmd c)) = Cmd c
getCmd (FinalCompCom cc)      = getCmd cc
getCmd (IncCompCom cc)        = getCmd cc
getCmd cc                     = cc


{-|
  Reemplaza el FinalCompCom cmd mas anidado de un comando FinalCompCom o IncCompCom FinalCompCom.

  Por ejemplo:

    - replaceCmd (FinalCompCom (FinalCompCom (FinalCompCom (Cmd (Fw 10))))) c -----> FinalCompCom (FinalCompCom c)

    - replaceCmd (IncCompCom (FinalCompCom (FinalCompCom (Cmd (Rot 30)))))  c -----> IncCompCom (FinalCompCom c)
-}

replaceCmd :: CompCom -> CompCom -> CompCom
replaceCmd (FinalCompCom (FinalCompCom cc')) cc  = FinalCompCom (replaceCmd (FinalCompCom cc') cc)
replaceCmd (FinalCompCom cc')                cc  = cc
replaceCmd (IncCompCom cc')                  cc  = IncCompCom (replaceCmd cc' cc)
replaceCmd cc                                cc' = error "replaceCmd solo debería ejecutarse con constructores FinalCompCom o IncCompCom FinalCompCom"


{-|
  Quita los contructores IncCompCom de una lista de comandos.

  Por ejemplo:

    removeIncCompCom [Cmd (Fw 10), IncCompCom (Cmd (Rot 50))] -----> [Cmd (Fw 10), Cmd (Rot 50)]
-}

removeIncCompCom :: [CompCom] -> [CompCom]
removeIncCompCom [] = []
removeIncCompCom ((IncCompCom cc):xs) = cc:(removeIncCompCom xs)
removeIncCompCom ((CCSeq ccs):xs)     = let ccs' = removeIncCompCom ccs
                                        in (CCSeq ccs'):(removeIncCompCom xs)
removeIncCompCom (cc:xs)              = cc:(removeIncCompCom xs)


{-|
  Devuelve el estado de un stack de comandos
-}

cmdStackState :: [CompCom] -> CmdState
cmdStackState [] = Complete
cmdStackState (cc:ccs) = case cmdState cc of
                           Complete -> cmdStackState ccs
                           otherwise -> otherwise


{-|
  Devuelve el estado de un comando
-}
cmdState :: CompCom -> CmdState
cmdState (IncRep _ _)                  = IncompleteRep
cmdState (IncCompCom (FinalCompCom _)) = IncompleteFin
cmdState (IncCompCom _)                = IncompleteComm
cmdState (FinalCompCom _)              = Completing
cmdState (CCSeq (x:xs))                = case cmdState x of
                                           Complete -> cmdState (CCSeq xs)
                                           otherwise -> otherwise
cmdState _                             = Complete


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']


{-|
  Genera un stack de comandos.
  Sí el argumento es un comando incompleto, entonces:
    - En el caso inicial será el stack de comandos incompletos que se guarda en el estado
    - En otro caso será el que se utilizará para completar el stack almacenado en el estado del juego

  Ejemplos:
    parseTest parseCompCommand "fw 100)); fw 10; fw 30;" = 
      CCSeq [FinalCompCom (FinalCompCom (Cmd (Fw 100.0))),Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))]

    makeStack (CCSeq [FinalCompCom (FinalCompCom (Cmd (Fw 100.0))),Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))]) =
      [
       CCSeq [Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))],
       FinalCompCom (FinalCompCom (Cmd (Fw 100.0)))
      ]


    parseTest parseCompCommand "rep 3 (fw 10; rep 4 ( fw 4; rep 5 ( rot 10; fw 5; rep 6 ( rep 7 (rot 10; fw 100;" =
      IncRep 3 [Cmd (Fw 10.0),IncRep 4 [Cmd (Fw 4.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0),IncRep 6 [IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]]]]

    makeStack (IncRep 3 [Cmd (Fw 10.0),IncRep 4 [Cmd (Fw 4.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0),IncRep 6 [IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]]]]) =

      [
       IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)],
       IncRep 6 [],
       IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0)],
       IncRep 4 [Cmd (Fw 4.0)],
       IncRep 3 [Cmd (Fw 10.0)]
      ]

    Notar que los comandos del stack generado quedan en el orden inverso a como se ingresaron,
    por lo tanto el último comando ingresado es el que está mas a la izquierda
-}
makeStack :: CompCom -> [CompCom]
makeStack cc = makeStack' cc [] False 0


{-|
  makeStack' cmd resultStack isRep n:

    - cmd: Comando a procesar

    - resultList: Stack que se está armando

    - isRep: Indica si lo que se está procesando es parte de una repetición

    - n: El entero de la repetición
-}
makeStack' :: CompCom -> [CompCom] -> Bool -> Int -> [CompCom]
makeStack' (CCSeq []) rs _ _   = rs
makeStack' (CCSeq xs) rs b n   = let (ys, rest) = splitList xs
                                 in makeStack'' ys rest rs b n
makeStack' (IncRep m [IncRep m' ccs]) rs b n = (makeStack' (IncRep m' ccs) ((IncRep m []):rs) b n)
makeStack' (IncRep m ccs) rs b n = makeStack' (CCSeq ccs) rs True m
makeStack' cc _ _ _              = [cc]


makeStack'' :: [CompCom] -> [CompCom] -> [CompCom] -> Bool -> Int -> [CompCom]
makeStack'' (r@(IncCompCom (FinalCompCom _)):_) ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) (r:rs) False n
makeStack'' (r@(IncCompCom (FinalCompCom _)):_) ys@(_:_)           rs False n = makeStack' (CCSeq ys) (r:rs) False n
makeStack'' (r@(IncCompCom (FinalCompCom _)):_) []                 rs False _ = r:rs
makeStack'' ((IncCompCom (FinalCompCom _)):_)   _                  _  True  _ = error "Se debería parsear como repetición de una sola línea"

makeStack'' (r@(FinalCompCom _):_)              ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) (r:rs) False n
makeStack'' (r@(FinalCompCom _):_)              ys@(_:_)           rs False n = makeStack' (CCSeq ys) (r:rs) False n
makeStack'' (r@(FinalCompCom _):_)              []                 rs False _ = r:rs
makeStack'' ((FinalCompCom cc):_)               _                  _  True  _ = error "Se debería parsear como repetición de una sola línea"

makeStack'' xs@(_:_)                            ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) ((CCSeq xs):rs) False n
makeStack'' xs@(_:_)                            ys@(_:_)           rs False n = makeStack' (CCSeq ys) ((CCSeq xs):rs) False n
makeStack'' xs@(_:_)                            []                 rs False _ = (CCSeq xs):rs
makeStack'' xs@(_:_)                            ((IncRep m ccs):_) rs True  n = makeStack' (IncRep m ccs) ((IncRep n xs):rs) False 0
makeStack'' xs@(_:_)                            ys@(_:_)           rs True  n = makeStack' (CCSeq ys) ((IncRep n xs):rs) False 0
makeStack'' xs@(_:_)                            []                 rs True  n = (IncRep n xs):rs

makeStack'' []                                  ((IncRep m ccs):_) rs b     n = makeStack' (IncRep m ccs) rs b n
makeStack'' []                                  ys@(_:_)           rs b     n = makeStack' (CCSeq ys) rs b n
makeStack'' []                                  []                 _  _     _ = error "No debería llegar makeStack''"



{-|
  Divide la lista cuando encuentra alguno de los siguientes comandos:

    1- IncCompCom

    2- FinalCompCom

    3- IncRep

  - En el caso de encontrar 1 o 2 los devuelve en la primer lista y en la
    segunda los comandos de la derecha.
  
  - En el caso que ecuentre 3, como todos los comandos que haya a
    la derecha serán parte de la misma, se devuelve la repetición
    en la segunda lista y en la primera todos los de la izquierda.

  Ejemplos:

    splitList [CCSeq [Cmd (Rot 30.0), Cmd (Fw 100.0)],
               IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] = 
      (
       [CCSeq [Cmd (Rot 30.0),Cmd (Fw 100.0)]],
       [IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]
      )

    splitList [Cmd (Rot 30.0),
               FinalCompCom (Cmd (Chg Rojo)),
               Cmd (Fw 100.0),
               IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] =
      (
       [Cmd (Rot 30.0),FinalCompCom (Cmd (Chg Rojo))],
       [Cmd (Fw 100.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]
      ) 
    

-}
splitList :: [CompCom] -> ([CompCom], [CompCom])
splitList [] = ([], [])
splitList ((IncRep n ys):xs) = ([], [IncRep n ys])
splitList (x:xs) = let (rs, rest) = splitList xs
                   in case x of
                        IncCompCom cc -> ([IncCompCom cc], xs)
                        FinalCompCom cc -> ([FinalCompCom cc], xs)
                        cc            -> (cc:rs, rest)