{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Provides a monadic interface for building class files in a high-level format.
module JVM.Data.Abstract.Builder where

import Data.Tuple (swap)
import Data.TypeMergingList qualified as TML
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Local
import Effectful.TH
import JVM.Data.Abstract.ClassFile (ClassFile (..), ClassFileAttribute (BootstrapMethods))
import JVM.Data.Abstract.ClassFile.AccessFlags (ClassAccessFlag)
import JVM.Data.Abstract.ClassFile.Field
import JVM.Data.Abstract.ClassFile.Method
import JVM.Data.Abstract.ConstantPool
import JVM.Data.Abstract.Name
import JVM.Data.JVMVersion

data ClassBuilder m a where
    ModifyClass :: (ClassFile -> ClassFile) -> ClassBuilder m ()
    GetClass :: ClassBuilder m ClassFile

makeEffect ''ClassBuilder

addAccessFlag :: (ClassBuilder :> r) => ClassAccessFlag -> Eff r ()
addAccessFlag :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
ClassAccessFlag -> Eff r ()
addAccessFlag ClassAccessFlag
flag = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{accessFlags = flag : c.accessFlags})

setName :: (ClassBuilder :> r) => QualifiedClassName -> Eff r ()
setName :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
QualifiedClassName -> Eff r ()
setName QualifiedClassName
n = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{name = n})

getName :: (ClassBuilder :> r) => Eff r QualifiedClassName
getName :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
Eff r QualifiedClassName
getName = (.name) (ClassFile -> QualifiedClassName)
-> Eff r ClassFile -> Eff r QualifiedClassName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff r ClassFile
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
Eff es ClassFile
getClass

setVersion :: (ClassBuilder :> r) => JVMVersion -> Eff r ()
setVersion :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
JVMVersion -> Eff r ()
setVersion JVMVersion
v = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{version = v})

setSuperClass :: (ClassBuilder :> r) => QualifiedClassName -> Eff r ()
setSuperClass :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
QualifiedClassName -> Eff r ()
setSuperClass QualifiedClassName
s = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{superClass = Just s})

addInterface :: (ClassBuilder :> r) => QualifiedClassName -> Eff r ()
addInterface :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
QualifiedClassName -> Eff r ()
addInterface QualifiedClassName
i = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{interfaces = i : c.interfaces})

addField :: (ClassBuilder :> r) => ClassFileField -> Eff r ()
addField :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
ClassFileField -> Eff r ()
addField ClassFileField
f = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{fields = f : c.fields})

addMethod :: (ClassBuilder :> r) => ClassFileMethod -> Eff r ()
addMethod :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
ClassFileMethod -> Eff r ()
addMethod ClassFileMethod
m = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{methods = m : c.methods})

addAttribute :: (ClassBuilder :> r) => ClassFileAttribute -> Eff r ()
addAttribute :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
ClassFileAttribute -> Eff r ()
addAttribute ClassFileAttribute
a = (ClassFile -> ClassFile) -> Eff r ()
forall {k} (es :: [Effect]).
(HasCallStack, ClassBuilder :> es) =>
(ClassFile -> ClassFile) -> Eff es ()
modifyClass (\ClassFile
c -> ClassFile
c{attributes = c.attributes `TML.snoc` a})

addBootstrapMethod :: (ClassBuilder :> r) => BootstrapMethod -> Eff r ()
addBootstrapMethod :: forall (r :: [Effect]).
(ClassBuilder :> r) =>
BootstrapMethod -> Eff r ()
addBootstrapMethod BootstrapMethod
b = ClassFileAttribute -> Eff r ()
forall (r :: [Effect]).
(ClassBuilder :> r) =>
ClassFileAttribute -> Eff r ()
addAttribute ([BootstrapMethod] -> ClassFileAttribute
BootstrapMethods [BootstrapMethod
b])

dummyClass :: QualifiedClassName -> JVMVersion -> ClassFile
dummyClass :: QualifiedClassName -> JVMVersion -> ClassFile
dummyClass QualifiedClassName
name JVMVersion
version =
    ClassFile
        { name :: QualifiedClassName
name = QualifiedClassName
name
        , version :: JVMVersion
version = JVMVersion
version
        , accessFlags :: [ClassAccessFlag]
accessFlags = []
        , superClass :: Maybe QualifiedClassName
superClass = Maybe QualifiedClassName
forall a. Maybe a
Nothing
        , interfaces :: [QualifiedClassName]
interfaces = []
        , fields :: [ClassFileField]
fields = []
        , methods :: [ClassFileMethod]
methods = []
        , attributes :: TypeMergingList ClassFileAttribute
attributes = TypeMergingList ClassFileAttribute
forall a. Monoid a => a
mempty
        }

classBuilderToState :: ((State ClassFile) :> r) => Eff (ClassBuilder ': r) a -> Eff r a
classBuilderToState :: forall (r :: [Effect]) a.
(State ClassFile :> r) =>
Eff (ClassBuilder : r) a -> Eff r a
classBuilderToState = EffectHandler ClassBuilder r -> Eff (ClassBuilder : r) a -> Eff r a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler ClassBuilder r
 -> Eff (ClassBuilder : r) a -> Eff r a)
-> EffectHandler ClassBuilder r
-> Eff (ClassBuilder : r) a
-> Eff r a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs r
_ -> \case
    ModifyClass ClassFile -> ClassFile
f -> (ClassFile -> ClassFile) -> Eff r ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
(s -> s) -> Eff es ()
modify ClassFile -> ClassFile
f
    ClassBuilder (Eff localEs) a
GetClass -> Eff r a
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
Eff es s
get

runClassBuilder :: QualifiedClassName -> JVMVersion -> Eff (ClassBuilder : r) a -> Eff r (ClassFile, a)
runClassBuilder :: forall (r :: [Effect]) a.
QualifiedClassName
-> JVMVersion -> Eff (ClassBuilder : r) a -> Eff r (ClassFile, a)
runClassBuilder QualifiedClassName
n JVMVersion
v =
    (Eff r (a, ClassFile) -> Eff r (ClassFile, a))
-> (Eff (ClassBuilder : r) a -> Eff r (a, ClassFile))
-> Eff (ClassBuilder : r) a
-> Eff r (ClassFile, a)
forall a b.
(a -> b)
-> (Eff (ClassBuilder : r) a -> a) -> Eff (ClassBuilder : r) a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (((a, ClassFile) -> (ClassFile, a))
-> Eff r (a, ClassFile) -> Eff r (ClassFile, a)
forall a b. (a -> b) -> Eff r a -> Eff r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ClassFile) -> (ClassFile, a)
forall a b. (a, b) -> (b, a)
swap)
        ( ClassFile -> Eff (State ClassFile : r) a -> Eff r (a, ClassFile)
forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState (QualifiedClassName -> JVMVersion -> ClassFile
dummyClass QualifiedClassName
n JVMVersion
v)
            (Eff (State ClassFile : r) a -> Eff r (a, ClassFile))
-> (Eff (ClassBuilder : r) a -> Eff (State ClassFile : r) a)
-> Eff (ClassBuilder : r) a
-> Eff r (a, ClassFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (ClassBuilder : State ClassFile : r) a
-> Eff (State ClassFile : r) a
forall (r :: [Effect]) a.
(State ClassFile :> r) =>
Eff (ClassBuilder : r) a -> Eff r a
classBuilderToState
            (Eff (ClassBuilder : State ClassFile : r) a
 -> Eff (State ClassFile : r) a)
-> (Eff (ClassBuilder : r) a
    -> Eff (ClassBuilder : State ClassFile : r) a)
-> Eff (ClassBuilder : r) a
-> Eff (State ClassFile : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (ClassBuilder : r) a
-> Eff (ClassBuilder : State ClassFile : r) a
forall (subEs :: [Effect]) (es :: [Effect]) a.
Subset subEs es =>
Eff subEs a -> Eff es a
inject
        )