packages feed

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 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"