diff --git a/java-classfile.cabal b/java-classfile.cabal index 5944842..222313e 100644 --- a/java-classfile.cabal +++ b/java-classfile.cabal @@ -29,7 +29,6 @@ library Data.Hex Language.Java.Classfile Language.Java.Classfile.Attributes - Language.Java.Classfile.ClassFlag Language.Java.Classfile.ConstantPool Language.Java.Classfile.ConstantPool.Entry Language.Java.Classfile.ConstantPool.References @@ -39,7 +38,6 @@ library Language.Java.Classfile.Extractable.SizedBytes Language.Java.Classfile.Extractable.WithTag Language.Java.Classfile.Fields - Language.Java.Classfile.Flag Language.Java.Classfile.Flags Language.Java.Classfile.FromBigEndian Language.Java.Classfile.Interfaces diff --git a/src/Data/Enum/Util.hs b/src/Data/Enum/Util.hs index eaf8c1e..ab15349 100644 --- a/src/Data/Enum/Util.hs +++ b/src/Data/Enum/Util.hs @@ -1,5 +1,9 @@ +-- | Functions that operate on 'Enum' + module Data.Enum.Util (enumerate) where +-- | Get all the values of an enum. This is a possibly unbounded list. + enumerate :: Bounded a => Enum a => [a] enumerate = [minBound..maxBound] diff --git a/src/Data/Hex.hs b/src/Data/Hex.hs index 187ad3d..8f87f25 100644 --- a/src/Data/Hex.hs +++ b/src/Data/Hex.hs @@ -1,7 +1,11 @@ +-- | Wrapper type for Show instance. + {-# LANGUAGE InstanceSigs #-} module Data.Hex (Hex(..)) where import Numeric (showHex) +-- | Overrides the Show instance by using 'showHex' internally. The type Parameter must be an instance of 'Integral'. + newtype Hex a = Hex a instance Integral a => Show (Hex a) where diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 1c7a8b0..74251e6 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -1,3 +1,5 @@ +-- | Classfile module, it contains everything from the binary file representation. + {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneKindSignatures #-} @@ -7,6 +9,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE InstanceSigs #-} module Language.Java.Classfile (Classfile(..)) where import GHC.Generics (Generic, Generically(Generically)) @@ -18,15 +22,17 @@ import Language.Java.Classfile.Version (Version) import Language.Java.Classfile.Magic (Magic) import Language.Java.Classfile.Extractable (Extractable) import Language.Java.Classfile.ConstantPool (ConstantPool) -import Language.Java.Classfile.Flags (Flags) -import Language.Java.Classfile.ClassFlag (ClassFlag) +import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.ConstantPool.References (Class) import Language.Java.Classfile.Interfaces (Interfaces) import Language.Java.Classfile.Fields (Fields) import Language.Java.Classfile.Methods (Methods) import Language.Java.Classfile.Attributes (Attributes) +import Data.Word (Word16) +-- | 'Stage'-indexed classfile. It can represent a class, an interface or a module. + type Classfile :: Stage -> Type data Classfile stage = Classfile { magic :: Magic stage @@ -51,3 +57,29 @@ data family ClassFlags stage newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving stock (Show, Generic) deriving Extractable via Generically (ClassFlags Parse) + +data ClassFlag + = Public + | Final + | Super + | Interface + | Abstract + | Synthetic + | Annotation + | Enum + | Module + deriving (Show, Eq, Ord, Enum, Bounded) + +instance FlagMask ClassFlag where + type FlagType ClassFlag = Word16 + maskOf :: ClassFlag -> FlagType ClassFlag + maskOf = \case + Public -> 0x0001 + Final -> 0x0010 + Super -> 0x0020 + Interface -> 0x0200 + Abstract -> 0x0400 + Synthetic -> 0x1000 + Annotation -> 0x2000 + Enum -> 0x4000 + Module -> 0x8000 diff --git a/src/Language/Java/Classfile/Attributes.hs b/src/Language/Java/Classfile/Attributes.hs index 425b28e..7466c04 100644 --- a/src/Language/Java/Classfile/Attributes.hs +++ b/src/Language/Java/Classfile/Attributes.hs @@ -1,3 +1,5 @@ +-- | Attributes that can be attached to a lot of things in classfiles. + {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} @@ -9,10 +11,16 @@ import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Extractable.SizedBytes (SizedBytes) import GHC.Generics ( Generic, Generically(..) ) +-- | Generic Attribute array used everywhere. +-- +-- Will not respect Attribute location restrictions, does not attempt to parse anything specific. + newtype Attributes = Attributes (Array Word16 Attribute) deriving stock (Show) deriving newtype Extractable +-- | Unknown Attribute + data Attribute = Attribute { name :: Utf8Reference , info :: SizedBytes Word32 diff --git a/src/Language/Java/Classfile/ClassFlag.hs b/src/Language/Java/Classfile/ClassFlag.hs deleted file mode 100644 index cb79d9a..0000000 --- a/src/Language/Java/Classfile/ClassFlag.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} -module Language.Java.Classfile.ClassFlag (ClassFlag(..)) where -import Data.Word (Word16) -import Language.Java.Classfile.Flag (FlagMask (..)) - -data ClassFlag - = Public - | Final - | Super - | Interface - | Abstract - | Synthetic - | Annotation - | Enum - | Module - deriving (Show, Eq, Ord, Enum, Bounded) - -instance FlagMask ClassFlag where - type FlagType ClassFlag = Word16 - maskOf :: ClassFlag -> FlagType ClassFlag - maskOf = \case - Public -> 0x0001 - Final -> 0x0010 - Super -> 0x0020 - Interface -> 0x0200 - Abstract -> 0x0400 - Synthetic -> 0x1000 - Annotation -> 0x2000 - Enum -> 0x4000 - Module -> 0x8000 diff --git a/src/Language/Java/Classfile/ConstantPool.hs b/src/Language/Java/Classfile/ConstantPool.hs index 0df605c..9f2fab3 100644 --- a/src/Language/Java/Classfile/ConstantPool.hs +++ b/src/Language/Java/Classfile/ConstantPool.hs @@ -1,3 +1,5 @@ +-- | THE constant pool, all the constants in a class file are handled in here. + {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} @@ -16,6 +18,8 @@ import qualified Data.Text as Text import Language.Java.Classfile.Stage (Stage(..)) import Data.Kind (Type) +-- | 'Stage'-indexed constant-pool. The constant-pool is erased after resolving the class file. + type ConstantPool :: Stage -> Type data family ConstantPool stage diff --git a/src/Language/Java/Classfile/ConstantPool/Entry.hs b/src/Language/Java/Classfile/ConstantPool/Entry.hs index cae736d..ff98f7b 100644 --- a/src/Language/Java/Classfile/ConstantPool/Entry.hs +++ b/src/Language/Java/Classfile/ConstantPool/Entry.hs @@ -1,3 +1,5 @@ +-- | Constant-Pool entries. + {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DataKinds #-} @@ -6,7 +8,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OrPatterns #-} -module Language.Java.Classfile.ConstantPool.Entry (Entry(..), StorageCount(..), storageCount) where +module Language.Java.Classfile.ConstantPool.Entry (Entry(..), StorageCount(..), storageCount, MethodHandleInfo(..)) where import GHC.Generics (Generic, Generically(..)) import Language.Java.Classfile.Extractable (Extractable (extract)) import Language.Java.Classfile.Extractable.WithTag (Word8Tag) @@ -19,31 +21,56 @@ import qualified Data.Text.Encoding as Text import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString as StrictByteString -data Entry +-- | A single entry. Double and Long are not followed by something unusable, they are duplicated instead. + +data Entry = Utf8 (Word8Tag 1 (SizedText Word16)) + -- ^ Java-modified Utf8 | Integer (Word8Tag 3 Int32) + -- ^ Constant value for ldc | Float (Word8Tag 4 Float) + -- ^ Constant value for ldc | Long (Word8Tag 5 Int64) + -- ^ Constant value for ldc | Double (Word8Tag 6 Double) - | Class (Word8Tag 7 Utf8Reference) -- name - | String (Word8Tag 8 Utf8Reference) -- value - | FieldRef (Word8Tag 9 (ClassReference, NameAndTypeReference)) -- containing class, descriptor - | MethodRef (Word8Tag 10 (ClassReference, NameAndTypeReference)) -- containing class, descriptor - | InterfaceMethodRef (Word8Tag 11 (ClassReference, NameAndTypeReference)) -- containing class, descriptor - | NameAndType (Word8Tag 12 (Utf8Reference, Utf8Reference)) -- name, type + -- ^ Constant value for ldc + | Class (Word8Tag 7 Utf8Reference) + -- ^ Reference to another class: full name + | String (Word8Tag 8 Utf8Reference) + -- ^ Constant value for ldc or ConstantValue attributes. + | FieldRef (Word8Tag 9 (ClassReference, NameAndTypeReference)) + -- ^ Reference to a field: (containing class, descriptor) + | MethodRef (Word8Tag 10 (ClassReference, NameAndTypeReference)) + -- ^ Reference to a method: (containing class, descriptor) + | InterfaceMethodRef (Word8Tag 11 (ClassReference, NameAndTypeReference)) + -- ^ Reference to an interface method: (containing class, descriptor) + | NameAndType (Word8Tag 12 (Utf8Reference, Utf8Reference)) + -- ^ Name and Type: (name, type) | MethodHandle (Word8Tag 15 MethodHandleInfo) - | MethodType (Word8Tag 16 Utf8Reference) -- descriptor - | Dynamic (Word8Tag 17 (BootstrapMethodIndex, NameAndTypeReference)) -- index into the bootstrapmethod attribute array, NameAndType must refer to a field - | InvokeDynamic (Word8Tag 18 (BootstrapMethodIndex, NameAndTypeReference)) -- index into the bootstrapmethod attribute array, NameAndType must refer to a method + -- ^ Reference to a Method, but more *dynamic* + | MethodType (Word8Tag 16 Utf8Reference) + -- ^ Descriptor of a Method + | Dynamic (Word8Tag 17 (BootstrapMethodIndex, NameAndTypeReference)) + -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a field + | InvokeDynamic (Word8Tag 18 (BootstrapMethodIndex, NameAndTypeReference)) + -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a method | Module (Word8Tag 19 Utf8Reference) + -- ^ Some module description | Package (Word8Tag 20 Utf8Reference) + -- ^ Some package description deriving stock (Show, Generic) deriving Extractable via Generically Entry +-- | Holds the invariants of MethodHandles (Only certain references are allowed after some kinds) +-- +-- TODO: Implement the invariants + data MethodHandleInfo = MethodHandleInfo MethodHandleReferenceKind OpaqueReference deriving stock (Show, Generic) deriving Extractable via Generically MethodHandleInfo +-- | Extractor newtype for a java-utf-text with size tag specified as a type argument. + newtype SizedText sizeType = SizedText Text deriving stock (Show) @@ -57,8 +84,12 @@ instance (Integral sizeType, Extractable sizeType) => Extractable (SizedText siz Left err -> fail $ show err Right t -> pure $ SizedText t +-- | How many indices does a 'Entry' take? + data StorageCount = Once | Twice +-- | Get the count for a specific entry. + storageCount :: Entry -> StorageCount storageCount = \case (Double _ ; Long _) -> Twice diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs index eefed7f..1cf94b4 100644 --- a/src/Language/Java/Classfile/ConstantPool/References.hs +++ b/src/Language/Java/Classfile/ConstantPool/References.hs @@ -1,3 +1,5 @@ +-- | Collection of types used in the classfile, they are generally an index into the constant-pool. + {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} @@ -13,30 +15,44 @@ import Language.Java.Classfile.Extractable.AsTag import Language.Java.Classfile.Stage (Stage(..)) import Data.Kind (Type) +-- | Wrapper for constant-pool reference to text. + newtype Utf8Reference = Utf8Reference Word16 deriving stock (Show) deriving newtype Extractable +-- | 'Stage'-indexed type, either a Class or only a t'ClassReference'. + type Class :: Stage -> Type type family Class stage where Class Parse = ClassReference +-- | Reference to a class in a constant-pool. This will resolve into a class. + newtype ClassReference = ClassReference Word16 deriving stock (Show) deriving newtype Extractable +-- | Reference to a class in a constant-pool. This will resolve to Name and Type. + newtype NameAndTypeReference = NameAndTypeReference Word16 deriving stock (Show) deriving newtype Extractable +-- | Reference to something in a constant-pool. I will hopefully get rid of this type. + newtype OpaqueReference = OpaqueReference Word16 deriving stock (Show) deriving newtype Extractable +-- | Reference to a method in the BootstrapMethods class attribute + newtype BootstrapMethodIndex = BootstrapMethodIndex Word16 deriving stock (Show) deriving newtype Extractable +-- | A Tag used to determine the type of a MethodHandle + data MethodHandleReferenceKind = GetField | GetStatic diff --git a/src/Language/Java/Classfile/Extract.hs b/src/Language/Java/Classfile/Extract.hs index 46111cf..d837cc7 100644 --- a/src/Language/Java/Classfile/Extract.hs +++ b/src/Language/Java/Classfile/Extract.hs @@ -1,6 +1,8 @@ +-- | Extract a Classfile value out of 'ByteString' input. + {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE InstanceSigs #-} -module Language.Java.Classfile.Extract (Extract(), bytes, runExtract, expectRaw, expectEqual, traceType, traceConstructor, traceField, traceIndex) where +module Language.Java.Classfile.Extract (Extract(), bytes, runExtract, expectRaw, expectEqual, traceType, traceConstructor, traceField, traceIndex, Reason(..), Trace(..), Expected(..), Actual(..), TypeName(..)) where import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as ByteString @@ -9,25 +11,49 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Typeable (Typeable, typeOf) +-- | Extractor Monad. Computations running in this monad will automatically keep track of used resources and backtrack arbitrarily. + newtype Extract a = Extract (Continuation a) deriving (Functor) +-- | Functions work wonders when defining monads. + type Continuation a = ByteString -> Reply a +-- | Result used to abort computations on failure. + +data Reply a + = Done ByteString a -- rest, result + | Fail [Trace] Reason + deriving (Functor) + +-- | Type Alias for the Show instance newtype Expected = Expected Text deriving Show + +-- | Type Alias for the Show instance newtype Actual = Actual Text deriving Show + +-- | Type Alias for the Show instance newtype TypeName = TypeName Text deriving Show +-- | Why did the computation fail? + data Reason = EndOfInput + -- ^ The parser expected more input bytes | UnexpectedValue Expected Actual TypeName + -- ^ A specific value was expected but not provided | Custom Text + -- ^ Something else went wrong | Unknown + -- ^ Someone used the 'empty' function from 'Alternative' deriving Show +-- | Where did the computation fail? Calls to these functions are auto-generated by the Generic instances. + data Trace = InType Text | InConstructor Text @@ -35,14 +61,12 @@ data Trace | AtIndex Word deriving Show -data Reply a - = Done ByteString a -- rest, result - | Fail [Trace] Reason - deriving (Functor) - instance Applicative Extract where + -- | Don't consume any input pure :: a -> Extract a pure x = Extract $ \ rest -> Done rest x + + -- | One by one, Fail short-circuits it all. (<*>) :: Extract (a -> b) -> Extract a -> Extract b (<*>) (Extract computeF) (Extract computeX) = Extract $ \ input -> case computeF input of Done rest f -> case computeX rest of @@ -51,6 +75,7 @@ instance Applicative Extract where Fail ts r -> Fail ts r instance Monad Extract where + -- | One by one, Fail short-circuits it all. (>>=) :: Extract a -> (a -> Extract b) -> Extract b (>>=) (Extract computeA) f = Extract $ \ input -> case computeA input of Done rest a -> let @@ -59,14 +84,18 @@ instance Monad Extract where Fail ts r -> Fail ts r instance Alternative Extract where + -- | Fail the computation. empty :: Extract a empty = Extract $ const (Fail [] Unknown) + + -- | This implementation is left-biased. Only when the left computation fails will it run the right one. (<|>) :: Extract a -> Extract a -> Extract a (<|>) (Extract left) (Extract right) = Extract $ \ input -> case left input of Fail _ _ -> right input t -> t instance MonadFail Extract where + -- | Produces the 'Custom' Failure Reason fail :: String -> Extract a fail = Extract . const . Fail [] . Custom . Text.pack @@ -98,6 +127,8 @@ expectEqual (Extract computeActual) expected = Extract $ \ input -> case compute else Fail [] (mismatchReason expected actual) failed -> failed +-- | Constructs the reason, arguments are in this order: expected, actual + mismatchReason :: (Typeable a, Show a) => a -> a -> Reason mismatchReason expected actual = UnexpectedValue (Expected expectedText) (Actual actualText) (TypeName typeName) where @@ -105,17 +136,11 @@ mismatchReason expected actual = UnexpectedValue (Expected expectedText) (Actual expectedText = textShow expected typeName = textShow $ typeOf expected +-- | You know what this is + textShow :: Show a => a -> Text textShow = Text.pack . show -{- It seems I cannot define a lawful monad instance -instance Monad Extract where - (>>=) :: Extract a -> (a -> Extract b) -> Extract b - (>>=) (Extract computeA) f = Extract $ \ input -> case computeA input of - Done rest a -> _ - Fail -> Fail --} - -- | Apply the extractor to the bytestring, returns the result and the rest on success, otherwise a best-effort traceback. runExtract :: ByteString -> Extract b -> Either (Reason, [Trace]) (ByteString, b) @@ -130,16 +155,22 @@ traceType typeName (Extract computeA) = Extract $ \ input -> case computeA input Fail ts r -> Fail (InType typeName:ts) r t -> t +-- | Trace the contained extractor, the backtrace will supply a hint with the given constructor name + traceConstructor :: Text -> Extract a -> Extract a traceConstructor conName (Extract computeA) = Extract $ \ input -> case computeA input of Fail ts r -> Fail (InConstructor conName:ts) r t -> t +-- | Trace the contained extractor, the backtrace will supply a hint with the given Field name + traceField :: Text -> Extract a -> Extract a traceField fieldName (Extract computeA) = Extract $ \ input -> case computeA input of Fail ts r -> Fail (InField fieldName:ts) r t -> t +-- | Trace the contained extractor, the backtrace will indicate that the computation was at a specific index. + traceIndex :: Word -> Extract a -> Extract a traceIndex index (Extract computeA) = Extract $ \ input -> case computeA input of Fail ts r -> Fail (AtIndex index:ts) r diff --git a/src/Language/Java/Classfile/Extractable.hs b/src/Language/Java/Classfile/Extractable.hs index a2617f4..bbf0d1c 100644 --- a/src/Language/Java/Classfile/Extractable.hs +++ b/src/Language/Java/Classfile/Extractable.hs @@ -1,3 +1,7 @@ +-- | This contains the typeclass used to associate types with their implementation of 'Extract'. +-- +-- There are also some convenience functions here. + {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} @@ -27,6 +31,10 @@ import GHC.TypeLits (symbolVal, KnownSymbol) import Data.Proxy (Proxy(Proxy)) import Data.Typeable (Typeable, typeRep) +-- | Extract a value of the type. It is recommended to generate this instance using 'Generic' and deriving via. +-- +-- Generated instances will collect all fields in order and also call the trace-functions where appropriate. + class Extractable a where extract :: Extract a @@ -85,6 +93,8 @@ deriving via Generically () instance Extractable () deriving via Generically (a, b) instance (Extractable a, Extractable b) => Extractable (a, b) deriving via Generically (a, b, c) instance (Extractable a, Extractable b, Extractable c) => Extractable (a, b, c) +-- | Fail if the extracted value is not equal to the provided constant. Otherwise succeed. + expectConstant :: (Extractable a, Eq a, Show a, Typeable a) => a -> Extract a expectConstant = expectEqual extract @@ -94,6 +104,7 @@ build = ByteString.foldl' shiftOr 0 shiftOr :: (Bits a1, Num a1) => a1 -> Word8 -> a1 shiftOr word appendix = shiftL word 8 .|. fromIntegral appendix +-- | Class used for generic-deriving, it won't interfere 'Extractable'. class GenericExtractable a where genericExtract :: Extract (a i) diff --git a/src/Language/Java/Classfile/Extractable/AsTag.hs b/src/Language/Java/Classfile/Extractable/AsTag.hs index 7d3de50..16cdb52 100644 --- a/src/Language/Java/Classfile/Extractable/AsTag.hs +++ b/src/Language/Java/Classfile/Extractable/AsTag.hs @@ -1,3 +1,5 @@ +-- | Treat some enumeration value as a tag. Use for deriving via. + {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} @@ -13,6 +15,8 @@ import Control.Applicative (asum) import Data.Functor (($>)) import Data.Typeable ( Typeable ) +-- | The 'Extractable' instance will use the values from 'TagValue' to get the correct constructor. + newtype AsTag a = AsTag a deriving Show @@ -25,6 +29,8 @@ instance (Extractable (TagType a), Bounded a, Enum a, Eq (TagType a), Show (TagT AsTag <$> asum allConstructors +-- | Specify the type of a tag. Provide values using 'tagOf'. This relies on the 'Enum' and 'Bounded' instances of the wrapped type to extract them. + class TagValue a where type TagType a :: Type tagOf :: a -> TagType a diff --git a/src/Language/Java/Classfile/Extractable/SizedBytes.hs b/src/Language/Java/Classfile/Extractable/SizedBytes.hs index 21d8dbf..eb80393 100644 --- a/src/Language/Java/Classfile/Extractable/SizedBytes.hs +++ b/src/Language/Java/Classfile/Extractable/SizedBytes.hs @@ -1,3 +1,5 @@ +-- | Read arbitrary bytes prefixed with a length. + {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} @@ -9,6 +11,8 @@ import Language.Java.Classfile.Extract (Extract, bytes) import qualified Data.ByteString as StrictByteString import qualified Data.ByteString.Lazy as ByteString +-- | The sizeType type Paramter is used to extract the correct byte count. + newtype SizedBytes sizeType = SizedBytes ByteString deriving stock Show diff --git a/src/Language/Java/Classfile/Extractable/WithTag.hs b/src/Language/Java/Classfile/Extractable/WithTag.hs index a3b78f9..d2759e4 100644 --- a/src/Language/Java/Classfile/Extractable/WithTag.hs +++ b/src/Language/Java/Classfile/Extractable/WithTag.hs @@ -1,3 +1,5 @@ +-- | Fail if a Value doesn't have the right tag. + {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} @@ -15,8 +17,12 @@ import Data.Proxy (Proxy(Proxy)) import Data.Typeable ( Typeable ) import Data.Word (Word8) +-- | Type alias if you use the same type a lot. + type Word8Tag value a = WithNumericTag value Word8 a +-- | This uses 'DataKinds' to extract the type-level natural number. Negative Tags are not supported. + type WithNumericTag :: Natural -> Type -> Type -> Type newtype WithNumericTag value tagType a = Tagged a deriving newtype Show diff --git a/src/Language/Java/Classfile/Fields.hs b/src/Language/Java/Classfile/Fields.hs index e7bf4f8..ea9ffc8 100644 --- a/src/Language/Java/Classfile/Fields.hs +++ b/src/Language/Java/Classfile/Fields.hs @@ -1,3 +1,5 @@ +-- | Fields array of a class. + {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} @@ -9,15 +11,18 @@ import Data.Array.IArray (Array) import Data.Word (Word16) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) -import Language.Java.Classfile.Flags (Flags) -import Language.Java.Classfile.Flag (FlagMask (..)) +import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) +-- | Word16-Array of Fields. + newtype Fields = Fields (Array Word16 Field) deriving stock Show deriving newtype Extractable +-- | All the access flags a field can have + data FieldFlag = Public | Private @@ -44,6 +49,7 @@ instance FlagMask FieldFlag where Synthetic -> 0x1000 Enumeration -> 0x4000 +-- | A singular field of a class. data Field = Field { flags :: Flags FieldFlag diff --git a/src/Language/Java/Classfile/Flag.hs b/src/Language/Java/Classfile/Flag.hs deleted file mode 100644 index 2d6eed5..0000000 --- a/src/Language/Java/Classfile/Flag.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module Language.Java.Classfile.Flag (FlagMask(..)) where -import Data.Kind (Type) - -class FlagMask a where - type FlagType a :: Type - maskOf :: a -> FlagType a - diff --git a/src/Language/Java/Classfile/Flags.hs b/src/Language/Java/Classfile/Flags.hs index a3d1b42..9a2e549 100644 --- a/src/Language/Java/Classfile/Flags.hs +++ b/src/Language/Java/Classfile/Flags.hs @@ -1,9 +1,12 @@ +-- | Parse flags, this will produce a Set of specified flags. + {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} -module Language.Java.Classfile.Flags (Flags(..)) where +{-# LANGUAGE TypeFamilies #-} +module Language.Java.Classfile.Flags (Flags(..), FlagMask(..)) where import Data.Bits (Bits((.&.))) @@ -14,7 +17,9 @@ import qualified Data.Set as Set import Language.Java.Classfile.Extract (Extract) import Language.Java.Classfile.Extractable (Extractable (extract)) -import Language.Java.Classfile.Flag (FlagMask(..)) +import Data.Kind (Type) + +-- | Using the 'FlagMask' instance of the type parameter, this will extract all the flags whose mask produced a non-zero value using '.&.' newtype Flags a = Flags (Set a) deriving (Show) @@ -28,3 +33,9 @@ instance (Extractable (FlagType a), Bounded a, Enum a, Ord a, FlagMask a, Bits ( pure . Flags . Set.fromList $ filter isContained allFlags +-- | Specify the masks and Parse type (size) a flag enum uses. + +class FlagMask a where + type FlagType a :: Type + maskOf :: a -> FlagType a + diff --git a/src/Language/Java/Classfile/FromBigEndian.hs b/src/Language/Java/Classfile/FromBigEndian.hs index 7ca4a80..a134444 100644 --- a/src/Language/Java/Classfile/FromBigEndian.hs +++ b/src/Language/Java/Classfile/FromBigEndian.hs @@ -1,9 +1,12 @@ +-- | Convert values from BigEndian byte order to native Byte order. + {-# LANGUAGE InstanceSigs #-} module Language.Java.Classfile.FromBigEndian (FromBigEndian(fromBigEndian)) where import Data.Word (Word16, byteSwap16, Word32, byteSwap32) import GHC.ByteOrder (ByteOrder(..)) import qualified GHC.ByteOrder as GHC +-- | Specifies the conversion function. When 'GHC.targetByteOrder' is 'BigEndian', this is 'id'. class FromBigEndian a where fromBigEndian :: a -> a diff --git a/src/Language/Java/Classfile/Interfaces.hs b/src/Language/Java/Classfile/Interfaces.hs index 6c4f485..6908287 100644 --- a/src/Language/Java/Classfile/Interfaces.hs +++ b/src/Language/Java/Classfile/Interfaces.hs @@ -1,3 +1,5 @@ +-- | Interface List. + {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Interfaces (Interfaces(..)) where @@ -7,6 +9,8 @@ import Language.Java.Classfile.ConstantPool.References (ClassReference) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generic, Generically, Generically(..) ) +-- | A list of classes something implements. + newtype Interfaces = Interfaces (Array Word16 ClassReference) deriving stock (Show, Generic) deriving Extractable via Generically Interfaces diff --git a/src/Language/Java/Classfile/Magic.hs b/src/Language/Java/Classfile/Magic.hs index 1c19846..31cc35c 100644 --- a/src/Language/Java/Classfile/Magic.hs +++ b/src/Language/Java/Classfile/Magic.hs @@ -1,3 +1,5 @@ +-- | Parse the Magic bytes at the beginning of every class-file. + {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} @@ -11,6 +13,8 @@ import Data.Hex (Hex (Hex)) import Language.Java.Classfile.Stage (Stage(Parse, Resolve)) import Data.Kind (Type) +-- | 'Stage'-indexed Magic type. The 'Resolve' stage is only a unit type. + type Magic :: Stage -> Type data family Magic stage diff --git a/src/Language/Java/Classfile/Methods.hs b/src/Language/Java/Classfile/Methods.hs index 38faced..814b9b6 100644 --- a/src/Language/Java/Classfile/Methods.hs +++ b/src/Language/Java/Classfile/Methods.hs @@ -1,3 +1,5 @@ +-- | Methods array of a class. + {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} @@ -7,9 +9,8 @@ module Language.Java.Classfile.Methods (Methods(..), Method(..), MethodFlag(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) -import Language.Java.Classfile.Flags (Flags) +import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.Extractable (Extractable) -import Language.Java.Classfile.Flag (FlagMask (..)) import GHC.Generics ( Generically, Generic, Generically(..) ) import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) diff --git a/src/Language/Java/Classfile/Stage.hs b/src/Language/Java/Classfile/Stage.hs index ebdf5bc..ccf104c 100644 --- a/src/Language/Java/Classfile/Stage.hs +++ b/src/Language/Java/Classfile/Stage.hs @@ -1,6 +1,9 @@ -{-# LANGUAGE DataKinds #-} +-- | Stages of the classfile loading. + module Language.Java.Classfile.Stage (Stage(..)) where +-- | Using the 'DataKinds' extension, these are used to index into data-types which will provide different Layouts based on the stage they are in. + data Stage = Parse | Resolve diff --git a/src/Language/Java/Classfile/Version.hs b/src/Language/Java/Classfile/Version.hs index a5704a1..4220868 100644 --- a/src/Language/Java/Classfile/Version.hs +++ b/src/Language/Java/Classfile/Version.hs @@ -1,3 +1,5 @@ +-- | The version component of a classfile. + {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Version (Version(..)) where @@ -6,6 +8,8 @@ import Data.Word (Word16) import GHC.Generics (Generic, Generically(Generically)) import Language.Java.Classfile.Extractable (Extractable) +-- | Classfile versions only have two components. The minor component is zero since some java version. + data Version = Version { minor :: Word16 , major :: Word16