| Copyright | (c) Christian Gram Kalhauge 2018 |
|---|---|
| License | MIT |
| Maintainer | kalhuage@cs.ucla.edu |
| Safe Haskell | None |
| Language | Haskell2010 |
Language.JVM.Type
Description
This module contains the JType, ClassName, MethodDescriptor, and
FieldDescriptor.
Synopsis
- data ClassName
- textCls :: Text -> Either String ClassName
- textClsOrFail :: Text -> ClassName
- strClsOrFail :: String -> ClassName
- dotCls :: Text -> Either String ClassName
- unsafeTextCls :: Text -> ClassName
- parseClassName :: Parser ClassName
- serializeClassName :: ClassName -> Builder
- data JType
- jTypeSize :: JType -> Int
- parseJType :: Parser JType
- serializeJType :: JType -> Builder
- data JBaseType
- jBaseTypeToChar :: JBaseType -> Char
- jBaseTypeSize :: JBaseType -> Int
- parseJBaseType :: Parser JBaseType
- serializeJBaseType :: JBaseType -> Builder
- data JRefType
- refTypeDepth :: JRefType -> Int
- parseJRefType :: Parser JRefType
- serializeJRefType :: JRefType -> Builder
- parseFlatJRefType :: Parser JRefType
- serializeFlatJRefType :: JRefType -> Builder
- data MethodDescriptor = MethodDescriptor {}
- parseMethodDescriptor :: Parser MethodDescriptor
- serializeMethodDescriptor :: MethodDescriptor -> Builder
- newtype ReturnDescriptor = ReturnDescriptor {}
- parseReturnDescriptor :: Parser ReturnDescriptor
- serializeReturnDescriptor :: ReturnDescriptor -> Builder
- newtype FieldDescriptor = FieldDescriptor {}
- parseFieldDescriptor :: Parser FieldDescriptor
- serializeFieldDescriptor :: FieldDescriptor -> Builder
- data NameAndType a = NameAndType !Text !a
- parseNameAndType :: Parser a -> Parser (NameAndType a)
- serializeNameAndType :: (a -> Builder) -> NameAndType a -> Builder
- class WithName n where
- type WithNameId n
- (<:>) :: Text -> n -> WithNameId n
- class AsNameAndType n where
- type TypeDescriptor n
- toNameAndType :: n -> NameAndType (TypeDescriptor n)
- ntDescriptor :: n -> TypeDescriptor n
- ntName :: n -> Text
- newtype MethodId = MethodId {}
- parseMethodId :: Parser MethodId
- serializeMethodId :: MethodId -> Builder
- newtype FieldId = FieldId {}
- parseFieldId :: Parser FieldId
- serializeFieldId :: FieldId -> Builder
- data InClass a = InClass {
- inClassName :: !ClassName
- inClassId :: !a
- parseInClass :: Parser a -> Parser (InClass a)
- serializeInClass :: (a -> Builder) -> InClass a -> Builder
- data InRefType a = InRefType {
- inRefType :: !JRefType
- inRefTypeId :: !a
- parseInRefType :: Parser a -> Parser (InRefType a)
- serializeInRefType :: (a -> Builder) -> InRefType a -> Builder
- inRefTypeAsInClass :: InRefType a -> InClass a
- newtype AbsMethodId = AbsMethodId {}
- parseAbsMethodId :: Parser AbsMethodId
- serializeAbsMethodId :: AbsMethodId -> Builder
- newtype AbsFieldId = AbsFieldId {}
- parseAbsFieldId :: Parser AbsFieldId
- serializeAbsFieldId :: AbsFieldId -> Builder
- module Language.JVM.TextSerializable
Base types
ClassName
A class name
Instances
| Eq ClassName Source # | |
| Ord ClassName Source # | |
| Show ClassName Source # | |
| IsString ClassName Source # | |
Defined in Language.JVM.Type Methods fromString :: String -> ClassName # | |
| Generic ClassName Source # | |
| NFData ClassName Source # | |
Defined in Language.JVM.Type | |
| TextSerializable ClassName Source # | |
| Referenceable ClassName Source # | |
| type Rep ClassName Source # | |
Defined in Language.JVM.Type | |
textClsOrFail :: Text -> ClassName Source #
Parses a ClassName from String, might fail with an exception. *warning* Unpure.
strClsOrFail :: String -> ClassName Source #
Parses a ClassName from String, might fail with an exception. *warning* Unpure.
dotCls :: Text -> Either String ClassName Source #
Takes the dot representation and converts it into a class.
unsafeTextCls :: Text -> ClassName Source #
Converts a text directly into a ClassName, will fail silently and might corrupt data.
parseClassName :: Parser ClassName Source #
Parse a ClassName, should not be any of '.;[<>:',
>>>deserialize parseClassName "java/lang/Object"Right "java/lang/Object"
>>>deserialize parseClassName "java;"Left "endOfInput"
serializeClassName :: ClassName -> Builder Source #
Display a ClassName
JType
A JType is either a simple type or a Reftype
Instances
| Eq JType Source # | |
| Ord JType Source # | |
| Show JType Source # | |
| IsString JType Source # | |
Defined in Language.JVM.Type Methods fromString :: String -> JType # | |
| Generic JType Source # | |
| NFData JType Source # | |
Defined in Language.JVM.Type | |
| TextSerializable JType Source # | |
| type Rep JType Source # | |
Defined in Language.JVM.Type type Rep JType = D1 ('MetaData "JType" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'False) (C1 ('MetaCons "JTBase" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 JBaseType)) :+: C1 ('MetaCons "JTRef" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 JRefType))) | |
parseJType :: Parser JType Source #
Parse a JType
The Jvm Primitive Types
Instances
| Eq JBaseType Source # | |
| Ord JBaseType Source # | |
| Show JBaseType Source # | |
| IsString JBaseType Source # | |
Defined in Language.JVM.Type Methods fromString :: String -> JBaseType # | |
| Generic JBaseType Source # | |
| NFData JBaseType Source # | |
Defined in Language.JVM.Type | |
| TextSerializable JBaseType Source # | |
| type Rep JBaseType Source # | |
Defined in Language.JVM.Type type Rep JBaseType = D1 ('MetaData "JBaseType" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'False) (((C1 ('MetaCons "JTByte" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "JTChar" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "JTDouble" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "JTFloat" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "JTInt" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "JTLong" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "JTShort" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "JTBoolean" 'PrefixI 'False) (U1 :: Type -> Type)))) | |
jBaseTypeSize :: JBaseType -> Int Source #
Doubles and Longs have size two in the stack.
parseJBaseType :: Parser JBaseType Source #
Parse a JBaseType
serializeJBaseType :: JBaseType -> Builder Source #
Serializes JBaseType
A JRefType is a Class or an Array.
Instances
| Eq JRefType Source # | |
| Ord JRefType Source # | |
Defined in Language.JVM.Type | |
| Show JRefType Source # | |
| IsString JRefType Source # | |
Defined in Language.JVM.Type Methods fromString :: String -> JRefType # | |
| Generic JRefType Source # | |
| NFData JRefType Source # | |
Defined in Language.JVM.Type | |
| TextSerializable JRefType Source # | |
| Referenceable JRefType Source # | |
| type Rep JRefType Source # | |
Defined in Language.JVM.Type type Rep JRefType = D1 ('MetaData "JRefType" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'False) (C1 ('MetaCons "JTClass" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ClassName)) :+: C1 ('MetaCons "JTArray" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 JType))) | |
refTypeDepth :: JRefType -> Int Source #
The number of nested arrays
serializeJRefType :: JRefType -> Builder Source #
parseFlatJRefType :: Parser JRefType Source #
Parses a JRefType but does not require an L infront of
the class name, and ';'
>>> deserialize parseFlatJRefType "javalangObject"
Right "LjavalangObject;"
>>> deserialize parseFlatJRefType "[I"
Right "[I"
MethodDescriptor
data MethodDescriptor Source #
Method Descriptor
Constructors
| MethodDescriptor | |
Fields | |
Instances
parseMethodDescriptor :: Parser MethodDescriptor Source #
A MethodDescriptor is just a list of types
>>>deserialize parseMethodDescriptor "(II)V"Right "(II)V"
newtype ReturnDescriptor Source #
A ReturnDescriptor is maybe a type, otherwise it is void. https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.3.3
Constructors
| ReturnDescriptor | |
Fields | |
Instances
parseReturnDescriptor :: Parser ReturnDescriptor Source #
A ReturnDescriptor is either A JType or A void V annotaiton:
>>>deserialize parseReturnDescriptor "V"Right Nothing
>>>parseTest parseReturnDescriptor "[I"Right (Just "[I")
FieldDescriptor
newtype FieldDescriptor Source #
Field Descriptor
Constructors
| FieldDescriptor | |
Fields | |
Instances
parseFieldDescriptor :: Parser FieldDescriptor Source #
A FieldDescriptor is just a JType
>>>deserialize parseMethodDescriptor "I"Right "I"
NameAndType
data NameAndType a Source #
A name and a type
Constructors
| NameAndType !Text !a |
Instances
parseNameAndType :: Parser a -> Parser (NameAndType a) Source #
A FieldDescriptor is just a JType
>>>deserialize (parseNameAndType parseMethodDescriptor) "method:(I)V"Right "method:(I)V"
serializeNameAndType :: (a -> Builder) -> NameAndType a -> Builder Source #
class WithName n where Source #
Associated Types
type WithNameId n Source #
Methods
(<:>) :: Text -> n -> WithNameId n Source #
Instances
| WithName FieldDescriptor Source # | |
Defined in Language.JVM.Type Associated Types type WithNameId FieldDescriptor Source # Methods (<:>) :: Text -> FieldDescriptor -> WithNameId FieldDescriptor Source # | |
| WithName MethodDescriptor Source # | |
Defined in Language.JVM.Type Associated Types Methods (<:>) :: Text -> MethodDescriptor -> WithNameId MethodDescriptor Source # | |
class AsNameAndType n where Source #
Minimal complete definition
Associated Types
type TypeDescriptor n Source #
Methods
toNameAndType :: n -> NameAndType (TypeDescriptor n) Source #
ntDescriptor :: n -> TypeDescriptor n Source #
Instances
| AsNameAndType MethodId Source # | |
Defined in Language.JVM.Type Associated Types type TypeDescriptor MethodId Source # Methods toNameAndType :: MethodId -> NameAndType (TypeDescriptor MethodId) Source # ntDescriptor :: MethodId -> TypeDescriptor MethodId Source # | |
| AsNameAndType FieldId Source # | |
Defined in Language.JVM.Type Associated Types type TypeDescriptor FieldId Source # Methods toNameAndType :: FieldId -> NameAndType (TypeDescriptor FieldId) Source # | |
| AsNameAndType (NameAndType a) Source # | |
Defined in Language.JVM.Type Associated Types type TypeDescriptor (NameAndType a) Source # Methods toNameAndType :: NameAndType a -> NameAndType (TypeDescriptor (NameAndType a)) Source # ntDescriptor :: NameAndType a -> TypeDescriptor (NameAndType a) Source # ntName :: NameAndType a -> Text Source # | |
MethodId
A MethodId
Constructors
| MethodId | |
Instances
serializeMethodId :: MethodId -> Builder Source #
FieldId
A FieldId
Constructors
| FieldId | |
Instances
| Eq FieldId Source # | |
| Ord FieldId Source # | |
| Show FieldId Source # | |
| IsString FieldId Source # | |
Defined in Language.JVM.Type Methods fromString :: String -> FieldId # | |
| Generic FieldId Source # | |
| NFData FieldId Source # | |
Defined in Language.JVM.Type | |
| TextSerializable FieldId Source # | |
| AsNameAndType FieldId Source # | |
Defined in Language.JVM.Type Associated Types type TypeDescriptor FieldId Source # Methods toNameAndType :: FieldId -> NameAndType (TypeDescriptor FieldId) Source # | |
| Referenceable FieldId Source # | |
| type Rep FieldId Source # | |
Defined in Language.JVM.Type type Rep FieldId = D1 ('MetaData "FieldId" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'True) (C1 ('MetaCons "FieldId" 'PrefixI 'True) (S1 ('MetaSel ('Just "fieldIdAsNameAndType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NameAndType FieldDescriptor)))) | |
| type TypeDescriptor FieldId Source # | |
Defined in Language.JVM.Type | |
serializeFieldId :: FieldId -> Builder Source #
InClass
A method or Field in a Class
Constructors
| InClass | |
Fields
| |
Instances
| Eq a => Eq (InClass a) Source # | |
| Ord a => Ord (InClass a) Source # | |
| Show a => Show (InClass a) Source # | |
| Generic (InClass a) Source # | |
| NFData a => NFData (InClass a) Source # | |
Defined in Language.JVM.Type | |
| type Rep (InClass a) Source # | |
Defined in Language.JVM.Type type Rep (InClass a) = D1 ('MetaData "InClass" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'False) (C1 ('MetaCons "InClass" 'PrefixI 'True) (S1 ('MetaSel ('Just "inClassName") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ClassName) :*: S1 ('MetaSel ('Just "inClassId") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a))) | |
InRefType
A method or Field in a Class
Constructors
| InRefType | |
Fields
| |
Instances
| Eq a => Eq (InRefType a) Source # | |
| Ord a => Ord (InRefType a) Source # | |
Defined in Language.JVM.Type | |
| Show a => Show (InRefType a) Source # | |
| Generic (InRefType a) Source # | |
| NFData a => NFData (InRefType a) Source # | |
Defined in Language.JVM.Type | |
| Referenceable (InRefType MethodId) Source # | |
| type Rep (InRefType a) Source # | |
Defined in Language.JVM.Type type Rep (InRefType a) = D1 ('MetaData "InRefType" "Language.JVM.Type" "jvm-binary-0.10.0-6UZh5809b0fJPIjalFrBq2" 'False) (C1 ('MetaCons "InRefType" 'PrefixI 'True) (S1 ('MetaSel ('Just "inRefType") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 JRefType) :*: S1 ('MetaSel ('Just "inRefTypeId") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a))) | |
inRefTypeAsInClass :: InRefType a -> InClass a Source #
Convert a InRefType to a InClass by casting all arrays to classes.
AbsMethodId
newtype AbsMethodId Source #
A MethodId
Constructors
| AbsMethodId | |
Fields | |
Instances
AbsFieldId
newtype AbsFieldId Source #
A FieldId
Constructors
| AbsFieldId | |
Fields | |