PiGeneration.hs

{-# LANGUAGE QuasiQuotes #-}
module Language.Java.Paragon.PiGeneration where

import Language.Java.Paragon.Syntax
import Language.Java.Paragon.Interaction
import Language.Java.Paragon.QuasiQuoter

import Control.Applicative

piGenModule :: String
piGenModule = libraryBase ++ ".PiGeneration"


piTransform :: CompilationUnit () -> CompilationUnit () 
piTransform  = transformCompilationUnit
--for generating Pi there should be a package name
-- no imports
-- one type for each compilationUnit since the execution is for one class 
-- but we can transform without considering that condition
transformCompilationUnit :: CompilationUnit () -> CompilationUnit ()
transformCompilationUnit (CompilationUnit _ mpDecl _  tdecls)
  = CompilationUnit () mpDecl []  (transformTypeDecl<$>tdecls)
----------------
transformTypeDecl :: TypeDecl () -> TypeDecl ()
transformTypeDecl (InterfaceTypeDecl _ (InterfaceDecl _ mods iden tparams refts ib))
  =  ClassTypeDecl () (ClassDecl () mods iden tparams Nothing refts (transformInterfaceBody ib)) -- Maybe typeDecl
transformTypeDecl (ClassTypeDecl _ (ClassDecl _ mods iden tparams mt refts (ClassBody _ dcls))) 
  = ClassTypeDecl () (ClassDecl () mods iden tparams mt refts (ClassBody () $ concat $ transformDecl <$> dcls))
transformTypeDecl _ = panic (piGenModule ++ ".transformTypeDecl") "Enums not yet supported"
----------------    
transformDecl :: Decl () -> [Decl ()]
transformDecl (MemberDecl _ md) = [MemberDecl () $ transformMemberDecl md]
transformDecl _ = []
----------------
transformInterfaceBody :: InterfaceBody () -> ClassBody ()
transformInterfaceBody (InterfaceBody _ mds) = ClassBody () $ (\md->MemberDecl () (transformMemberDecl md))<$>mds
-------------
transformMemberDecl :: MemberDecl () -> MemberDecl ()
transformMemberDecl f@(FieldDecl _ _ [typeQQ| actor  |] _) = f
transformMemberDecl f@(FieldDecl _ _ [typeQQ| policy |] _) = f
transformMemberDecl (FieldDecl _ fmods ft vdecs) = (FieldDecl () fmods ft (transformVarDecls vdecs))
transformMemberDecl m@(MethodDecl _ mmods mtparams mmaybet mident mformparams mexceptionspecs mb) 
  | Typemethod () `elem` mmods  = m
  | otherwise  = MethodDecl () mmods mtparams mmaybet mident mformparams mexceptionspecs (transformMethodBody mb)
transformMemberDecl (ConstructorDecl _ cmods ctparams cident cformparams cexceptionspecs cb) 
  = ConstructorDecl () cmods ctparams cident cformparams cexceptionspecs (transformConstructorBody cb)
transformMemberDecl x = x
-- I assumed the LockDecl and PolicyDecl should not be touch 
-- Also I didnt write code for inner classes/interfaces 
------
transformVarDecls :: [VarDecl ()] -> [VarDecl ()]
transformVarDecls vds = [ VarDecl () varDeclId Nothing | (VarDecl _ varDeclId _) <- vds]
-------
transformMethodBody :: MethodBody () -> MethodBody ()
transformMethodBody = const $ MethodBody () Nothing -- [methodBodyQQ|{}|] 
-- maybe we have to add nothing instead of "just emptyMethodBody" 
-------
transformConstructorBody ::  ConstructorBody () -> ConstructorBody ()
transformConstructorBody (ConstructorBody _ _eci _bs) = ConstructorBody () Nothing [] -- second argument nothing ?