{-# LANGUAGE DeriveDataTypeable #-}
module Language.Grammars.ZipperAG.Examples.SmartParentesis where

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

data Root = Root Exp
	deriving (Eq, Ord, Show, Typeable, Data)

data Exp = Add Exp Exp
         | Mul Exp Exp
         | Div Exp Exp
         | Sub Exp Exp
         | Lit Int
           deriving (Eq, Ord, Show, Typeable, Data)

constructor :: Zipper Root -> String
constructor a = case (getHole a :: Maybe Exp) of
				   Just (Add _ _) -> "Add"
				   Just (Mul _ _) -> "Mul"
				   Just (Div _ _) -> "Div"
				   Just (Sub _ _) -> "Sub"
				   Just (Lit _) -> "Lit"
				   _ -> case (getHole a :: Maybe Root ) of
				   			Just (Root _) -> "Root"

lexeme :: Zipper Root -> Int
lexeme t = let Lit v = fromJust (getHole t :: Maybe Exp)
	      in v

---- AG ----
---- Inherited Attributes ----
enclosingOpPrecedence :: Zipper Root -> Int
enclosingOpPrecedence t = case (constructor t) of
							"Root" -> 0
							"Add" -> 1
							"Sub" -> 1
							"Mul" -> 2
							"Div" -> 2

leftOrRight :: Zipper Root -> String
leftOrRight t = case (constructor t) of
							"Root" -> "none"
							"Add" -> case t.|1 of
										True -> "left"
										False -> "right"
							"Sub" -> case t.|1 of
										True -> "left"
										False -> "right"
							"Mul" -> case t.|1 of
										True -> "left"
										False -> "right"
							"Div" -> "left"

bpp :: Zipper Root -> String
bpp t = case (constructor t) of
			  "Root" -> bpp (t.$1)
			  "Lit" -> show (lexeme t)
		  	  "Add" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left") 
		  	   			 then "(" ++ (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 )) ++ ")"
		  	   			 else (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 ))
			  "Sub" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left")
		      			 then "(" ++ (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 )) ++ ")"
		      			 else (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 ))
			  "Mul" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") 
		     			 then "(" ++ (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 )) ++ ")"
		      			 else (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 ))
			  "Div" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") 
		      			 then "(" ++ (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 )) ++ ")"
		      			 else (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 ))

-- SEMANTIC FUNCTIONS --
wrapInParens enclosingP thisP thisPos opAssoc = (enclosingP > thisP) || ((enclosingP == thisP) && (thisPos /= opAssoc))

{- Simple PrettyPrinting for Exp -}
exp2str :: Exp -> String
exp2str (Add a b) = "(" ++ exp2str(a) ++ " + " ++ exp2str(b) ++ ")"
exp2str (Mul a b) = "(" ++ exp2str(a) ++ " * " ++ exp2str(b) ++ ")"
exp2str (Div a b) = "(" ++ exp2str(a) ++ " / " ++ exp2str(b) ++ ")"
exp2str (Sub a b) = "(" ++ exp2str(a) ++ " - " ++ exp2str(b) ++ ")"
exp2str (Lit f) = show f

{- Tests -}
expr = Root $ Mul (Sub (Div (Lit 5) (Lit 5)) (Lit 10)) (Add (Lit 4) (Lit 5))

semantics z = bpp (toZipper z)