{-# LANGUAGE Haskell2010 , TupleSections #-} {-# 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 Language.Java.Reflect ( getReflectClasses, module Language.Java.Reflect.Types ) where import Language.Java.Reflect.Types 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.Maybe (fromJust) import qualified Data.Traversable as T import Foreign.Java import Haskell.X definitely = maybe (error "The impossible happened! Please report this as a bug.") 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" (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") getFields <- clazz `bindMethod` "getFields" ::= array (object "java.lang.reflect.Field") getReturnType <- cMethod `bindMethod` "getReturnType" ::= object "java.lang.Class" getName <- clazz `bindMethod` "getName" ::= string getMethodName <- cMethod `bindMethod` "getName" ::= string getFieldName <- cField `bindMethod` "getName" ::= string getFieldType <- cField `bindMethod` "getType" ::= object "java.lang.Class" getGenericType <- cField `bindMethod` "getGenericType" ::= object "java.lang.reflect.Type" 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 getModifiersF <- cField `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 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' } _ -> return NotSoGeneric 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 = zip parameters genericParams, constructorTypeParams = typeParams, constructorExceptions = [] } reflectField :: JObject -- of type java.lang.reflect.Field -> Java JavaField reflectField field = do (Just name) <- getFieldName field modifiers <- getModifiersF field fieldType <- getFieldType field >>= definitely reflectType >>= definitely return genericType <- getGenericType field >>= definitely reflectGenericType isActuallyStatic <- isStatic modifiers isActuallyFinal <- isStatic modifiers return $ JavaField { fieldName = name, fieldType = (fieldType, genericType), fieldFinal = isActuallyFinal, fieldStatic = isActuallyStatic } 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 isActuallyFinal <- isFinal modifiers isActuallyNative <- isNative modifiers isActuallySynchronized <- isSynchronized modifiers return $ JavaMethod { methodName = name, methodName' = "", -- filled in later on methodParams = zip parameters genericParams, methodReturnType = (returnType, genericReturnType), methodTypeParams = typeParams, methodExceptions = [], methodStatic = isActuallyStatic, methodAbstract = isActuallyAbstract, 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 parents <- asObject clazz >>= findParentClasses >>= mapM (fmap fromJust . getName) interfaces <- asObject clazz >>= getInterfaces >>= maybe (return []) toList >>= mapM (getName . maybe undefined id) >>= mapM (maybe undefined return) fields <- asObject clazz >>= getFields >>= maybe (return []) toList >>= mapM (maybe undefined reflectField) 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 = className, classFields = fields, classMethods = methods, classParents = parents, classIfaces = interfaces, classConstructors = constructors, classTypeParams = parameters, classEnum = isActuallyEnum, classEnumConstants = enumConstants, classIface = isActuallyIface, classAnnotation = isActuallyAnn, classAbstract = isActuallyAbstract, classFinal = isActuallyFinal } 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