{-# LANGUAGE Haskell2010 #-} {-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing #-} -- | -- Module : Foreign.Java.Bindings.ReflectJava -- Copyright : (c) Julian Fleischer 2013 -- License : MIT (See LICENSE file in cabal package) -- -- Maintainer : julian.fleischer@fu-berlin.de -- Stability : provisional -- -- Methods for reflecting Java classes using a JVM as source of information. module Foreign.Java.Bindings.ReflectJava where 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 Foreign.Java import Foreign.Java.Bindings.JavaTypes import Foreign.Java.Utils -- ( -- [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" getMethods <- clazz `bindMethod` "getMethods" ::= array (object "java.lang.reflect.Method") getConstructors <- clazz `bindMethod` "getConstructors" ::= array (object "java.lang.reflect.Constructor") 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 superclass <- getSuperclass clazz >>= maybe (return Nothing) getClassName interfaces <- getInterfaces clazz >>= toList . fromJust >>= mapM (getClassName . fromJust) >>= return . map fromJust return (constructors ++ methods, (superclass, interfaces)) 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 (Just clazz) <- getClass "java.lang.Class" (Just cMethod) <- getClass "java.lang.reflect.Method" (Just cConstr) <- getClass "java.lang.reflect.Constructor" (Just cTypeV) <- getClass "java.lang.reflect.TypeVariable" (Just cParamT) <- getClass "java.lang.reflect.ParameterizedType" (Just cWildT) <- getClass "java.lang.reflect.WildcardType" (Just cGenArrT) <- getClass "java.lang.reflect.GenericArrayType" (Just cEnum) <- getClass "java.lang.Enum" (Just modifiers) <- getClass "java.lang.reflect.Modifier" getMethods <- clazz `bindMethod` "getMethods" ::= array (object "java.lang.reflect.Method") getReturnType <- cMethod `bindMethod` "getReturnType" ::= object "java.lang.Class" getName <- clazz `bindMethod` "getName" ::= string getMethodName <- cMethod `bindMethod` "getName" ::= string getParameters <- cMethod `bindMethod` "getParameterTypes" ::= array (object "java.lang.Class") getParameters' <- cConstr `bindMethod` "getParameterTypes" ::= array (object "java.lang.Class") getGenericParametersM <- cMethod `bindMethod` "getGenericParameterTypes" ::= array (object "java.lang.reflect.Type") getGenericParametersC <- cConstr `bindMethod` "getGenericParameterTypes" ::= array (object "java.lang.reflect.Type") getGenericReturnType <- cMethod `bindMethod` "getGenericReturnType" ::= object "java.lang.reflect.Type" getSuperclass <- clazz `bindMethod` "getSuperclass" ::= object "java.lang.Class" getInterfaces <- clazz `bindMethod` "getInterfaces" ::= array (object "java.lang.Class") getModifiersC <- clazz `bindMethod` "getModifiers" ::= int getModifiersM <- cMethod `bindMethod` "getModifiers" ::= int getConstructors <- clazz `bindMethod` "getConstructors" ::= array (object "java.lang.reflect.Constructor") getComponentType <- clazz `bindMethod` "getComponentType" ::= object "java.lang.Class" getEnumConstants <- clazz `bindMethod` "getEnumConstants" ::= array (object "java.lang.Object") getTypeParameters <- clazz `bindMethod` "getTypeParameters" ::= array (object "java.lang.reflect.TypeVariable") getTypeParametersC <- cConstr `bindMethod` "getTypeParameters" ::= array (object "java.lang.reflect.TypeVariable") getTypeParametersM <- cMethod `bindMethod` "getTypeParameters" ::= array (object "java.lang.reflect.TypeVariable") -- reflect TypeVariables getTypeVariableName <- cTypeV `bindMethod` "getName" ::= string getTypeVariableBounds <- cTypeV `bindMethod` "getBounds" ::= array (object "java.lang.reflect.Type") -- reflect ParameterizedTypes getActualTypeArguments <- cParamT `bindMethod` "getActualTypeArguments" ::= array (object "java.lang.reflect.Type") getRawType <- cParamT `bindMethod` "getRawType" ::= object "java.lang.reflect.Type" -- reflect WildcardTypes getLowerBounds <- cWildT `bindMethod` "getLowerBounds" ::= array (object "java.lang.reflect.Type") getUpperBounds <- cWildT `bindMethod` "getUpperBounds" ::= array (object "java.lang.reflect.Type") -- reflect GenericArrayTypes getGenericComponentType <- cGenArrT `bindMethod` "getGenericComponentType" ::= object "java.lang.reflect.Type" -- reflect Enum types getEnumName <- cEnum `bindMethod` "name" ::= string getEnumOrdinal <- cEnum `bindMethod` "ordinal" ::= int isAnnotation <- clazz `bindMethod` "isAnnotation" ::= boolean isArray <- clazz `bindMethod` "isArray" ::= boolean isEnum <- clazz `bindMethod` "isEnum" ::= boolean isInterface <- clazz `bindMethod` "isInterface" ::= boolean isPrimitive <- clazz `bindMethod` "isPrimitive" ::= boolean isStatic <- modifiers `bindStaticMethod` "isStatic" ::= int --> boolean isAbstract <- modifiers `bindStaticMethod` "isAbstract" ::= int --> boolean isPublic <- modifiers `bindStaticMethod` "isPublic" ::= int --> boolean isFinal <- modifiers `bindStaticMethod` "isFinal" ::= int --> boolean isNative <- modifiers `bindStaticMethod` "isNative" ::= int --> boolean isSynchronized <- modifiers `bindStaticMethod` "isSynchronized" ::= int --> boolean (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 findParentClasses :: JObject -- of type java.lang.Class -> Java [JObject] findParentClasses clazz = do parent <- getSuperclass clazz case parent of (Just parent) -> do parents <- findParentClasses parent return $ parent : parents _ -> return [] reflectType :: JObject -- of type java.lang.Class -> Java (Maybe JavaType) reflectType javatype = do isActuallyPrimitive <- isPrimitive javatype isActuallyAnArray <- isArray javatype case undefined of _ | isActuallyPrimitive -> do stringRepresentation <- toString javatype return $ case stringRepresentation of "boolean" -> Just JBoolean "char" -> Just JChar "byte" -> Just JByte "short" -> Just JShort "int" -> Just JInt "long" -> Just JLong "float" -> Just JFloat "double" -> Just JDouble "void" -> Nothing x -> error ("can't be: " ++ show x) -- these are all primitive types _ | isActuallyAnArray -> do (Just componentType) <- getComponentType javatype reflectType componentType >>= return . Just . JArr . fromJust _otherwiseItsAnObjectType -> do (Just name) <- getName javatype return $ Just $ JObj { typeName = name } reflectTypeParameter :: JObject -- of type java.lang.reflect.TypeVariable -> Java JavaTypeParam reflectTypeParameter typeParameter = do (Just name) <- getTypeVariableName typeParameter (Just bounds) <- getTypeVariableBounds typeParameter bounds' <- toList bounds >>= mapM (reflectGenericType . fromJust) return $ JavaTypeParam { paramName = (TyVar name), paramBounds = bounds' } reflectGenericType :: JObject -- of type java.lang.reflect.Type -> Java JavaGenericType reflectGenericType genericType = do isGenericArrayType <- genericType `isInstanceOf` cGenArrT isParameterizedType <- genericType `isInstanceOf` cParamT isTypeVariable <- genericType `isInstanceOf` cTypeV isWildcardType <- genericType `isInstanceOf` cWildT case undefined of _ | isGenericArrayType -> do (Just basetype) <- getGenericComponentType genericType reflectedType <- reflectGenericType basetype return $ GenericArray { jgtComponentType = reflectedType } _ | isParameterizedType -> do (Just typeargs) <- getActualTypeArguments genericType (Just basetype) <- getRawType genericType isClass <- basetype `isInstanceOf` clazz basetypeName <- if isClass then getName basetype >>= return . fromJust else fail "Type parameterized on a type variable. That was not possible <= Java 8." parameters <- toList typeargs >>= mapM (reflectGenericType . fromJust) return $ Parameterized { jgtBasetype = basetypeName, jgtParameters = parameters } _ | isTypeVariable -> do (Just name) <- getTypeVariableName genericType return $ TypeVarReference { jgtName = (TyVar name) } _ | isWildcardType -> do (Just lowerBounds) <- getLowerBounds genericType (Just bounds) <- getUpperBounds genericType lowerBounds' <- toList lowerBounds >>= mapM (reflectGenericType . fromJust) bounds' <- toList bounds >>= mapM (reflectGenericType . fromJust) return $ Wildcard { jgtBounds = bounds', jgtLowerBounds = lowerBounds' } _ -> getName genericType >>= return . NotSoGeneric . fromJust reflectEnumConstant :: JObject -- of type java.lang.Enum -> Java (Int32, String) reflectEnumConstant enumConstant = do (Just name) <- getEnumName enumConstant ordinal <- getEnumOrdinal enumConstant return (ordinal, name) reflectConstructor :: JObject -- of type java.lang.reflect.Constructor -> Java JavaConstructor reflectConstructor constructor = do parameters <- getParameters' constructor >>= maybe (return []) toList >>= mapM (fmap fromJust . reflectType . fromJust) genericParams <- getGenericParametersC constructor >>= maybe (return []) toList >>= mapM (reflectGenericType . fromJust) typeParams <- getTypeParametersC constructor >>= maybe (return []) toList >>= mapM (reflectTypeParameter . fromJust) return $ JavaConstructor { constructorParams = parameters, constructorGenericParams = genericParams, constructorTypeParams = typeParams } reflectMethod :: JObject -- of type java.lang.reflect.Method -> Java JavaMethod reflectMethod method = do (Just name) <- getMethodName method modifiers <- getModifiersM method returnType <- getReturnType method >>= maybe (return Nothing) reflectType parameters <- getParameters method >>= maybe (return []) toList >>= mapM (fmap fromJust . reflectType . fromJust) genericParams <- getGenericParametersM method >>= maybe (return []) toList >>= mapM (reflectGenericType . fromJust) genericReturnType <- getGenericReturnType method >>= reflectGenericType . fromJust typeParams <- getTypeParametersM method >>= maybe (return []) toList >>= mapM (reflectTypeParameter . fromJust) isActuallyStatic <- isStatic modifiers isActuallyAbstract <- isAbstract modifiers isActuallyPublic <- isPublic modifiers isActuallyFinal <- isFinal modifiers isActuallyNative <- isNative modifiers isActuallySynchronized <- isSynchronized modifiers return $ JavaMethod { methodName = name, methodName' = "", -- filled in later on methodParams = parameters, methodReturnType = returnType, methodGenericParams = genericParams, methodGenericReturnType = genericReturnType, methodTypeParams = typeParams, methodStatic = isActuallyStatic, methodAbstract = isActuallyAbstract, methodPublic = isActuallyPublic, methodFinal = isActuallyFinal, methodNative = isActuallyNative, methodSynchronized = isActuallySynchronized } reflectClass :: String -> Java JavaClass reflectClass className = do (Just clazz) <- callMethod loadClass systemClassLoader className False modifiers <- getModifiersC clazz isActuallyAbstract <- isAbstract modifiers isActuallyFinal <- isFinal modifiers let name = takeClassName className packageName = takePackageName className parents <- asObject clazz >>= findParentClasses >>= mapM (fmap fromJust . getName) interfaces <- asObject clazz >>= getInterfaces >>= maybe (return []) toList >>= mapM (getName . maybe undefined id) >>= mapM (maybe undefined return) methods <- asObject clazz >>= getMethods >>= maybe (return []) toList >>= mapM (maybe undefined reflectMethod) constructors <- asObject clazz >>= getConstructors >>= maybe (return []) toList >>= mapM (maybe undefined reflectConstructor) parameters <- asObject clazz >>= getTypeParameters >>= maybe (return []) toList >>= mapM (maybe undefined reflectTypeParameter) enumConstants <- asObject clazz >>= getEnumConstants >>= maybe (return []) toList >>= mapM (maybe undefined reflectEnumConstant) isActuallyEnum <- asObject clazz >>= isEnum isActuallyIface <- asObject clazz >>= isInterface isActuallyAnn <- asObject clazz >>= isAnnotation return $ JavaClass { className = name, classPackage = packageName, classModName = "", -- is filled in later classMethods = methods, classParents = parents, classIfaces = interfaces, classConstructors = constructors, classTypeParams = parameters, classEnum = isActuallyEnum, classEnumConstants = enumConstants, classIface = isActuallyIface, classAnnotation = isActuallyAnn, classAbstract = isActuallyAbstract, classFinal = isActuallyFinal } mapM reflectClass classes