{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
module Language.Java.Paragon.QuasiQuoter where
--import Language.Haskell.TH.Syntax 
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Lift
import Language.Java.Paragon.Parser
import Language.Java.Paragon.Syntax
import Text.ParserCombinators.Parsec
import Language.Java.Paragon.Lexer
import Language.Haskell.Meta.Parse
import Prelude hiding(exp)
import qualified GHC.Enum as GE 
fromRight :: Either a b -> b
fromRight (Right res) = res
instance Lift Double where
  lift d = let s = show d 
               cs = lift s
           in  [|(read $cs)::Double|]
               
$(deriveLiftMany [''Exp,''Literal,''ClassType,''TypeArgument,
       ''ClassBody,''ArrayInit,''MethodInvocation,''Name,''Op,       
       ''AssignOp,''PolicyExp,''Ident,''Lhs,''RefType,''Type,
       ''ArrayIndex,''FieldAccess,''NonWildTypeArgument,
       ''WildcardBound,''Decl,''VarInit,
       ''Clause,
       ''PrimType,
       ''Atom,
       ''Actor,
       ''ActorName,
       ''Lock,
       ''Block,
       ''MemberDecl,
       ''MethodBody,
       ''FormalParam,
       ''ExceptionSpec,
       ''ConstructorBody,
       ''InterfaceDecl,
       ''BlockStmt,
       ''Modifier,
       ''LockProperties,
       ''ClassDecl,
       ''TypeParam,
       ''VarDecl,
       ''InterfaceBody,
       ''VarDeclId,
       ''ExplConstrInv,
       ''Stmt,
       ''EnumConstant, ''ForInit, ''SwitchBlock, ''Catch,
       ''SwitchLabel, ''EnumBody])


--expToPat :: TS.Exp -> Pat 
--expToPat (LitE l) = [p|$l|]
--expToPat (VarE n) = [p|$n|]

parserQQ :: (Lift a,Show a) => GenParser (L Token) () a -> QuasiQuoter
parserQQ f = QuasiQuoter{ quoteExp=lift.fromRight.(parser f), 
                          quotePat=return.fromRight.parsePat.show.fromRight.(parser f)}       


expQQ = parserQQ exp
typeQQ = parserQQ ttype          
stmtQQ = parserQQ stmt
varDeclQQ=parserQQ varDecl
methodBodyQQ=parserQQ methodBody 
--memberDeclQQ= parserQQ memberDecl