jvm-binary 0.7.0 → 0.8.0
raw patch · 9 files changed
+133/−115 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Language.JVM.Attribute.Base: [unConst] :: Const a b -> a
- Language.JVM.Attribute.Base: newtype Const a b
+ Language.JVM.Attribute.Base: [getConst] :: Const a -> a
+ Language.JVM.Attribute.Base: newtype Const a (b :: k) :: forall k. () => Type -> k -> Type
+ Language.JVM.Attribute.Signature: classTypeT :: ClassType -> Builder
+ Language.JVM.Attribute.Signature: referenceTypeT :: ReferenceType -> Builder
+ Language.JVM.Attribute.Signature: throwsSignatureP :: Parser ThrowsSignature
+ Language.JVM.Attribute.Signature: throwsSignatureT :: ThrowsSignature -> Builder
+ Language.JVM.Attribute.Signature: typeArgumentP :: Parser (Maybe TypeArgument)
+ Language.JVM.Attribute.Signature: typeArgumentT :: Maybe TypeArgument -> Builder
+ Language.JVM.Attribute.Signature: typeArgumentsP :: Parser [Maybe TypeArgument]
+ Language.JVM.Attribute.Signature: typeArgumentsT :: [Maybe TypeArgument] -> Builder
+ Language.JVM.Attribute.Signature: typeParameterT :: TypeParameter -> Builder
+ Language.JVM.Attribute.Signature: typeParametersT :: [TypeParameter] -> Builder
- Language.JVM.Attribute.Base: Const :: a -> Const a b
+ Language.JVM.Attribute.Base: Const :: a -> Const a
Files
- CHANGELOG.md +2/−1
- jvm-binary.cabal +2/−2
- package.yaml +1/−1
- src/Language/JVM/Attribute/Base.hs +8/−9
- src/Language/JVM/Attribute/Signature.hs +76/−58
- stack.yaml +1/−1
- test/Language/JVM/Attribute/EnclosingMethodSpec.hs +10/−10
- test/Language/JVM/Attribute/InnerClassesSpec.hs +32/−32
- test/Language/JVMSpec.hs +1/−1
CHANGELOG.md view
@@ -1,6 +1,7 @@ # Change log -## Version 0.8.0 (PENDING)+## Version 0.8.0 +- Upgrade to GHC 8.6.4 ## Version 0.7.0 - Create instances for InClass
jvm-binary.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 66f9e829b672a9a2b77a10d9248e3a98ba13cdf0b8422506f9cb9ffd4858b5eb+-- hash: 03c963aeab3e7e2bc2d184ccd232d7e3fee10eca4c19073d94b1471921209eea name: jvm-binary-version: 0.7.0+version: 0.8.0 synopsis: A library for reading Java class-files description: A library for reading Java class-files. category: Language, Java, JVM
package.yaml view
@@ -1,5 +1,5 @@ name: jvm-binary-version: '0.7.0'+version: '0.8.0' author: Christian Gram Kalhauge maintainer: Christian Gram Kalhauge <kalhauge@cs.ucla.edu> synopsis: A library for reading Java class-files
src/Language/JVM/Attribute/Base.hs view
@@ -28,13 +28,16 @@ , collectBC , AttributeCollector (..) , ByteCodeAttributeCollector (..)- , Const (..) , firstOne++ -- * re-export+ , Const (..) ) where -- base import Data.Monoid import Control.Monad+import Control.Applicative import Data.Maybe import Data.Bifunctor import qualified Data.List as List@@ -82,10 +85,6 @@ -- | A list of attributes and described by the expected values. type Attributes b r = Choice (SizedList16 (Attribute r)) (b r) r --- | Create a type dependent on another type 'b',--- used for accessing the correct 'attrName' in 'IsAttribute'.-newtype Const a b = Const { unConst :: a }- -- | A class-type that describes a data-type 'a' as an Attribute. Most notable -- it provides the 'fromAttribute'' method that enables converting an Attribute -- to a data-type 'a'.@@ -99,7 +98,7 @@ toAttribute' :: forall a. IsAttribute a => a -> Attribute High toAttribute' a =- let name = unConst (attrName :: Const Text.Text a)+ let name = getConst (attrName :: Const Text.Text a) bytes = encode a in Attribute name (SizedByteString . BL.toStrict $ bytes) @@ -126,7 +125,7 @@ => Attribute High -> Maybe (m (a High)) fromAttribute as =- if aName as == unConst (attrName :: Const Text.Text (a Low))+ if aName as == getConst (attrName :: Const Text.Text (a Low)) then Just . label (Text.unpack $ aName as) . either attributeError evolve $ fromAttribute' as else Nothing @@ -137,7 +136,7 @@ -> Attribute High -> Maybe (m (a High)) fromBCAttribute fn as =- if aName as == unConst (attrName :: Const Text.Text (a Low))+ if aName as == getConst (attrName :: Const Text.Text (a Low)) then Just . label (Text.unpack $ aName as) . either attributeError (evolveBC fn) $ fromAttribute' as else Nothing @@ -148,7 +147,7 @@ -- -> Attribute High -- -> Maybe (m (a High)) -- evolveAttribute g as =--- if aName as == unConst (attrName :: Const Text.Text (a Low))+-- if aName as == getConst (attrName :: Const Text.Text (a Low)) -- then Just $ either attributeError g $ fromAttribute' as -- else Nothing
src/Language/JVM/Attribute/Signature.hs view
@@ -38,17 +38,27 @@ -- * Lower Level Definitions , ClassType (..) , classTypeP+ , classTypeT , ReferenceType (..) , referenceTypeP+ , referenceTypeT , ThrowsSignature (..)+ , throwsSignatureP+ , throwsSignatureT , TypeArgument (..)+ , typeArgumentsT+ , typeArgumentsP+ , typeArgumentP+ , typeArgumentT , TypeParameter (..)+ , typeParameterP+ , typeParameterT+ , typeParametersT+ , typeParametersP , TypeSignature (..) , TypeVariable (..) , typeVariableP , Wildcard (..)- , typeParameterP- , typeParametersP ) where import Control.DeepSeq (NFData)@@ -61,6 +71,7 @@ import GHC.Generics (Generic) import Data.Attoparsec.Text+import Control.Applicative import qualified Data.List as L @@ -81,10 +92,6 @@ signatureFromText :: Text.Text -> Signature High signatureFromText = Signature -------------------------- Parsing------------------------ data ClassSignature = ClassSignature { csTypeParameters :: [TypeParameter] , csSuperclassSignature :: ClassType@@ -92,6 +99,68 @@ } deriving (Show, Eq, Generic, NFData) +data MethodSignature = MethodSignature+ { msTypeParameters :: [TypeParameter]+ , msArguments :: [TypeSignature]+ , msResults :: Maybe TypeSignature+ , msThrows :: [ ThrowsSignature ]+ }+ deriving (Show, Eq, Generic, NFData)++newtype FieldSignature =+ FieldSignature {fsRefType :: ReferenceType}+ deriving (Show, Eq, Generic, NFData)+++data TypeSignature+ = ReferenceType ReferenceType+ | BaseType JBaseType+ deriving (Show, Eq, Generic, NFData)++data ReferenceType+ = RefClassType ClassType+ | RefTypeVariable TypeVariable+ | RefArrayType TypeSignature+ deriving (Show, Eq, Generic, NFData)++data ClassType+ = ClassType+ { ctsClassName :: ClassName+ , ctsTypeArguments :: [Maybe TypeArgument]+ }+ | InnerClassType+ { ctsInnerClassName :: Text.Text+ , ctsOuterClassType :: ClassType+ , ctsTypeArguments :: [Maybe TypeArgument]+ }+ deriving (Show, Eq, Generic, NFData)++data TypeArgument = TypeArgument+ { taWildcard :: Maybe Wildcard+ , taType :: ReferenceType+ } deriving (Show, Eq, Generic, NFData)++data Wildcard =+ WildPlus | WildMinus+ deriving (Show, Eq, Generic, NFData)++newtype TypeVariable =+ TypeVariable { tvAsText :: Text.Text }+ deriving (Show, Eq, Generic, NFData)++data TypeParameter =+ TypeParameter+ { tpIndentifier :: Text.Text+ , tpClassBound :: Maybe ReferenceType+ , tpInterfaceBound :: [ReferenceType]+ }+ deriving (Show, Eq, Generic, NFData)+++----------------------+-- Parsing+----------------------+ classSignatureP :: Parser ClassSignature classSignatureP = do tp <- option [] typeParametersP@@ -111,10 +180,6 @@ classSignatureT (ClassSignature tp ct its)= do typeParametersT tp <> foldMap classTypeT (ct:its) -data TypeSignature- = ReferenceType ReferenceType- | BaseType JBaseType- deriving (Show, Eq, Generic, NFData) typeSignatureP :: Parser TypeSignature typeSignatureP = do@@ -125,12 +190,6 @@ typeSignatureT (ReferenceType t) = referenceTypeT t typeSignatureT (BaseType t) = singleton (jBaseTypeToChar t) -data ReferenceType- = RefClassType ClassType- | RefTypeVariable TypeVariable- | RefArrayType TypeSignature- deriving (Show, Eq, Generic, NFData)- referenceTypeP :: Parser ReferenceType referenceTypeP = do choice@@ -146,17 +205,6 @@ RefTypeVariable tv -> typeVariableT tv RefArrayType at -> singleton '[' <> typeSignatureT at -data ClassType- = ClassType- { ctsClassName :: ClassName- , ctsTypeArguments :: [Maybe TypeArgument]- }- | InnerClassType- { ctsInnerClassName :: Text.Text- , ctsOuterClassType :: ClassType- , ctsTypeArguments :: [Maybe TypeArgument]- }- deriving (Show, Eq, Generic, NFData) classTypeP :: Parser ClassType classTypeP = nameit "ClassType" $ do@@ -184,11 +232,6 @@ <> Text.fromText (classNameAsText cn) <> typeArgumentsT arg -data TypeArgument = TypeArgument- { taWildcard :: Maybe Wildcard- , taType :: ReferenceType- }- deriving (Show, Eq, Generic, NFData) typeArgumentsP :: Parser [ Maybe TypeArgument ] typeArgumentsP = do@@ -223,16 +266,10 @@ Just WildPlus -> singleton '+' Nothing -> mempty) <> referenceTypeT rt -data Wildcard =- WildPlus | WildMinus- deriving (Show, Eq, Generic, NFData) wildcardP :: Parser Wildcard wildcardP = choice [ char '+' $> WildPlus, char '-' $> WildMinus] -newtype TypeVariable =- TypeVariable { tvAsText :: Text.Text }- deriving (Show, Eq, Generic, NFData) typeVariableP :: Parser TypeVariable typeVariableP = do@@ -245,13 +282,6 @@ typeVariableT (TypeVariable t)= do singleton 'T' <> Text.fromText t <> singleton ';' -data TypeParameter =- TypeParameter- { tpIndentifier :: Text.Text- , tpClassBound :: Maybe ReferenceType- , tpInterfaceBound :: [ReferenceType]- }- deriving (Show, Eq, Generic, NFData) typeParametersP :: Parser [TypeParameter] typeParametersP = nameit "TypeParameters" $ do@@ -270,7 +300,7 @@ typeParameterP = nameit "TypeParameter" $ do id_ <- identifierP _ <- char ':'- cb <- option Nothing (Just <$> referenceTypeP)+ cb <- optional referenceTypeP ib <- many' (char ':' >> referenceTypeP) return $ TypeParameter id_ cb ib @@ -287,14 +317,6 @@ takeWhile1 (notInClass ".;[/<>:") <?> "Identifier" -data MethodSignature = MethodSignature- { msTypeParameters :: [TypeParameter]- , msArguments :: [TypeSignature]- , msResults :: Maybe TypeSignature- , msThrows :: [ ThrowsSignature ]- }- deriving (Show, Eq, Generic, NFData)- methodSignatureP :: Parser MethodSignature methodSignatureP = do tps <- option [] typeParametersP@@ -343,10 +365,6 @@ <> case t of ThrowsClass ct -> classTypeT ct ThrowsTypeVariable tt -> typeVariableT tt--newtype FieldSignature =- FieldSignature {fsRefType :: ReferenceType}- deriving (Show, Eq, Generic, NFData) fieldSignatureP :: Parser FieldSignature fieldSignatureP =
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-12.26+resolver: lts-13.19 packages: - . flags: {}
test/Language/JVM/Attribute/EnclosingMethodSpec.hs view
@@ -15,17 +15,17 @@ spec :: Spec spec =- spec_enclosing+ -- spec_enclosing -spec_enclosing :: SpecWith ()-spec_enclosing = do- it "can find an enclosing method in 'Streams$5'" $ do- tc <- withTestClass "Streams$5"- cEnclosingMethod tc `shouldBe`- Just (EnclosingMethod- "com/google/common/collect/Streams"- (Just ("mapWithIndex:(Ljava/util/stream/DoubleStream;Lcom/google/common/collect/Streams$DoubleFunctionWithIndex;)Ljava/util/stream/Stream;"))- )+-- spec_enclosing :: SpecWith ()+-- spec_enclosing = do+-- it "can find an enclosing method in 'Streams$5'" $ do+-- tc <- withTestClass "Streams$5"+-- cEnclosingMethod tc `shouldBe`+-- Just (EnclosingMethod+-- "com/google/common/collect/Streams"+-- (Just ("mapWithIndex:(Ljava/util/stream/DoubleStream;Lcom/google/common/collect/Streams$DoubleFunctionWithIndex;)Ljava/util/stream/Stream;"))+-- ) -- test_real_signatures :: SpecWith () -- test_real_signatures = do
test/Language/JVM/Attribute/InnerClassesSpec.hs view
@@ -14,42 +14,42 @@ spec :: Spec spec = do it "can do a roundtrip" $ property $ prop_roundtrip_InnerClassesSpec- spec_inner_classes+ --spec_inner_classes prop_roundtrip_InnerClassesSpec :: InnerClasses High -> Property prop_roundtrip_InnerClassesSpec = isoRoundtrip -spec_inner_classes :: SpecWith ()-spec_inner_classes = do- it "can find the inner classes of 'Streams$5'" $ do- tc <- withTestClass "Streams$5"- cInnerClasses tc `shouldBe`- [- InnerClass {- icClassName = "java/util/PrimitiveIterator$OfDouble",- icOuterClassName = Just "java/util/PrimitiveIterator",- icInnerName = Just "OfDouble",- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICInterface, ICAbstract]- },- InnerClass {- icClassName = "com/google/common/collect/Streams$DoubleFunctionWithIndex",- icOuterClassName = Just "com/google/common/collect/Streams",- icInnerName = Just "DoubleFunctionWithIndex",- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICInterface, ICAbstract]- },- InnerClass {- icClassName = "com/google/common/collect/Streams$5",- icOuterClassName = Nothing,- icInnerName = Nothing,- icInnerAccessFlags = BitSet $ S.fromList [ ICStatic ]- },- InnerClass {- icClassName = "java/util/Spliterators$AbstractSpliterator",- icOuterClassName = Just "java/util/Spliterators",- icInnerName = Just "AbstractSpliterator",- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICAbstract]- }- ]+-- spec_inner_classes :: SpecWith ()+-- spec_inner_classes = do+-- it "can find the inner classes of 'Streams$5'" $ do+-- tc <- withTestClass "Streams$5"+-- cInnerClasses tc `shouldBe`+-- [+-- InnerClass {+-- icClassName = "java/util/PrimitiveIterator$OfDouble",+-- icOuterClassName = Just "java/util/PrimitiveIterator",+-- icInnerName = Just "OfDouble",+-- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICInterface, ICAbstract]+-- },+-- InnerClass {+-- icClassName = "com/google/common/collect/Streams$DoubleFunctionWithIndex",+-- icOuterClassName = Just "com/google/common/collect/Streams",+-- icInnerName = Just "DoubleFunctionWithIndex",+-- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICInterface, ICAbstract]+-- },+-- InnerClass {+-- icClassName = "com/google/common/collect/Streams$5",+-- icOuterClassName = Nothing,+-- icInnerName = Nothing,+-- icInnerAccessFlags = BitSet $ S.fromList [ ICStatic ]+-- },+-- InnerClass {+-- icClassName = "java/util/Spliterators$AbstractSpliterator",+-- icOuterClassName = Just "java/util/Spliterators",+-- icInnerName = Just "AbstractSpliterator",+-- icInnerAccessFlags = BitSet $ S.fromList [ICPublic, ICStatic, ICAbstract]+-- }+-- ] -- test_real_signatures :: SpecWith () -- test_real_signatures = do
test/Language/JVMSpec.hs view
@@ -53,7 +53,7 @@ describe "the standard library" $ do runIO (lookupEnv "JAVA_HOME") >>= \case Just home -> do- Right archive <- runIO $ readZipFile (home </> "jre/lib/rt.jar")+ archive <- runIO $ either (error . ("Could not read zip file: "++) . show) return =<< readZipFile (home </> "jre/lib/rt.jar") let priorities = [ "java/lang/Class.class"