{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}

module H2JVM.Internal.Raw.ConstantPool (ConstantPoolInfo (..)) where

import Data.Binary
import Data.Binary.Put
import Data.ByteString
import Witch (unsafeInto)

import Data.ByteString qualified as BS

import H2JVM.Internal.Binary.Write (WriteBinary (writeBinary))
import H2JVM.Internal.Raw.Types

import H2JVM.Internal.Raw.MagicNumbers qualified as MagicNumbers

data ConstantPoolInfo
    = -- | https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.1
      ClassInfo {ConstantPoolInfo -> U2
nameIndex :: U2}
    | FieldRefInfo {ConstantPoolInfo -> U2
classIndex :: U2, ConstantPoolInfo -> U2
nameAndTypeIndex :: U2}
    | MethodRefInfo {classIndex :: U2, nameAndTypeIndex :: U2}
    | InterfaceMethodRefInfo {classIndex :: U2, nameAndTypeIndex :: U2}
    | StringInfo {ConstantPoolInfo -> U2
stringIndex :: U2}
    | IntegerInfo {ConstantPoolInfo -> U4
bytes :: U4}
    | FloatInfo {bytes :: U4}
    | LongInfo {ConstantPoolInfo -> U4
highBytes :: U4, ConstantPoolInfo -> U4
lowBytes :: U4}
    | DoubleInfo {highBytes :: U4, lowBytes :: U4}
    | NameAndTypeInfo {nameIndex :: U2, ConstantPoolInfo -> U2
descriptorIndex :: U2}
    | UTF8Info {ConstantPoolInfo -> ByteString
utfBytes :: ByteString}
    | MethodHandleInfo {ConstantPoolInfo -> U1
referenceKind :: U1, ConstantPoolInfo -> U2
referenceIndex :: U2}
    | MethodTypeInfo {descriptorIndex :: U2}
    | InvokeDynamicInfo {ConstantPoolInfo -> U2
bootstrapMethodAttrIndex :: U2, nameAndTypeIndex :: U2}
    deriving (ConstantPoolInfo -> ConstantPoolInfo -> Bool
(ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> (ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> Eq ConstantPoolInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
== :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
$c/= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
/= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
Eq, Eq ConstantPoolInfo
Eq ConstantPoolInfo =>
(ConstantPoolInfo -> ConstantPoolInfo -> Ordering)
-> (ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> (ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> (ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> (ConstantPoolInfo -> ConstantPoolInfo -> Bool)
-> (ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo)
-> (ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo)
-> Ord ConstantPoolInfo
ConstantPoolInfo -> ConstantPoolInfo -> Bool
ConstantPoolInfo -> ConstantPoolInfo -> Ordering
ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConstantPoolInfo -> ConstantPoolInfo -> Ordering
compare :: ConstantPoolInfo -> ConstantPoolInfo -> Ordering
$c< :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
< :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
$c<= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
<= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
$c> :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
> :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
$c>= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
>= :: ConstantPoolInfo -> ConstantPoolInfo -> Bool
$cmax :: ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo
max :: ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo
$cmin :: ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo
min :: ConstantPoolInfo -> ConstantPoolInfo -> ConstantPoolInfo
Ord, Int -> ConstantPoolInfo -> ShowS
[ConstantPoolInfo] -> ShowS
ConstantPoolInfo -> String
(Int -> ConstantPoolInfo -> ShowS)
-> (ConstantPoolInfo -> String)
-> ([ConstantPoolInfo] -> ShowS)
-> Show ConstantPoolInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstantPoolInfo -> ShowS
showsPrec :: Int -> ConstantPoolInfo -> ShowS
$cshow :: ConstantPoolInfo -> String
show :: ConstantPoolInfo -> String
$cshowList :: [ConstantPoolInfo] -> ShowS
showList :: [ConstantPoolInfo] -> ShowS
Show)

instance WriteBinary ConstantPoolInfo where
    writeBinary :: ConstantPoolInfo -> Put
writeBinary (ClassInfo{U2
nameIndex :: ConstantPoolInfo -> U2
nameIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Class
        U2 -> Put
putWord16be U2
nameIndex
    writeBinary (FieldRefInfo{U2
classIndex :: ConstantPoolInfo -> U2
nameAndTypeIndex :: ConstantPoolInfo -> U2
classIndex :: U2
nameAndTypeIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Fieldref
        U2 -> Put
putWord16be U2
classIndex
        U2 -> Put
putWord16be U2
nameAndTypeIndex
    writeBinary (MethodRefInfo{U2
classIndex :: ConstantPoolInfo -> U2
nameAndTypeIndex :: ConstantPoolInfo -> U2
classIndex :: U2
nameAndTypeIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Methodref
        U2 -> Put
putWord16be U2
classIndex
        U2 -> Put
putWord16be U2
nameAndTypeIndex
    writeBinary (InterfaceMethodRefInfo{U2
classIndex :: ConstantPoolInfo -> U2
nameAndTypeIndex :: ConstantPoolInfo -> U2
classIndex :: U2
nameAndTypeIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_InterfaceMethodref
        U2 -> Put
putWord16be U2
classIndex
        U2 -> Put
putWord16be U2
nameAndTypeIndex
    writeBinary (StringInfo{U2
stringIndex :: ConstantPoolInfo -> U2
stringIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_String
        U2 -> Put
putWord16be U2
stringIndex
    writeBinary (IntegerInfo{U4
bytes :: ConstantPoolInfo -> U4
bytes :: U4
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Integer
        U4 -> Put
putWord32be U4
bytes
    writeBinary (FloatInfo{U4
bytes :: ConstantPoolInfo -> U4
bytes :: U4
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Float
        U4 -> Put
putWord32be U4
bytes
    writeBinary (LongInfo{U4
highBytes :: ConstantPoolInfo -> U4
lowBytes :: ConstantPoolInfo -> U4
highBytes :: U4
lowBytes :: U4
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Long
        U4 -> Put
putWord32be U4
highBytes
        U4 -> Put
putWord32be U4
lowBytes
    writeBinary (DoubleInfo{U4
highBytes :: ConstantPoolInfo -> U4
lowBytes :: ConstantPoolInfo -> U4
highBytes :: U4
lowBytes :: U4
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Double
        U4 -> Put
putWord32be U4
highBytes
        U4 -> Put
putWord32be U4
lowBytes
    writeBinary (NameAndTypeInfo{U2
nameIndex :: ConstantPoolInfo -> U2
descriptorIndex :: ConstantPoolInfo -> U2
nameIndex :: U2
descriptorIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_NameAndType
        U2 -> Put
putWord16be U2
nameIndex
        U2 -> Put
putWord16be U2
descriptorIndex
    writeBinary (UTF8Info{ByteString
utfBytes :: ConstantPoolInfo -> ByteString
utfBytes :: ByteString
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_Utf8
        U2 -> Put
putWord16be (Int -> U2
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> U2) -> Int -> U2
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
utfBytes)
        ByteString -> Put
putByteString ByteString
utfBytes
    writeBinary (MethodHandleInfo{U1
U2
referenceKind :: ConstantPoolInfo -> U1
referenceIndex :: ConstantPoolInfo -> U2
referenceKind :: U1
referenceIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_MethodHandle
        U1 -> Put
putWord8 U1
referenceKind
        U2 -> Put
putWord16be U2
referenceIndex
    writeBinary (MethodTypeInfo{U2
descriptorIndex :: ConstantPoolInfo -> U2
descriptorIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_MethodType
        U2 -> Put
putWord16be U2
descriptorIndex
    writeBinary (InvokeDynamicInfo{U2
nameAndTypeIndex :: ConstantPoolInfo -> U2
bootstrapMethodAttrIndex :: ConstantPoolInfo -> U2
bootstrapMethodAttrIndex :: U2
nameAndTypeIndex :: U2
..}) = do
        U1 -> Put
putWord8 U1
MagicNumbers.constant_InvokeDynamic
        U2 -> Put
putWord16be U2
bootstrapMethodAttrIndex
        U2 -> Put
putWord16be U2
nameAndTypeIndex