module Language.Java.Reflect (
findClasses,
reflectClasses,
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.Word
import Data.Maybe (fromJust)
import Foreign.Java
import Foreign.Java.Utils
definitely = maybe (error "The impossible happened! Please report this as a bug.")
type Class = ([String], (Maybe String, [String]))
findClasses :: Word32 -> [String] -> Java [String]
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
(Just returnType) <- getReturnType method >>= getClassName . fromJust
return (returnType : args)
readConstructor :: JObject -> Java [String]
readConstructor constr = do
args <- readConstructorParameters 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 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")
getTypeVariableName <- cTypeV `bindMethod` "getName"
::= string
getTypeVariableBounds <- cTypeV `bindMethod` "getBounds"
::= array (object "java.lang.reflect.Type")
getActualTypeArguments <- cParamT `bindMethod` "getActualTypeArguments"
::= array (object "java.lang.reflect.Type")
getRawType <- cParamT `bindMethod` "getRawType"
::= object "java.lang.reflect.Type"
getLowerBounds <- cWildT `bindMethod` "getLowerBounds"
::= array (object "java.lang.reflect.Type")
getUpperBounds <- cWildT `bindMethod` "getUpperBounds"
::= array (object "java.lang.reflect.Type")
getGenericComponentType <- cGenArrT `bindMethod` "getGenericComponentType"
::= object "java.lang.reflect.Type"
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
-> Java [JObject]
findParentClasses clazz = do
parent <- getSuperclass clazz
case parent of
(Just parent) -> do
parents <- findParentClasses parent
return $ parent : parents
_ -> return []
reflectType :: JObject
-> 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)
_ | 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
-> 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
-> 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
-> Java (Int32, String)
reflectEnumConstant enumConstant = do
(Just name) <- getEnumName enumConstant
ordinal <- getEnumOrdinal enumConstant
return (ordinal, name)
reflectConstructor :: JObject
-> 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
-> 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
-> 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' = "",
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
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)
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 = name,
classPackage = packageName,
classModName = "",
classFields = fields,
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