{-# LANGUAGE Rank2Types  #-}

module BrownPLT.JavaScript.Multiplate where

import BrownPLT.JavaScript

import Data.Generics.Multiplate
import Control.Applicative
import Data.Functor.Identity
import Data.Functor.Constant
import Data.Functor.Compose
import Data.Traversable



data Plate f = Plate
           {pJavaScript    :: forall a. JavaScript a -> f (JavaScript a)
	   ,pId            :: forall a. Id a -> f (Id a)
	   ,pInfixOp       :: InfixOp -> f InfixOp
	   ,pAssignOp      :: AssignOp -> f AssignOp
	   ,pUnaryAssignOp :: UnaryAssignOp -> f UnaryAssignOp
	   ,pPrefixOp      :: PrefixOp -> f PrefixOp
	   ,pProp          :: forall a. Prop a -> f (Prop a)
	   ,pLValue        :: forall a. LValue a -> f (LValue a)
	   ,pExpression    :: forall a. Expression a -> f (Expression a)
	   ,pCaseClause    :: forall a. CaseClause a -> f (CaseClause a)
	   ,pCatchClause   :: forall a. CatchClause a -> f (CatchClause a)
	   ,pVarDecl       :: forall a. VarDecl a -> f (VarDecl a)
	   ,pForInit       :: forall a. ForInit a -> f (ForInit a)
	   ,pForInInit     :: forall a. ForInInit a -> f (ForInInit a)
	   ,pStatement     :: forall a. Statement a -> f (Statement a)
           }


instance Multiplate Plate where
 mkPlate b = Plate (b pJavaScript) (b pId) (b pInfixOp) (b pAssignOp) (b pUnaryAssignOp) (b pPrefixOp) (b pProp) (b pLValue)
                   (b pExpression) (b pCaseClause) (b pCatchClause) (b pVarDecl) (b pForInit) (b pForInInit) (b pStatement)
 multiplate p  = Plate bJavaScript bId bInfixOp bAssignOp bUnaryAssignOp bPrefixOp bProp bLValue
                       bExpression bCaseClause bCatchClause bVarDecl bForInit bForInInit bStatement
  where
   
   traverseTuple fa fb (a, b) = (,) <$> fa a <*> fb b

   bJavaScript (Script a stmts) = Script <$> pure a <*> traverse (pStatement p) stmts
   
   bId (Id a str) = Id <$> pure a <*> pure str

   bInfixOp       = pure
   bAssignOp      = pure
   bUnaryAssignOp = pure
   bPrefixOp      = pure

   bProp (PropId a ident)   = PropId <$> pure a <*> pId p ident
   bProp (PropString a str) = PropString <$> pure a <*> pure str
   bProp (PropNum a int)    = PropNum <$> pure a <*> pure int

   bLValue (LVar a str)            = LVar <$> pure a <*> pure str
   bLValue (LDot a expr str)       = LDot <$> pure a <*> pExpression p expr <*> pure str
   bLValue (LBracket a expr expr') = LBracket <$> pure a <*> pExpression p expr <*> pExpression p expr'

   bCaseClause (CaseClause a expr stmts)   = CaseClause <$> pure a <*> pExpression p expr <*> traverse (pStatement p) stmts
   bCaseClause (CaseDefault a stmts)       = CaseDefault <$> pure a <*> traverse (pStatement p) stmts

   bCatchClause (CatchClause a ident stmt) = CatchClause <$> pure a <*> pId p ident <*> pStatement p stmt

   bVarDecl (VarDecl a ident maybeExpr)    = VarDecl <$> pure a <*> pId p ident <*> traverse (pExpression p) maybeExpr
   
   bForInit (NoInit)             = pure NoInit
   bForInit (VarInit varDecls)   = VarInit <$> traverse (pVarDecl p) varDecls
   bForInit (ExprInit expr)      = ExprInit <$> pExpression p expr
   
   bForInInit (ForInVar ident)   = ForInVar <$> pId p ident
   bForInInit (ForInNoVar ident) = ForInNoVar <$> pId p ident

   bExpression (StringLit a str)  = StringLit <$> pure a <*> pure str
   bExpression (RegexpLit a str boolGlobal boolCI)  = RegexpLit <$> pure a <*> pure str <*> pure boolGlobal <*> pure boolCI
   bExpression (NumLit a double)  = NumLit <$> pure a <*> pure double
   bExpression (IntLit a int)     = IntLit <$> pure a <*> pure int
   bExpression (BoolLit a bool)   = BoolLit <$> pure a <*> pure bool
   bExpression (NullLit a)        = NullLit <$> pure a
   bExpression (ArrayLit a exprs) = ArrayLit <$> pure a <*> traverse (pExpression p) exprs
   bExpression (ObjectLit a propToExprMap) = ObjectLit <$> pure a <*> traverse (traverseTuple (pProp p) (pExpression p)) propToExprMap
   bExpression (ThisRef a)             = ThisRef <$> pure a
   bExpression (VarRef a ident)        = VarRef <$> pure a <*> pId p ident
   bExpression (DotRef a expr ident)   = DotRef <$> pure a <*> pExpression p expr <*> pId p ident
   bExpression (BracketRef a exprContainer exprKey) = BracketRef <$> pure a <*> pExpression p exprContainer <*> pExpression p exprKey
   bExpression (NewExpr a exprConstructor exprs)    = NewExpr <$> pure a <*> pExpression p exprConstructor <*> traverse (pExpression p) exprs
   bExpression (PrefixExpr a prefixOp expr)         = PrefixExpr <$> pure a <*> pPrefixOp p prefixOp <*> pExpression p expr
   bExpression (UnaryAssignExpr a unaryAssignOp lvalue) = UnaryAssignExpr <$> pure a <*> pUnaryAssignOp p unaryAssignOp <*> pLValue p lvalue
   bExpression (InfixExpr a infixOp expr expr')     = InfixExpr <$> pure a <*> pInfixOp p infixOp <*> pExpression p expr <*> pExpression p expr'
   bExpression (CondExpr a expr expr' expr'')       = CondExpr <$> pure a <*> pExpression p expr <*> pExpression p expr' <*> pExpression p expr''
   bExpression (AssignExpr a assignOp lvalue expr)  = AssignExpr <$> pure a <*> pAssignOp p assignOp <*> pLValue p lvalue <*> pExpression p expr
   bExpression (ParenExpr a expr)      = ParenExpr <$> pure a <*> pExpression p expr
   bExpression (ListExpr a exprs)      = ListExpr <$> pure a <*> traverse (pExpression p) exprs
   bExpression (CallExpr a expr exprs) = CallExpr <$> pure a <*> pExpression p expr <*> traverse (pExpression p) exprs
   bExpression (FuncExpr a maybeIdent idents stmt)  = FuncExpr <$> pure a <*> traverse (pId p) maybeIdent <*> traverse (pId p) idents <*> pStatement p stmt
   
   bStatement (BlockStmt a stmts) = BlockStmt <$> pure a <*> traverse (pStatement p) stmts
   bStatement (EmptyStmt a)       = EmptyStmt <$> pure a
   bStatement (ExprStmt a expr)   = ExprStmt <$> pure a <*> pExpression p expr
   bStatement (IfStmt a expr stmt stmt')  = IfStmt <$> pure a <*> pExpression p expr <*> pStatement p stmt <*> pStatement p stmt'
   bStatement (IfSingleStmt a expr stmt)  = IfSingleStmt <$> pure a <*> pExpression p expr <*> pStatement p stmt
   bStatement (SwitchStmt a expr caseClauses) = SwitchStmt <$> pure a <*> pExpression p expr <*> traverse (pCaseClause p) caseClauses
   bStatement (WhileStmt a expr stmt)     = WhileStmt <$> pure a <*> pExpression p expr <*> pStatement p stmt
   bStatement (DoWhileStmt a stmt expr)   = DoWhileStmt <$> pure a <*> pStatement p stmt <*> pExpression p expr
   bStatement (BreakStmt a maybeIdent)    = BreakStmt <$> pure a <*> traverse (pId p) maybeIdent
   bStatement (ContinueStmt a maybeIdent) = ContinueStmt <$> pure a <*> traverse (pId p) maybeIdent
   bStatement (LabelledStmt a ident stmt) = LabelledStmt <$> pure a <*> pId p ident <*> pStatement p stmt
   bStatement (ForInStmt a forInInit expr stmt) = ForInStmt <$> pure a <*> pForInInit p forInInit <*> pExpression p expr <*> pStatement p stmt
   bStatement (ForStmt a forInit maybeExprTest maybeExprIncr stmt) = 
          ForStmt <$> pure a <*> pForInit p forInit <*> traverse (pExpression p) maybeExprTest <*> traverse (pExpression p) maybeExprIncr <*> pStatement p stmt
   bStatement (TryStmt a stmt catchClauses maybeStmt) =
          TryStmt <$> pure a <*> pStatement p stmt <*> traverse (pCatchClause p) catchClauses <*> traverse (pStatement p) maybeStmt
   bStatement (ThrowStmt a expr)       = ThrowStmt <$> pure a <*> pExpression p expr
   bStatement (ReturnStmt a maybeExpr) = ReturnStmt <$> pure a <*> traverse (pExpression p) maybeExpr
   bStatement (WithStmt a expr stmt)   = WithStmt <$> pure a <*> pExpression p expr <*> pStatement p stmt
   bStatement (VarDeclStmt a varDecls) = VarDeclStmt <$> pure a <*> traverse (pVarDecl p) varDecls
   bStatement (FunctionStmt a ident idents stmt) = FunctionStmt <$> pure a <*> pId p ident <*> traverse (pId p) idents <*> pStatement p stmt