{-# LANGUAGE LambdaCase #-}

-- | Conversion of access flags from the high level ADT to low level bitfield representations.
module H2JVM.Internal.Convert.AccessFlag (accessFlagsToWord16) where

import Data.Bits ((.|.))
import Data.Word (Word16)

import H2JVM.ClassFile.AccessFlags (ClassAccessFlag (..), FieldAccessFlag (..), MethodAccessFlag (..))
import H2JVM.Internal.Raw.AccessFlags (accessFlagValue)

import H2JVM.Internal.Raw.AccessFlags qualified as Raw

-- | A convertible access flag
class ConvertAccessFlag a where
    convertAccessFlag :: a -> Raw.AccessFlag

{- | Convert some list of access flags to a bitmask of their low level representations.
>>> accessFlagsToWord16 @ClassAccessFlag []
0
-}
accessFlagsToWord16 :: ConvertAccessFlag a => [a] -> Word16
accessFlagsToWord16 :: forall a. ConvertAccessFlag a => [a] -> Word16
accessFlagsToWord16 = (a -> Word16 -> Word16) -> Word16 -> [a] -> Word16
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
flag Word16
acc -> Word16
acc Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. AccessFlag -> Word16
accessFlagValue (a -> AccessFlag
forall a. ConvertAccessFlag a => a -> AccessFlag
convertAccessFlag a
flag)) Word16
0

instance ConvertAccessFlag ClassAccessFlag where
    convertAccessFlag :: ClassAccessFlag -> AccessFlag
convertAccessFlag = \case
        ClassAccessFlag
CPublic -> AccessFlag
Raw.ACC_PUBLIC
        ClassAccessFlag
CFinal -> AccessFlag
Raw.ACC_FINAL
        ClassAccessFlag
CSuper -> AccessFlag
Raw.ACC_SUPER
        ClassAccessFlag
CInterface -> AccessFlag
Raw.ACC_INTERFACE
        ClassAccessFlag
CAbstract -> AccessFlag
Raw.ACC_ABSTRACT
        ClassAccessFlag
CSynthetic -> AccessFlag
Raw.ACC_SYNTHETIC
        ClassAccessFlag
CAnnotation -> AccessFlag
Raw.ACC_ANNOTATION
        ClassAccessFlag
CEnum -> AccessFlag
Raw.ACC_ENUM

instance ConvertAccessFlag FieldAccessFlag where
    convertAccessFlag :: FieldAccessFlag -> AccessFlag
convertAccessFlag = \case
        FieldAccessFlag
FPublic -> AccessFlag
Raw.ACC_PUBLIC
        FieldAccessFlag
FPrivate -> AccessFlag
Raw.ACC_PRIVATE
        FieldAccessFlag
FProtected -> AccessFlag
Raw.ACC_PROTECTED
        FieldAccessFlag
FStatic -> AccessFlag
Raw.ACC_STATIC
        FieldAccessFlag
FFinal -> AccessFlag
Raw.ACC_FINAL
        FieldAccessFlag
FVolatile -> AccessFlag
Raw.ACC_VOLATILE
        FieldAccessFlag
FTransient -> AccessFlag
Raw.ACC_TRANSIENT
        FieldAccessFlag
FSynthetic -> AccessFlag
Raw.ACC_SYNTHETIC
        FieldAccessFlag
FEnum -> AccessFlag
Raw.ACC_ENUM

instance ConvertAccessFlag MethodAccessFlag where
    convertAccessFlag :: MethodAccessFlag -> AccessFlag
convertAccessFlag = \case
        MethodAccessFlag
MPublic -> AccessFlag
Raw.ACC_PUBLIC
        MethodAccessFlag
MPrivate -> AccessFlag
Raw.ACC_PRIVATE
        MethodAccessFlag
MProtected -> AccessFlag
Raw.ACC_PROTECTED
        MethodAccessFlag
MStatic -> AccessFlag
Raw.ACC_STATIC
        MethodAccessFlag
MFinal -> AccessFlag
Raw.ACC_FINAL
        MethodAccessFlag
MSynchronized -> AccessFlag
Raw.ACC_SYNCHRONIZED
        MethodAccessFlag
MBridge -> AccessFlag
Raw.ACC_BRIDGE
        MethodAccessFlag
MVarargs -> AccessFlag
Raw.ACC_VARARGS
        MethodAccessFlag
MNative -> AccessFlag
Raw.ACC_NATIVE
        MethodAccessFlag
MAbstract -> AccessFlag
Raw.ACC_ABSTRACT
        MethodAccessFlag
MStrict -> AccessFlag
Raw.ACC_STRICT
        MethodAccessFlag
MSynthetic -> AccessFlag
Raw.ACC_SYNTHETIC