module BrownPLT.JavaScript.MultiplateSimplified where
import BrownPLT.JavaScript
import Data.Generics.Multiplate
import Data.Generics.Multiplate.Simplified
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
constr <$>: a = constr <$> (getProjector p a) p a
appl <*>: a = appl <*> (getProjector p a) p a
infixl 4 <$>:
infixl 4 <*>:
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 <*>: 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 <*>: expr <*> pure str
bLValue (LBracket a expr expr') = LBracket <$> pure a <*>: expr <*>: expr'
bCaseClause (CaseClause a expr stmts) = CaseClause <$> pure a <*>: expr <*> traverse (pStatement p) stmts
bCaseClause (CaseDefault a stmts) = CaseDefault <$> pure a <*> traverse (pStatement p) stmts
bCatchClause (CatchClause a ident stmt) = CatchClause <$> pure a <*>: ident <*>: stmt
bVarDecl (VarDecl a ident maybeExpr) = VarDecl <$> pure a <*>: ident <*> traverse (pExpression p) maybeExpr
bForInit (NoInit) = pure NoInit
bForInit (VarInit varDecls) = VarInit <$> traverse (pVarDecl p) varDecls
bForInit (ExprInit expr) = ExprInit <$>: expr
bForInInit (ForInVar ident) = ForInVar <$>: ident
bForInInit (ForInNoVar ident) = ForInNoVar <$>: 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 <*>: ident
bExpression (DotRef a expr ident) = DotRef <$> pure a <*>: expr <*>: ident
bExpression (BracketRef a exprContainer exprKey) = BracketRef <$> pure a <*>: exprContainer <*>: exprKey
bExpression (NewExpr a exprConstructor exprs) = NewExpr <$> pure a <*>: exprConstructor <*> traverse (pExpression p) exprs
bExpression (PrefixExpr a prefixOp expr) = PrefixExpr <$> pure a <*> pPrefixOp p prefixOp <*>: expr
bExpression (UnaryAssignExpr a unaryAssignOp lvalue) = UnaryAssignExpr <$> pure a <*>: unaryAssignOp <*>: lvalue
bExpression (InfixExpr a infixOp expr expr') = InfixExpr <$> pure a <*>: infixOp <*>: expr <*>: expr'
bExpression (CondExpr a expr expr' expr'') = CondExpr <$> pure a <*>: expr <*>: expr' <*>: expr''
bExpression (AssignExpr a assignOp lvalue expr) = AssignExpr <$> pure a <*>: assignOp <*>: lvalue <*>: expr
bExpression (ParenExpr a expr) = ParenExpr <$> pure a <*>: expr
bExpression (ListExpr a exprs) = ListExpr <$> pure a <*> traverse (pExpression p) exprs
bExpression (CallExpr a expr exprs) = CallExpr <$> pure a <*>: expr <*> traverse (pExpression p) exprs
bExpression (FuncExpr a maybeIdent idents stmt) = FuncExpr <$> pure a <*> traverse (pId p) maybeIdent <*> traverse (pId p) idents <*>: 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 <*>: expr
bStatement (IfStmt a expr stmt stmt') = IfStmt <$> pure a <*>: expr <*>: stmt <*>: stmt'
bStatement (IfSingleStmt a expr stmt) = IfSingleStmt <$> pure a <*>: expr <*>: stmt
bStatement (SwitchStmt a expr caseClauses) = SwitchStmt <$> pure a <*>: expr <*> traverse (pCaseClause p) caseClauses
bStatement (WhileStmt a expr stmt) = WhileStmt <$> pure a <*>: expr <*>: stmt
bStatement (DoWhileStmt a stmt expr) = DoWhileStmt <$> pure a <*>: stmt <*>: 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 <*>: ident <*>: stmt
bStatement (ForInStmt a forInInit expr stmt) = ForInStmt <$> pure a <*>: forInInit <*>: expr <*>: stmt
bStatement (ForStmt a forInit maybeExprTest maybeExprIncr stmt) =
ForStmt <$> pure a <*>: forInit <*> traverse (pExpression p) maybeExprTest <*> traverse (pExpression p) maybeExprIncr <*>: stmt
bStatement (TryStmt a stmt catchClauses maybeStmt) =
TryStmt <$> pure a <*>: stmt <*> traverse (pCatchClause p) catchClauses <*> traverse (pStatement p) maybeStmt
bStatement (ThrowStmt a expr) = ThrowStmt <$> pure a <*>: expr
bStatement (ReturnStmt a maybeExpr) = ReturnStmt <$> pure a <*> traverse (pExpression p) maybeExpr
bStatement (WithStmt a expr stmt) = WithStmt <$> pure a <*>: expr <*>: stmt
bStatement (VarDeclStmt a varDecls) = VarDeclStmt <$> pure a <*> traverse (pVarDecl p) varDecls
bStatement (FunctionStmt a ident idents stmt) = FunctionStmt <$> pure a <*>: ident <*> traverse (pId p) idents <*>: stmt
instance IsProjector Plate (Statement a) where
getProjector _ _ = pStatement
instance IsProjector Plate (Expression a) where
getProjector _ _ = pExpression
instance IsProjector Plate (JavaScript a) where
getProjector _ _ = pJavaScript
instance IsProjector Plate (Id a) where
getProjector _ _ = pId
instance IsProjector Plate (InfixOp) where
getProjector _ _ = pInfixOp
instance IsProjector Plate (AssignOp) where
getProjector _ _ = pAssignOp
instance IsProjector Plate (UnaryAssignOp) where
getProjector _ _ = pUnaryAssignOp
instance IsProjector Plate (PrefixOp) where
getProjector _ _ = pPrefixOp
instance IsProjector Plate (Prop a) where
getProjector _ _ = pProp
instance IsProjector Plate (LValue a) where
getProjector _ _ = pLValue
instance IsProjector Plate (CaseClause a) where
getProjector _ _ = pCaseClause
instance IsProjector Plate (CatchClause a) where
getProjector _ _ = pCatchClause
instance IsProjector Plate (VarDecl a) where
getProjector _ _ = pVarDecl
instance IsProjector Plate (ForInit a) where
getProjector _ _ = pForInit
instance IsProjector Plate (ForInInit a) where
getProjector _ _ = pForInInit