{-# LANGUAGE DeriveDataTypeable#-}

module Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening where

import Data.Generics.Zipper
import Language.Grammars.ZipperAG
import Data.Data

import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate
import Language.Grammars.ZipperAG.Examples.LET.Let_Scope
import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi

data VarList = VarList String VarList
             | NoVar

pointFree :: Zipper a -> (Zipper a -> Bool) -> (Zipper a -> b) -> (Zipper a -> Zipper a) -> b
pointFree ag cond calc incre = if   cond ag
                               then calc ag
                               else pointFree (incre ag) cond calc incre

solve :: Zipper RootA -> Zipper RootA
solve ag = pointFree ag isSolved id (toZipper . flatAG)

isSolved :: Zipper RootA -> Bool
isSolved ag = case (constructor ag) of
                "RootA"       -> isSolved $ ag.$1
                "LetA"        -> (isSolved $ ag.$1) || (isSolved $ ag.$2)
                "InA"         -> isConstant $ ag.$1
                "ConsAssignA" -> (isConstant $ ag.$2) && (isSolved $ ag.$3)
                "ConsLetA"    -> False
                "EmptyListA"  -> True

isSolvable :: Zipper RootA -> Bool
isSolvable ag = case (constructor ag) of
                 "Plus"        -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
                 "Divide"      -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
                 "Minus"       -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
                 "Time"        -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
                 "Variable"    -> isVarSolved (lexeme_Variable ag) ag
                 "Constant"    -> True

flatAG :: Zipper RootA -> RootA
flatAG ag = case (constructor ag) of
              "RootA" -> RootA (flatLetAG $ ag.$1) Empty

flatLetAG :: Zipper RootA -> LetA
flatLetAG ag = case (constructor ag) of
                 "LetA" -> LetA (flatListAG $ ag.$1) (lexme_LetA_2 ag) Empty

flatListAG :: Zipper RootA -> ListA
flatListAG ag = case (constructor ag) of
                  "ConsLetA"    -> if (isSolved $ ag.$2)
                                   then ConsAssignA (lexeme_ConsLetA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty
                                   else ConsLetA    (lexeme_ConsLetA_1 ag) (flatLetAG $ ag.$2)                  (flatListAG $ ag.$3) Empty
                  "ConsAssignA" -> if ((not . isConstant $ ag.$2) && (isSolvable $ ag.$2))
                                   then ConsAssignA (lexeme_ConsAssignA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty
                                   else ConsAssignA (lexeme_ConsAssignA_1 ag) (lexeme_ConsAssignA_2 ag)            (flatListAG $ ag.$3) Empty
                  "EmptyListA"  -> EmptyListA Empty

isConstant :: Zipper RootA -> Bool
isConstant ag = case (constructor ag) of
                  "Constant" -> True
                  _          -> False

calculate :: Zipper RootA -> Int
calculate ag = case (constructor ag) of
                 "RootA"       -> calculate $ ag.$1
                 "LetA"        -> calculate $ ag.$2
                 "InA"         -> calculate $ ag.$1
                 "Plus"        -> (calculate $ ag.$1) + (calculate $ ag.$2)
                 "Divide"      -> (calculate $ ag.$1) `div` (calculate $ ag.$2)
                 "Minus"       -> (calculate $ ag.$1) - (calculate $ ag.$2)
                 "Time"        -> (calculate $ ag.$1) * (calculate $ ag.$2)
                 "Variable"    -> getVarValue (lexeme_Variable ag) ag
                 "Constant"    -> lexeme_Constant ag

------- AUX's -------

getVarValue :: String -> Zipper RootA -> Int
getVarValue name ag = case (constructor ag) of
                       "RootA"    -> auxGetVarValue name ag
                       "ConsLetA" -> auxGetVarValue name (ag.$2)
                       _ -> getVarValue name (parent ag)

auxGetVarValue :: String -> Zipper RootA -> Int
auxGetVarValue name ag = case (constructor ag) of
                          "RootA"       -> auxGetVarValue name (ag.$1)
                          "LetA"        -> auxGetVarValue name (ag.$1)
                          "ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (lexeme_Constant $ ag.$2)
                                           else (auxGetVarValue name (ag.$3))
                          "ConsLetA"    -> auxGetVarValue name (ag.$3)
                          "EmptyListA"  -> oneUpGetVarValue name ag

oneUpGetVarValue :: String -> Zipper RootA -> Int
oneUpGetVarValue name ag = case (constructor ag) of
                       "ConsLetA" -> getVarValue name (parent ag)
                       _          -> oneUpGetVarValue name (parent ag)

isVarSolved :: String -> Zipper RootA -> Bool
isVarSolved name ag = case (constructor ag) of
                       "RootA"    -> auxIsVarSolved name ag
                       "ConsLetA" -> auxIsVarSolved name ag
                       _ -> isVarSolved name (parent ag)

auxIsVarSolved :: String -> Zipper RootA -> Bool
auxIsVarSolved name ag = case (constructor ag) of
                          "RootA"       -> auxIsVarSolved name (ag.$1)
                          "LetA"        -> auxIsVarSolved name (ag.$1)
                          "ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (isConstant $ ag.$2)
                                           else (auxIsVarSolved name (ag.$3))
                          "ConsLetA"    -> if (lexeme_ConsLetA_1 ag == name)    then False
                                           else (auxIsVarSolved name (ag.$3))
                          "EmptyListA"  -> oneUpIsVarSolved name ag

oneUpIsVarSolved :: String -> Zipper RootA -> Bool
oneUpIsVarSolved name ag = case (constructor ag) of
                       "ConsLetA" -> isVarSolved name (parent ag)
                       _          -> oneUpIsVarSolved name (parent ag)

flatten_Let p = solve $ toZipper (getRootC_RootA $ toZipper p)