Constant (..),
AccessFlag (..), AccessFlags,
Attributes (..),
+ defaultClass,
-- * Misc
HasSignature (..), HasAttributes (..),
NameType (..),
+ fieldNameType, methodNameType,
+ toString,
className,
apsize, arsize, arlist
)
import Data.Binary.Put
import Data.Char
import Data.List
+import Data.Default
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
data instance Attributes File = AP {attributesList :: [Attribute]}
deriving (Eq, Show)
+instance Default (Attributes File) where
+ def = AP []
+
-- | At Direct stage, attributes are represented as a Map.
data instance Attributes Direct = AR (M.Map B.ByteString B.ByteString)
deriving (Eq, Show)
+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
-- | Constant pool item
data Constant stage =
CClass (Link stage B.ByteString)
- | CField {refClass :: Link stage B.ByteString, fieldNameType :: Link stage (NameType Field)}
- | CMethod {refClass :: Link stage B.ByteString, nameType :: Link stage (NameType Method)}
- | CIfaceMethod {refClass :: Link stage B.ByteString, nameType :: Link stage (NameType Method)}
+ | 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
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
put magic
deriving instance Show (Field File)
deriving instance Show (Field Direct)
+fieldNameType :: Field Direct -> NameType Field
+fieldNameType f = NameType (fieldName f) (fieldSignature f)
+
instance Binary (Field File) where
put (Field {..}) = do
put fieldAccessFlags
deriving instance Show (Method File)
deriving instance Show (Method Direct)
+methodNameType :: Method Direct -> NameType Method
+methodNameType m = NameType (methodName m) (methodSignature m)
+
instance Binary (Method File) where
put (Method {..}) = do
put methodAccessFlags