java-reflect 0.9 → 0.9.1

raw patch · 3 files changed

+100/−189 lines, 3 filesdep +hxPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hx

API changes (from Hackage documentation)

Files

• java-reflect.cabal +2/−1
• src/Language/Java/Reflect.hs +38/−151
• src/Language/Java/Reflect/Types.hs +60/−37

@@ -1,5 +1,5 @@ name:           java-reflect-version:        0.9+version:        0.9.1  license:        MIT license-file:   LICENSE@@ -21,6 +21,7 @@     build-depends:      base >= 4.5 && < 5                         , java-bridge == 0.9                         , containers >= 0.4.2.1+                        , hx      hs-source-dirs:     src 

@@ -1,4 +1,6 @@-{-# LANGUAGE Haskell2010 #-}+{-# LANGUAGE Haskell2010+    , TupleSections+ #-} {-# OPTIONS     -Wall     -fno-warn-missing-signatures@@ -15,8 +17,7 @@ -- -- Methods for reflecting Java classes using a JVM as source of information. module Language.Java.Reflect (-    findClasses,-    reflectClasses,+    getReflectClasses,      module Language.Java.Reflect.Types @@ -28,158 +29,27 @@ import qualified Data.Map as Map import Data.Map (Map) +{- import qualified Data.Set as Set import Data.Set (Set)+-}  import Data.Int-import Data.Word import Data.Maybe (fromJust) +import qualified Data.Traversable as T+ import Foreign.Java-import Foreign.Java.Utils+import Haskell.X   definitely = maybe (error "The impossible happened! Please report this as a bug.")  --- (---  [Methods = [types] ],---  (Maybe Parentclass, [Interfaces])--- )-type Class = ([String], (Maybe String, [String]))---findClasses :: Word32 -> [String] -> Java [String] --Java (Map String Class)-findClasses maxDepth classNamesToFind = do--    (Just clazz)   <- getClass "java.lang.Class"-    (Just cMethod) <- getClass "java.lang.reflect.Method"-    (Just cConstr) <- getClass "java.lang.reflect.Constructor"-    (Just cField)  <- getClass "java.lang.reflect.Field"--    getMethods <- clazz `bindMethod` "getMethods"-        ::= array (object "java.lang.reflect.Method")-    getConstructors <- clazz `bindMethod` "getConstructors"-        ::= array (object "java.lang.reflect.Constructor")-    getFields <- clazz `bindMethod` "getFields"-        ::= array (object "java.lang.reflect.Field")--    getFieldType <- cField `bindMethod` "getType"-        ::= object "java.lang.Class"-    getReturnType <- cMethod `bindMethod` "getReturnType"-        ::= object "java.lang.Class"-    getClassName <- clazz `bindMethod` "getName"-        ::= string-    getParametersM <- cMethod `bindMethod` "getParameterTypes"-        ::= array (object "java.lang.Class")-    getParametersC <- cConstr `bindMethod` "getParameterTypes"-        ::= array (object "java.lang.Class")-    getSuperclass <- clazz `bindMethod` "getSuperclass"-        ::= object "java.lang.Class"-    getInterfaces <- clazz `bindMethod` "getInterfaces"-        ::= array (object "java.lang.Class")--    (Just classLoader) <- getClass "java.lang.ClassLoader"-    getSystemClassLoader <- classLoader `bindStaticMethod` "getSystemClassLoader"-        ::= object "java.lang.ClassLoader"-    (Just systemClassLoader) <- getSystemClassLoader--    (Just loadClass) <- classLoader `getMethod` "loadClass"-        ::= string --> boolean --> object "java.lang.Class"--    let getClass' :: String -> Java (Maybe JObject)-        getClass' clazz = callMethodE loadClass systemClassLoader clazz False-            >>= return . either (const Nothing) id--        readClass :: JObject -> Java Class-        readClass clazz = do-            constructors <- getConstructors clazz-                >>= toList . fromJust-                >>= mapM (readConstructor . fromJust)-                >>= return . concat-            methods <- getMethods clazz-                >>= toList . fromJust-                >>= mapM (readMethod . fromJust)-                >>= return . concat-            fields <- getFields clazz-                >>= toList . fromJust-                >>= mapM (readField . fromJust)-            superclass <- getSuperclass clazz-                >>= maybe (return Nothing) getClassName-            interfaces <- getInterfaces clazz-                >>= toList . fromJust-                >>= mapM (getClassName . fromJust)-                >>= return . map fromJust-            return (constructors ++ fields ++ methods, (superclass, interfaces))--        readField :: JObject -> Java String-        readField field = do-            (Just fieldType) <- getFieldType field >>= getClassName . fromJust--            return fieldType--        readMethod :: JObject -> Java [String]-        readMethod method = do-            args <- readMethodParameters method---          excs <- readMethodExceptions method-            (Just returnType) <- getReturnType method >>= getClassName . fromJust-            -            return (returnType : args)--        readConstructor :: JObject -> Java [String]-        readConstructor constr = do-            args <- readConstructorParameters constr---          excs <- readConstructorExceptions constr-            -            return args--        readMethodParameters :: JObject -> Java [String]-        readMethodParameters method = getParametersM method-            >>= toList . fromJust-            >>= mapM (getClassName . fromJust)-            >>= return . map fromJust--        readConstructorParameters :: JObject -> Java [String]-        readConstructorParameters method = getParametersC method-            >>= toList . fromJust-            >>= mapM (getClassName . fromJust)-            >>= return . map fromJust--        readReferences :: Class -> [String]-        readReferences (refs1, (super, ifaces)) =-            let refs2 = maybe ifaces (: ifaces) super-            in refs2 ++ refs1--        isPrimitive x = head x == '[' || x `elem` ["byte", "short", "int", "long",-                                                   "float", "double", "boolean", "char",-                                                   "void"]--        resolve :: Map String Class -> Set String -> [String]-                -> Java (Map String Class, Set String)-        resolve map set css = case css of-            (x:xs) -> if x `Map.member` map-                then do resolve map set xs-                else getClass' x >>= maybe (resolve map set xs) (\clazz -> do-                        clazz' <- readClass clazz-                        let newClasses = Set.filter (`Map.notMember` map)-                                            $ Set.fromList (readReferences clazz')-                        resolve (Map.insert x clazz' map)-                                (newClasses `Set.union` set)-                                xs)-            [] -> do return (map, Set.filter (not . isPrimitive) set)--        findAll :: Word32 -> Map String Class -> [String] -> Java (Map String Class)-        findAll 0 classes _xs = return classes-        findAll limit classes xs = do-            (classes', new) <- resolve classes Set.empty xs-            if Set.null new-                then return classes'-                else findAll (pred limit) classes' (Set.toList new)-    -    Map.keys `fmap` findAll maxDepth Map.empty classNamesToFind--reflectClasses :: [String] -> Java [JavaClass]-reflectClasses classes = do+getReflectClasses :: Java (Bool -> [String] -> Java (Map String JavaClass))+-- ^ Creates a function which can be used to gather reflection information+-- about classes identified by their binary name (e.g. @java.lang.Thread$State@).+getReflectClasses = do      (Just clazz)     <- getClass "java.lang.Class"     (Just cField)    <- getClass "java.lang.reflect.Field"@@ -410,7 +280,7 @@                         jgtLowerBounds = lowerBounds'                     } -                _ -> getName genericType >>= return . NotSoGeneric . fromJust+                _ -> return NotSoGeneric                               reflectEnumConstant :: JObject -- of type java.lang.Enum@@ -519,9 +389,6 @@              isActuallyAbstract <- isAbstract modifiers             isActuallyFinal <- isFinal modifiers--            let name        = takeClassName   className-                packageName = takePackageName className                          parents <- asObject clazz                 >>= findParentClasses@@ -563,9 +430,7 @@             isActuallyAnn   <- asObject clazz >>= isAnnotation              return $ JavaClass {-                className = name,-                classPackage = packageName,-                classModName = "", -- is filled in later+                className = className,                 classFields = fields,                 classMethods = methods,                 classParents = parents,@@ -580,5 +445,27 @@                 classFinal = isActuallyFinal             } -    mapM reflectClass classes+        reflectWithDependencies :: String -> Java (JavaClass, Map String (Either String JavaClass))+        reflectWithDependencies clazz = do+            reflected <- reflectClass clazz+            let deps = classDependencies reflected+                depsMap = Map.fromList (zip deps (map Left deps))+            return (reflected, depsMap)++        resolve :: Map String (Either String JavaClass) -> Java (Map String (Either String JavaClass))+        resolve classes = do+            resolved <- T.mapM (either reflectWithDependencies (return . (, Map.empty))) classes+            let newDeps = Map.foldl' Map.union Map.empty (Map.map snd resolved)+                resolved' = Map.map (Right . fst) resolved+                +            return (resolved' `Map.union` newDeps)++        reflect :: Bool -> [String] -> Java (Map String JavaClass)+        reflect findAll classes = do+            let classesMap = (Map.fromList (zip classes (map Left classes)))+            resolved <- (if findAll then exhaustivelyM else id) resolve classesMap+            return (snd (Map.mapEither id resolved))++    return reflect+ 

@@ -21,10 +21,12 @@ -- combinators (see "Data.Generics"). module Language.Java.Reflect.Types where -import Foreign.Java.Utils+ import Data.Int import Data.Data +import Data.List (nub)+ -- type JavaClassCache = Map (String, [JavaType]) JavaClass  -- | A JavaType is either a Primitive Type, an Array, or an Object.@@ -62,8 +64,6 @@ -- | The interface of a Java class. data JavaClass = JavaClass {     className :: String,-    classPackage :: Maybe String,-    classModName :: String,     classParents :: [String],     classIfaces :: [String],     classConstructors :: [JavaConstructor],@@ -98,14 +98,11 @@ classDependencies clazz = concat [     classParents clazz,     classIfaces clazz,-    concatMap fieldDependencies (classFields clazz),-    concatMap methodDependencies (classMethods clazz),-    concatMap constructorDependencies (classConstructors clazz) ]+    concatMap (fieldDependencies typeParams) (classFields clazz),+    concatMap (methodDependencies typeParams) (classMethods clazz),+    concatMap (constructorDependencies typeParams) (classConstructors clazz) ]+  where typeParams = classTypeParams clazz -classFullName :: JavaClass -> String--- ^ Derive the full name from a class definition. See also 'makeName'.-classFullName clazz = makeName (classPackage clazz) (className clazz)-      -- | A Type variable declaration. data JavaTypeParam = JavaTypeParam {@@ -117,6 +114,7 @@ newtype TyVar = TyVar { tyVarName :: String }     deriving (Eq, Ord, Show, Read, Data, Typeable) + data JavaGenericType     = -- | @<? super X>@, @<? extends X>@       Wildcard {@@ -140,13 +138,8 @@         -- | The name of the type variable, e.g. @E@ or @X@.         jgtName :: TyVar     }-    | -- java.lang.Object-      NotSoGeneric {-        -- | A plain type, full name. Used for example in a 'Parameterized'-        -- type, which may be parameterized by a plain type (like-        -- @Class<Number>@.-        jgtBasetype :: String-    } deriving (Eq, Ord, Show, Read, Data, Typeable)+    | NotSoGeneric+    deriving (Eq, Ord, Show, Read, Data, Typeable)  -- | The type of a generic type. data JavaGenericTypeType = WildcardT@@ -162,7 +155,7 @@     (Parameterized _ _)  -> ParameterizedT     (GenericArray _)     -> GenericArrayT     (TypeVarReference _) -> TypeVarReferenceT-    (NotSoGeneric _)     -> NotSoGenericT+    NotSoGeneric         -> NotSoGenericT  -- | The interface to a field in the Java language. data JavaField = JavaField {@@ -172,10 +165,8 @@     fieldStatic :: Bool   } deriving (Eq, Show, Read, Data, Typeable) -fieldDependencies :: JavaField -> [String]-fieldDependencies field = case fst (fieldType field) of-    JObj n -> [n]-    _ -> []+fieldDependencies :: [JavaTypeParam] -> JavaField -> [String]+fieldDependencies tvars field = dependencies tvars [fieldType field]  -- | The interface to a method in the Java language. data JavaMethod = JavaMethod {@@ -192,16 +183,18 @@     methodSynchronized :: Bool   } deriving (Eq, Show, Read, Data, Typeable) -methodDependencies :: JavaMethod -> [String]+methodDependencies :: [JavaTypeParam] -> JavaMethod -> [String] -- ^ Return the full names of all classes that this method -- references in its definition.-methodDependencies method = foldl classReference [] referenced-  where-    referenced = maybe paramTypes (: paramTypes) (fst $ methodReturnType method)-    paramTypes = map fst $ methodParams method-    classReference r c = case c of-        JObj n -> n : r-        _ -> r+methodDependencies tvars method = returnDependency ++ dependencies tvars' (methodParams method)+  where returnDependency = case methodReturnType method of+            (Nothing, _) -> []+            (Just t, gt) -> dependencies tvars' [(t, gt)]+        tvars' = methodTypeParams method ++ tvars+                 -- it is important that the type params are appended+                 -- up front, since lookup will return the first+                 -- (the first is the more appropriate one, since it is+                 -- the one in scope).  -- | A Constructor in the Java language. data JavaConstructor = JavaConstructor {@@ -210,14 +203,44 @@     constructorTypeParams :: [JavaTypeParam]   } deriving (Eq, Show, Read, Data, Typeable) -constructorDependencies :: JavaConstructor -> [String]+constructorDependencies :: [JavaTypeParam] -> JavaConstructor -> [String] -- ^ Retrieve all classes that this constructor definition -- references in its parameters or generic declaration.-constructorDependencies constr = foldl classReference []-                              $ map fst $ constructorParams constr-  where-    classReference r c = case c of-        JObj n -> n : r-        _ -> r+constructorDependencies tvars constr = dependencies tvars' (constructorParams constr)+  where tvars' = constructorTypeParams constr ++ tvars+                 -- it is important that the type params are appended+                 -- up front, since lookup will return the first+                 -- (the first is the more appropriate one, since it is+                 -- the one in scope). +dependencies :: [JavaTypeParam] -> [(JavaType, JavaGenericType)] -> [String]+-- ^ Discovers all types which are mentioned in a list of type declarations,+-- using the type variables that are in scope.+dependencies tyvars = nub . foldr (\(t, gt) ds -> deps t ++ gdeps tyvars gt ++ ds) []+  where+    -- | Find the dependencies of an ordinary type (if any)+    deps t = case t of+        JObj c -> [c]+        JArr c -> deps c -- in case of an array, the dependency+                         -- is on the component type+        _ -> [] -- in all other cases, it is only a primitive type+    -- | Find the dependencies of the generic declaration of that type+    -- (bounds, parameters, etc.)+    gdeps :: [JavaTypeParam] -> JavaGenericType -> [String]+    gdeps tv t = case jgtType t of+        WildcardT+            -> concatMap (gdeps tv) (jgtBounds t ++ jgtLowerBounds t)+        ParameterizedT+            -> jgtBasetype t : concatMap (gdeps tv) (jgtParameters t)+        GenericArrayT+            -> (gdeps tv) (jgtComponentType t)+        TypeVarReferenceT+            -> maybe [] (concatMap (gdeps tv') . paramBounds)+                (lookup tvName (zip (map paramName tv) tyvars))+        NotSoGenericT -> []+      where tvName = jgtName t+            tv' = filter ((/= tvName) . paramName) tv+                  -- remove the current type variable so+                  -- that we do not end up lookin it up in+                  -- an infinite loop (*very* important)