{-# 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