+instance Default (Attributes Direct) where
+ def = AR M.empty
+
+-- | Size of attributes set at Direct stage
+arsize :: Attributes Direct -> Int
+arsize (AR m) = M.size m
+
+-- | Associative list of attributes at Direct stage
+arlist :: Attributes Direct -> [(B.ByteString, B.ByteString)]
+arlist (AR m) = M.assocs m
+
+-- | Size of attributes set at File stage
+apsize :: Attributes File -> Int
+apsize (AP list) = length list
+
+-- | Access flags. Used for classess, methods, variables.
+data AccessFlag =
+ ACC_PUBLIC -- ^ 0x0001 Visible for all
+ | ACC_PRIVATE -- ^ 0x0002 Visible only for defined class
+ | ACC_PROTECTED -- ^ 0x0004 Visible only for subclasses
+ | ACC_STATIC -- ^ 0x0008 Static method or variable
+ | ACC_FINAL -- ^ 0x0010 No further subclassing or assignments
+ | ACC_SYNCHRONIZED -- ^ 0x0020 Uses monitors
+ | ACC_VOLATILE -- ^ 0x0040 Could not be cached
+ | ACC_TRANSIENT -- ^ 0x0080
+ | ACC_NATIVE -- ^ 0x0100 Implemented in other language
+ | ACC_INTERFACE -- ^ 0x0200 Class is interface
+ | ACC_ABSTRACT -- ^ 0x0400
+ deriving (Eq, Show, Ord, Enum)
+
+-- | Fields and methods have signatures.
+class (Binary (Signature a), Show (Signature a), Eq (Signature a))
+ => HasSignature a where
+ type Signature a
+
+instance HasSignature Field where
+ type Signature Field = FieldSignature
+
+instance HasSignature Method where
+ type Signature Method = MethodSignature
+
+-- | Name and signature pair. Used for methods and fields.
+data NameType a = NameType {
+ ntName :: B.ByteString,
+ ntSignature :: Signature a }
+
+instance (HasSignature a) => Show (NameType a) where
+ show (NameType n t) = toString n ++ ": " ++ show t
+
+deriving instance HasSignature a => Eq (NameType a)
+
+instance HasSignature a => Binary (NameType a) where
+ put (NameType n t) = putLazyByteString n >> put t
+
+ get = NameType <$> get <*> get
+
+-- | Constant pool item
+data Constant stage =
+ CClass (Link stage B.ByteString)
+ | CField (Link stage B.ByteString) (Link stage (NameType Field))
+ | CMethod (Link stage B.ByteString) (Link stage (NameType Method))
+ | CIfaceMethod (Link stage B.ByteString) (Link stage (NameType Method))
+ | CString (Link stage B.ByteString)
+ | CInteger Word32
+ | CFloat Float
+ | CLong Word64
+ | CDouble Double
+ | CNameType (Link stage B.ByteString) (Link stage B.ByteString)
+ | CUTF8 {getString :: B.ByteString}
+ | CUnicode {getString :: B.ByteString}
+
+-- | Name of the CClass. Error on any other constant.
+className :: Constant Direct -> B.ByteString
+className (CClass s) = s
+className x = error $ "Not a class: " ++ show x
+
+instance Show (Constant Direct) where
+ show (CClass name) = "class " ++ toString name
+ show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
+ show (CMethod cls nt) = "method " ++ toString cls ++ "." ++ show nt
+ show (CIfaceMethod cls nt) = "interface method " ++ toString cls ++ "." ++ show nt
+ show (CString s) = "String \"" ++ toString s ++ "\""
+ show (CInteger x) = show x
+ show (CFloat x) = show x
+ show (CLong x) = show x
+ show (CDouble x) = show x
+ show (CNameType name tp) = toString name ++ ": " ++ toString tp
+ show (CUTF8 s) = "UTF8 \"" ++ toString s ++ "\""
+ show (CUnicode s) = "Unicode \"" ++ toString s ++ "\""
+
+-- | Constant pool
+type Pool stage = M.Map Word16 (Constant stage)
+
+-- | Generic .class file format
+data Class stage = Class {
+ magic :: Word32, -- ^ Magic value: 0xCAFEBABE
+ minorVersion :: Word16,
+ majorVersion :: Word16,
+ constsPoolSize :: Word16, -- ^ Number of items in constants pool
+ constsPool :: Pool stage, -- ^ Constants pool itself
+ accessFlags :: AccessFlags stage, -- ^ See @JVM.Types.AccessFlag@
+ thisClass :: Link stage B.ByteString, -- ^ Constants pool item index for this class
+ superClass :: Link stage B.ByteString, -- ^ --/-- for super class, zero for java.lang.Object
+ interfacesCount :: Word16, -- ^ Number of implemented interfaces
+ interfaces :: [Link stage B.ByteString], -- ^ Constants pool item indexes for implemented interfaces
+ classFieldsCount :: Word16, -- ^ Number of class fileds
+ classFields :: [Field stage], -- ^ Class fields
+ classMethodsCount :: Word16, -- ^ Number of class methods
+ classMethods :: [Method stage], -- ^ Class methods
+ classAttributesCount :: Word16, -- ^ Number of class attributes
+ classAttributes :: Attributes stage -- ^ Class attributes
+ }
+
+deriving instance Eq (Class File)
+deriving instance Eq (Class Direct)
+deriving instance Show (Class File)
+deriving instance Show (Class Direct)
+
+deriving instance Eq (Constant File)
+deriving instance Eq (Constant Direct)
+deriving instance Show (Constant File)
+
+-- | Default (empty) class file definition.
+defaultClass :: (Default (AccessFlags stage), Default (Link stage B.ByteString), Default (Attributes stage))
+ => Class stage
+defaultClass = Class {
+ magic = 0xCAFEBABE,
+ minorVersion = 0,
+ majorVersion = 50,
+ constsPoolSize = 0,
+ constsPool = def,
+ accessFlags = def,
+ thisClass = def,
+ superClass = def,
+ interfacesCount = 0,
+ interfaces = [],
+ classFieldsCount = 0,
+ classFields = [],
+ classMethodsCount = 0,
+ classMethods = [],
+ classAttributesCount = 0,
+ classAttributes = def }
+
+instance Binary (Class File) where
+ put (Class {..}) = do