{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | Conversion of fields to the raw, low level format.
module H2JVM.Internal.Convert.Field (convertField) where

import Data.Word (Word16)
import Effectful
import Witch

import Data.Vector qualified as V

import H2JVM.ConstantPool (ConstantPoolEntry (..))
import H2JVM.Internal.Convert.AccessFlag (accessFlagsToWord16)
import H2JVM.Internal.Convert.ConstantPool
import H2JVM.Internal.Convert.Monad
import H2JVM.Internal.Convert.Type (fieldTypeDescriptor)

import H2JVM.ClassFile.Field qualified as Abs
import H2JVM.Internal.Raw.ClassFile qualified as Raw

-- | Convert a 'Abs.ConstantValue' to an index within the constant pool.
convertConstantValue :: ConvertEff r => Abs.ConstantValue -> Eff r Word16
convertConstantValue :: forall (r :: [Effect]).
ConvertEff r =>
ConstantValue -> Eff r Word16
convertConstantValue =
    (Word16 -> Word16) -> Eff r Word16 -> Eff r Word16
forall a b. (a -> b) -> Eff r a -> Eff r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word16
forall target source. From source target => source -> target
into (Eff r Word16 -> Eff r Word16)
-> (ConstantValue -> Eff r Word16) -> ConstantValue -> Eff r Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstantPoolEntry -> Eff r Word16
forall (r :: [Effect]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r Word16
findIndexOf (ConstantPoolEntry -> Eff r Word16)
-> (ConstantValue -> ConstantPoolEntry)
-> ConstantValue
-> Eff r Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Abs.ConstantInteger JVMInt
i -> JVMInt -> ConstantPoolEntry
CPIntegerEntry (JVMInt -> JVMInt
forall target source. From source target => source -> target
into JVMInt
i)
        Abs.ConstantFloat JVMFloat
f -> JVMFloat -> ConstantPoolEntry
CPFloatEntry JVMFloat
f
        Abs.ConstantLong JVMLong
l -> JVMLong -> ConstantPoolEntry
CPLongEntry (JVMLong -> JVMLong
forall target source. From source target => source -> target
into JVMLong
l)
        Abs.ConstantDouble JVMDouble
d -> JVMDouble -> ConstantPoolEntry
CPDoubleEntry JVMDouble
d
        Abs.ConstantString JVMString
s -> JVMString -> ConstantPoolEntry
CPStringEntry JVMString
s

-- | Convert a 'Abs.FieldAttribute' to a raw attribute info by upserting its components into the constant pool.
convertFieldAttribute :: ConvertEff r => Abs.FieldAttribute -> Eff r Raw.AttributeInfo
convertFieldAttribute :: forall (r :: [Effect]).
ConvertEff r =>
FieldAttribute -> Eff r AttributeInfo
convertFieldAttribute (Abs.ConstantValue ConstantValue
constantValue) = do
    nameIndex <- ConstantPoolEntry -> Eff r Word16
forall (r :: [Effect]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r Word16
findIndexOf (JVMString -> ConstantPoolEntry
CPUTF8Entry JVMString
"ConstantValue")
    constantValueIndex <- convertConstantValue constantValue
    pure $ Raw.AttributeInfo (into nameIndex) (Raw.ConstantValueAttribute constantValueIndex)
convertFieldAttribute FieldAttribute
Abs.Synthetic = do
    nameIndex <- ConstantPoolEntry -> Eff r Word16
forall (r :: [Effect]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r Word16
findIndexOf (JVMString -> ConstantPoolEntry
CPUTF8Entry JVMString
"Synthetic")
    pure $ Raw.AttributeInfo (into nameIndex) Raw.SyntheticAttribute

-- | Convert a 'Abs.ClassFileField' to a 'Raw.FieldInfo' by upserting all its attributes into the constant poo..
convertField :: ConvertEff r => Abs.ClassFileField -> Eff r Raw.FieldInfo
convertField :: forall (r :: [Effect]).
ConvertEff r =>
ClassFileField -> Eff r FieldInfo
convertField Abs.ClassFileField{[FieldAccessFlag]
[FieldAttribute]
JVMString
FieldType
fieldAccessFlags :: [FieldAccessFlag]
fieldName :: JVMString
fieldType :: FieldType
fieldAttributes :: [FieldAttribute]
fieldAttributes :: ClassFileField -> [FieldAttribute]
fieldType :: ClassFileField -> FieldType
fieldName :: ClassFileField -> JVMString
fieldAccessFlags :: ClassFileField -> [FieldAccessFlag]
..} = do
    nameIndex <- ConstantPoolEntry -> Eff r Word16
forall (r :: [Effect]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r Word16
findIndexOf (JVMString -> ConstantPoolEntry
CPUTF8Entry JVMString
fieldName)
    descriptorIndex <- findIndexOf (CPUTF8Entry (fieldTypeDescriptor fieldType))
    attributes <- traverse convertFieldAttribute fieldAttributes
    pure $ Raw.FieldInfo (accessFlagsToWord16 fieldAccessFlags) (into nameIndex) (into descriptorIndex) (V.fromList attributes)