Constant (..),
AccessFlag (..), AccessFlags,
Attributes (..),
+ defaultClass,
-- * Misc
HasSignature (..), HasAttributes (..),
NameType (..),
+ 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
deriving (Eq, Show, Ord, Enum)
-- | Fields and methods have signatures.
-class HasSignature a where
+class (Binary (Signature a), Show (Signature a), Eq (Signature a))
+ => HasSignature a where
type Signature a
instance HasSignature Field where
ntName :: B.ByteString,
ntSignature :: Signature a }
-instance Show (Signature a) => Show (NameType a) where
+instance (HasSignature a) => Show (NameType a) where
show (NameType n t) = toString n ++ ": " ++ show t
-deriving instance Eq (Signature a) => Eq (NameType a)
+deriving instance HasSignature a => Eq (NameType a)
-instance (Binary (Signature a)) => Binary (NameType a) where
+instance HasSignature a => Binary (NameType a) where
put (NameType n t) = putLazyByteString n >> put t
get = NameType <$> get <*> get
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