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 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))
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")
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'
}
_ -> return NotSoGeneric
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
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