29 lines
1.2 KiB
Haskell
29 lines
1.2 KiB
Haskell
-- | Interface List.
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DerivingVia #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# LANGUAGE StandaloneKindSignatures #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
module Language.Java.Classfile.Interfaces (Interfaces(..)) where
|
|
import Data.Array.IArray (Array)
|
|
import Data.Word (Word16)
|
|
import Language.Java.Classfile.ConstantPool.References (Class)
|
|
import Language.Java.Classfile.Extractable (Extractable)
|
|
import GHC.Generics ( Generic, Generically, Generically(..) )
|
|
import Pretty.Serialize (PrettySerialize)
|
|
import Language.Java.Classfile.Stage (Stage)
|
|
import Data.Kind (Type)
|
|
import Data.Typeable (Typeable)
|
|
|
|
-- | A list of classes something implements.
|
|
|
|
type Interfaces :: Stage -> Type
|
|
newtype Interfaces stage = Interfaces (Array Word16 (Class stage))
|
|
deriving stock (Generic)
|
|
|
|
deriving stock instance (Show (Class stage)) => Show (Interfaces stage)
|
|
deriving via Generically (Interfaces stage) instance (Extractable (Class stage), Typeable stage) => Extractable (Interfaces stage)
|
|
deriving via Generically (Interfaces stage) instance (PrettySerialize (Class stage), Typeable stage) => PrettySerialize (Interfaces stage)
|