java-bridge-0.99: src/Foreign/Java.cpphs
{-# LANGUAGE Haskell2010
, MultiParamTypeClasses
, FunctionalDependencies
, FlexibleInstances
, FlexibleContexts
, UndecidableInstances
#-}
{-# OPTIONS
-Wall
-fno-warn-missing-signatures
-fno-warn-name-shadowing
#-}
-- |
-- Module : Foreign.Java
-- Copyright : (c) Julian Fleischer 2013
-- License : MIT (See LICENSE file in cabal package)
--
-- Maintainer : julian.fleischer@fu-berlin.de
-- Stability : provisional
-- Portability : non-portable (see LANGUAGE pragma)
--
-- This module contains the medium level interface to the Java Bridge.
--
-- See "Foreign.Java.JNI.Safe" and "Foreign.Java.JNI.Unsafe" for the low
-- level interface which is a plain translation of the Java Native
-- Interface. Information about the library can be retrieved using
-- "Foreign.Java.JNI".
--
-- High level bindings can be generated using "Foreign.Java.Bindings".
module Foreign.Java (
-- * Medium Level Java Interface
-- $medium_level_intro
-- ** Obtaining Class and Method References
-- $obtaining_references
-- ** Calling Methods
-- $calling_methods
-- * Reference
-- ** The Java Monad
Java,
runJava,
runJava',
initJava,
setUnsafe,
runJavaGui,
runJavaGui',
-- ** Classes and Objects
getClass,
getConstructor,
-- *** Object creation
newObject,
newObjectE,
newObjectX,
newObjectFrom,
newObjectFromE,
newObjectFromX,
-- ** Methods
getMethod,
getStaticMethod,
bindMethod,
bindStaticMethod,
-- *** Method invocation
callMethod,
callMethodE,
callMethodX,
callStaticMethod,
callStaticMethodE,
callStaticMethodX,
-- ** Fields
getField,
getStaticField,
readField,
readStaticField,
writeField,
writeStaticField,
-- ** Arrays
arrayLength,
JavaArray (..),
-- ** Objects
JavaObject (..),
isInstanceOf,
-- ** Utilities
io,
-- | Re-exported for convenience when dealing with high-level bindings.
module Foreign.Java.Value,
-- *** Interaction with IO
liftIO,
forkJava,
waitJava,
-- ** JVM data
JVM,
JClass,
JObject,
JArray,
JField,
JStaticField,
JMethod,
JStaticMethod,
JConstructor,
JThrowable,
JavaThreadId,
-- ** Method discovery
MethodDescriptor (..),
(-->),
void,
boolean,
char,
byte,
short,
int,
long,
float,
double,
object,
string,
array
) where
import Control.Exception
import Control.Monad.State hiding (void)
import qualified Control.Monad.State as State
import Data.Maybe
import Data.Int
import Data.Word
-- The monad class and associated functions come from
-- the following module:
import Foreign.Java.JavaMonad
import qualified Foreign.Java.JNI.Safe as JNI
import qualified Foreign.Java.JNI.Unsafe as Unsafe
import qualified Foreign.Java.JNI.Types as Core
import Foreign.Java.JNI.Types (
JObject (..),
JClass (..),
JThrowable (..),
JArray (..)
)
import Foreign hiding (void)
import Foreign.C.String
import Foreign.Java.Types
import Foreign.Java.Util
import Foreign.Java.Value
-- | INTERNAL Checks whether an exception has occurred in the
-- virtual machine and returns either a @Left JThrowable@
-- if that is so or a @Right a@ where a is the excepted type
-- of the result.
check result = do
vm <- getVM
safe <- getSafe
let excOccurredClear = if safe then JNI.exceptionOccurredClear
else Unsafe.exceptionOccurredClear
release = if safe then JNI.release else Unsafe.release
exc <- io $ excOccurredClear vm
if exc /= nullPtr
then do ptr <- io $ newForeignPtr release exc
return $ Left (JThrowable ptr)
else do return $ Right result
throwJavaException :: JThrowable -> Java a
-- | INTERNAL This function is used to really throw a JThrowable,
-- that is to throw a Java Exception as an exception in Haskell.
throwJavaException throwable = do
strMessage <- toString throwable
io $ throw $ JavaException strMessage throwable
-- | Provides basic functions that every Java Object supports.
-- There are instances for 'JObject', 'JClass', 'JThrowable',
-- and 'JArray' (which are all references to objects in the
-- virtual machine).
--
-- Minimal complete definition: 'asObject'.
class JavaObject a where
-- | Invokes the @toString@ method which every Java Object has.
toString :: a -> Java String
-- | Invokes the @hashCode@ method which every Java Object has.
hashCode :: a -> Java Int32
-- | Turns the reference into a JObject. This can be used
-- to down-cast any reference to an Object inside the JVM
-- to a JObject.
asObject :: a -> Java JObject
-- | Returns a reference to the Class of the given object.
classOf :: a -> Java JClass
-- | Returns a string representation of the type.
jtypeOf :: a -> Java String
-- | Checks two objects for equality using their @equals@ methods.
equals :: JavaObject b => a -> b -> Java Bool
toString obj = asObject obj >>= toString
hashCode obj = asObject obj >>= hashCode
classOf obj = asObject obj >>= classOf
jtypeOf obj = do
(Just clazz) <- getClass "java.lang.Class"
getName <- clazz `bindMethod` "getName" ::= string
classOf obj >>= asObject >>= getName >>= return . maybe "" id
equals this obj = do
this' <- asObject this
object <- asObject obj
this' `equals` object
instance JavaObject JObject where
toString obj = do
clazz <- classOf obj
state <- State.get
toString <- case jvmToString state of
Nothing -> do
method <- clazz `bindMethod` "toString" ::= string
State.put (state { jvmToString = Just method })
return method
(Just method) -> return method
toString obj $> maybe "" id
hashCode obj = do
clazz <- classOf obj
state <- State.get
hashCode <- case jvmHashCode state of
Nothing -> do
method <- clazz `bindMethod` "hashCode" ::= int
State.put (state { jvmHashCode = Just method })
return method
(Just method) -> return method
hashCode obj
asObject = return
classOf (JObject obj) = do
safe <- getSafe
vm <- getVM
ptr <- io (withForeignPtr obj $
\p -> (if safe then JNI.getObjectClass
else Unsafe.getObjectClass) vm p)
JClass <$ io (newForeignPtr (if safe then JNI.release
else Unsafe.release) ptr)
equals this obj = do
clazz <- classOf this
equals <- clazz `bindMethod`
"equals" ::= object "java.lang.Object" --> boolean
object <- asObject obj
this `equals` Just object
-- | Every JArray is a JavaObject.
instance JavaObject (JArray L) where
toString arr = toList arr
>>= mapM (maybe (return "null") toString)
>>= return . show
asObject (JArray _ ptr) = return (JObject ptr)
-- further instances for primitive types are below
-- | Every JClass is a JavaObject.
instance JavaObject JClass where
asObject (JClass ptr) = return (JObject $ castForeignPtr ptr)
-- | Every JThrowable is a JavaObject.
instance JavaObject JThrowable where
asObject (JThrowable ptr) = return (JObject $ castForeignPtr ptr)
arrayLength :: JArray e -> Java Int32
-- ^ Return the length of an JArray.
arrayLength (JArray size _) = return size
class JavaArray e a | e -> a where
at :: JArray e -> Int32 -> Java a
write :: JArray e -> Int32 -> a -> Java ()
toList :: JArray e -> Java [a]
toList arr@(JArray size _) = forM [0..size-1] (arr `at`)
#define JAVA_ARRAY(TYPE, RESULT, GETTER, SETTER, ARG, GET, SET) \
instance JavaArray TYPE RESULT where {\
at = _get GETTER GET (\s v -> s { GET = v }) ARG ;\
write = _set SETTER SET (\s v -> s { SET = v }) ARG }\
;\
instance JavaObject (JArray TYPE) where {\
toString arr = toList arr >>= return . show ;\
asObject (JArray _ ptr) = return (JObject ptr) }
JAVA_ARRAY(Z, Bool, "getBoolean", "setBoolean", boolean, jvmGetZ, jvmSetZ)
JAVA_ARRAY(C, Word16, "getChar", "setChar", char, jvmGetC, jvmSetC)
JAVA_ARRAY(B, Int8, "getByte", "setByte", byte, jvmGetB, jvmSetB)
JAVA_ARRAY(S, Int16, "getShort", "setShort", short, jvmGetS, jvmSetS)
JAVA_ARRAY(I, Int32, "getInt", "setInt", int, jvmGetI, jvmSetI)
JAVA_ARRAY(J, Int64, "getLong", "setLong", long, jvmGetJ, jvmSetJ)
JAVA_ARRAY(D, Double, "getDouble", "setDouble", double, jvmGetD, jvmSetD)
JAVA_ARRAY(F, Float, "getFloat", "setFloat", float, jvmGetF, jvmSetF)
instance JavaArray L (Maybe JObject) where
at = _get "get" jvmGetL (\s v -> s { jvmGetL = v }) (object "java.lang.Object")
write = _set "set" jvmSetL (\s v -> s { jvmSetL = v }) (object "java.lang.Object")
instance JavaArray (A e) (Maybe (JArray e)) where
at arr ix = do
let get = _get "get" jvmGetL (\s v -> s { jvmGetL = v }) (object "java.lang.Object")
result <- get arr ix
case result of
(Just (JObject ptr)) -> do
vm <- getVM
safe <- getSafe
length <- io $ withForeignPtr ptr $ \ptr ->
(if safe then JNI.getArrayLength
else Unsafe.getArrayLength) vm ptr
return $ Just $ JArray length ptr
Nothing -> return Nothing
write arr ix arg = do
let set = _set "set" jvmSetL (\s v -> s { jvmSetL = v }) (object "java.lang.Object")
case arg of
Nothing -> set arr ix Nothing
(Just (JArray _ ptr)) -> set arr ix (Just (JObject ptr))
_get getter get set result (JArray size arr) ix
| ix < 0 || ix >= size = fail $ "Index out of bounds (read): " ++ show ix
| otherwise = do
state <- State.get
-- get the getter function cached in the monad
-- or if there is none look it up in the VM.
method <- case get state of
Nothing -> do
(Just arrayClass) <- getClass "java.lang.reflect.Array"
m <- arrayClass `bindStaticMethod` getter
::= object "java.lang.Object" --> int --> result
State.put $ set state $ Just $ m
return m
Just m -> return m
method (Just $ JObject arr) ix
_set setter get set arg (JArray size arr) ix value
| ix < 0 || ix >= size = fail $ "Index out of bounds (write): " ++ show ix
| otherwise = do
state <- State.get
-- get the setter function cached in the monad
-- of if there is none look it up in the VM.
method <- case get state of
Nothing -> do
(Just arrayClass) <- getClass "java.lang.reflect.Array"
m <- arrayClass `bindStaticMethod` setter
::= object "java.lang.Object" --> int --> arg --> void
State.put $ set state $ Just $ m
return m
Just m -> return m
method (Just $ JObject arr) ix value
newObject, newObjectX :: JClass
-> Java (Maybe JObject)
newObject clazz = newObjectE clazz
>>= either (\exc -> toString exc >>= fail) return
newObjectE :: JClass
-> Java (Either JThrowable (Maybe JObject))
newObjectE clazz = newObjectX clazz >>= check
newObjectX clazz = do
vm <- getVM
safe <- getSafe
ptr <- io $ do
csig <- newCString "()V"
cptr <- withForeignPtr (jclassPtr clazz) $ \p ->
(if safe then JNI.getConstructorID
else Unsafe.getConstructorID) vm p csig
free csig
return cptr
if ptr == nullPtr
then return $ fail "no default constructor"
else do
obj <- io $ withForeignPtr (jclassPtr clazz) $ \p ->
(if safe then JNI.newObject
else Unsafe.newObject) vm p ptr nullPtr
if obj == nullPtr
then return (fail "could not create object")
else io (newForeignPtr (if safe then JNI.release
else Unsafe.release) obj)
>>= return . return . JObject
-- getConstructor
data JConstructor a = JConstructor (ForeignPtr Core.JClassRef)
(Ptr Core.JConstructorID) a
deriving Show
infixl 7 `getConstructor`
getConstructor clazz p = do
vm <- getVM
safe <- getSafe
ptr <- io $ do
csig <- newCString $ constructorSignature p
cID <- withForeignPtr (jclassPtr clazz) $ \p -> do
(if safe then JNI.getConstructorID
else Unsafe.getConstructorID) vm p csig
free csig
return cID
return $ if ptr == nullPtr
then fail "No such constructor"
else return $ JConstructor (jclassPtr clazz) ptr p
-- createObject
newObjectFrom :: (NewObject p b) => JConstructor p -> b
newObjectFrom (JConstructor clazz ptr t) =
_newObject (ConstructorH clazz ptr) [] t
newObjectFromE :: (NewObjectE p b) => JConstructor p -> b
newObjectFromE (JConstructor clazz ptr t) =
_newObjectE (ConstructorH clazz ptr) [] t
newObjectFromX :: (NewObjectX p b) => JConstructor p -> b
newObjectFromX (JConstructor clazz ptr t) =
_newObjectX (ConstructorH clazz ptr) [] t
data ConstructorH = ConstructorH (ForeignPtr Core.JClassRef)
(Ptr Core.JConstructorID) deriving Show
class NewObject a b | a -> b
where _newObject :: ConstructorH -> [Core.JArg] -> a -> b
class NewObjectE a b | a -> b
where _newObjectE :: ConstructorH -> [Core.JArg] -> a -> b
class NewObjectX a b | a -> b
where _newObjectX :: ConstructorH -> [Core.JArg] -> a -> b
instance (JArg t v, NewObject x b) => NewObject (P t x) (v -> b) where
_newObject m args (P t x) val = _newObject m (jarg t val : args) x
instance (JArg t v, NewObjectE x b) => NewObjectE (P t x) (v -> b) where
_newObjectE m args (P t x) val = _newObjectE m (jarg t val : args) x
instance (JArg t v, NewObjectX x b) => NewObjectX (P t x) (v -> b) where
_newObjectX m args (P t x) val = _newObjectX m (jarg t val : args) x
#define NEW_OBJECT(TYPE, RESULT) \
instance NewObject TYPE (RESULT -> Java (Maybe JObject)) \
where { _newObject = nuObject }\
;\
instance NewObjectX TYPE (RESULT -> Java (Maybe JObject)) \
where { _newObjectX = nuObjectX }\
;\
instance NewObjectE TYPE \
(RESULT -> Java (Either JThrowable (Maybe JObject))) where \
{ _newObjectE = nuObjectE }
NEW_OBJECT(Z, Bool)
NEW_OBJECT(C, Word16)
NEW_OBJECT(B, Int8)
NEW_OBJECT(S, Int16)
NEW_OBJECT(I, Int32)
NEW_OBJECT(J, Int64)
NEW_OBJECT(F, Float)
NEW_OBJECT(D, Double)
NEW_OBJECT(L, Maybe JObject)
NEW_OBJECT(Q, Maybe JObject)
NEW_OBJECT(X, String)
NEW_OBJECT((A e), Maybe (JArray e))
nuObject c args t val = nuObjectE c args t val
>>= either (\exc -> toString exc >>= fail) return
nuObjectE c args t val = nuObjectX c args t val >>= check
nuObjectX (ConstructorH clazz cid) args t val = do
vm <- getVM
safe <- getSafe
ptr <- liftIO $ do
let mkValues = (if safe then JNI.mkJValues
else Unsafe.mkJValues)
jvalues <- mkValues vm $ reverse (jarg t val : args)
jobject <- withForeignPtr clazz $ \p ->
(if safe then JNI.newObject
else Unsafe.newObject) vm p cid jvalues
free jvalues
return jobject
if ptr == nullPtr
then return (fail "Object could not be created")
else io (newForeignPtr (if safe then JNI.release
else Unsafe.release) ptr)
>>= return . return . JObject
-- getStaticMethod
data JStaticMethod a = JStaticMethod (ForeignPtr Core.JClassRef)
(Ptr Core.JStaticMethodID) a
deriving Show
infixl 7 `getStaticMethod`
getStaticMethod :: (Method (p -> String))
=> JClass
-> MethodDescriptor p
-> Java (Maybe (JStaticMethod p))
getStaticMethod clazz (name ::= p) = do
vm <- getVM
safe <- getSafe
ptr <- liftIO $ do
cname <- newCString name
csig <- newCString $ methodSignature p
let getStaticMethodID = if safe then JNI.getStaticMethodID
else Unsafe.getStaticMethodID
methodID <- withForeignPtr (jclassPtr clazz) $ \p -> do
getStaticMethodID vm p cname csig
free cname >> free csig
return methodID
return $ if ptr == nullPtr
then fail "No such static method"
else return $ JStaticMethod (jclassPtr clazz) ptr p
-- bindStaticMethod
infixl 7 `bindStaticMethod`
bindStaticMethod :: (Method (p -> String), StaticCall p b)
=> JClass
-> MethodDescriptor p
-> Java b
bindStaticMethod c m =
getStaticMethod c m $> fromJust $> callStaticMethod
-- bindMethod
infixl 7 `bindMethod`
bindMethod :: (Method (p -> String), MethodCall p b)
=> JClass
-> MethodDescriptor p
-> Java (JObject -> b)
bindMethod c m = getMethod c m $> fromJust $> callMethod
-- getMethod
data JMethod a = JMethod (ForeignPtr Core.JClassRef) (Ptr Core.JMethodID) a
deriving Show
infixl 7 `getMethod`
getMethod :: (Method (p -> String))
=> JClass -> MethodDescriptor p -> Java (Maybe (JMethod p))
getMethod clazz (name ::= p) = do
vm <- getVM
safe <- getSafe
ptr <- liftIO $ do
cname <- newCString name
csig <- newCString $ methodSignature p
let getMethod = if safe then JNI.getMethodID
else Unsafe.getMethodID
methodID <- withForeignPtr (jclassPtr clazz) $
\p -> getMethod vm p cname csig
free cname >> free csig
return methodID
return $ if ptr == nullPtr
then fail "No such method"
else return $ JMethod (jclassPtr clazz) ptr p
callStaticMethod :: (StaticCall p b) => JStaticMethod p -> b
callStaticMethod (JStaticMethod clazz ptr t) =
_staticCall (StaticH clazz ptr) [] t
callStaticMethodE :: (StaticCallE p b) => JStaticMethod p -> b
callStaticMethodE (JStaticMethod clazz ptr t) =
_staticCallE (StaticH clazz ptr) [] t
callStaticMethodX :: (StaticCallX p b) => JStaticMethod p -> b
callStaticMethodX (JStaticMethod clazz ptr t) =
_staticCallX (StaticH clazz ptr) [] t
data StaticH = StaticH (ForeignPtr Core.JClassRef)
(Ptr Core.JStaticMethodID)
deriving Show
class StaticCall a b | a -> b
where _staticCall :: StaticH -> [Core.JArg] -> a -> b
class StaticCallE a b | a -> b
where _staticCallE :: StaticH -> [Core.JArg] -> a -> b
class StaticCallX a b | a -> b
where _staticCallX :: StaticH -> [Core.JArg] -> a -> b
instance (JArg t v, StaticCall x b) => StaticCall (P t x) (v -> b)
where _staticCall m args (P t x) val =
_staticCall m (jarg t val : args) x
instance (JArg t v, StaticCallE x b) => StaticCallE (P t x) (v -> b)
where _staticCallE m args (P t x) val =
_staticCallE m (jarg t val : args) x
instance (JArg t v, StaticCallX x b) => StaticCallX (P t x) (v -> b)
where _staticCallX m args (P t x) val =
_staticCallX m (jarg t val : args) x
#define STATIC_CALL(TYPE, RESULT, RETURN, SAFE, UNSAFE) \
instance StaticCall TYPE (Java RESULT) where {\
_staticCall m a t = do safe <- getSafe ;\
staticCall (if safe then SAFE \
else UNSAFE) \
RETURN m a t }\
;\
instance StaticCallE TYPE (Java (Either JThrowable RESULT)) where {\
_staticCallE m a t = do safe <- getSafe ;\
staticCallE (if safe then SAFE \
else UNSAFE) \
RETURN m a t }\
;\
instance StaticCallX TYPE (Java RESULT) where {\
_staticCallX m a t = do safe <- getSafe ;\
staticCallX (if safe then SAFE \
else UNSAFE) \
RETURN m a t }
STATIC_CALL(V, (), return, JNI.callStaticVoidMethod,
Unsafe.callStaticVoidMethod)
STATIC_CALL(Z, Bool, return, JNI.callStaticBooleanMethod,
Unsafe.callStaticBooleanMethod)
STATIC_CALL(C, Word16, return, JNI.callStaticCharMethod,
Unsafe.callStaticCharMethod)
STATIC_CALL(B, Int8, return, JNI.callStaticByteMethod,
Unsafe.callStaticByteMethod)
STATIC_CALL(S, Int16, return, JNI.callStaticShortMethod,
Unsafe.callStaticShortMethod)
STATIC_CALL(I, Int32, return, JNI.callStaticIntMethod,
Unsafe.callStaticIntMethod)
STATIC_CALL(J, Int64, return, JNI.callStaticLongMethod,
Unsafe.callStaticLongMethod)
STATIC_CALL(F, Float, (return . realToFrac),
JNI.callStaticFloatMethod, Unsafe.callStaticFloatMethod)
STATIC_CALL(D, Double, (return . realToFrac),
JNI.callStaticDoubleMethod, Unsafe.callStaticDoubleMethod)
STATIC_CALL(X, (Maybe String), returnString,
JNI.callStaticStringMethod,Unsafe.callStaticStringMethod)
STATIC_CALL(L, (Maybe JObject), returnObject,
JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)
STATIC_CALL(Q, (Maybe JObject), returnObject,
JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)
STATIC_CALL((A e), (Maybe (JArray e)), returnArray,
JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)
staticCall, staticCallX
:: (Ptr Core.JVM -> Ptr Core.JClassRef -> Ptr Core.JStaticMethodID
-> Ptr Core.JValues -> IO a)
-> (a -> Java b)
-> StaticH
-> [Core.JArg]
-> x
-> Java b
staticCall callback convert m a t = staticCallE callback convert m a t
>>= either throwJavaException return
staticCallE
:: (Ptr Core.JVM -> Ptr Core.JClassRef -> Ptr Core.JStaticMethodID
-> Ptr Core.JValues -> IO a)
-> (a -> Java b)
-> StaticH
-> [Core.JArg]
-> x
-> Java (Either JThrowable b)
staticCallE callback convert m a t = staticCallX callback convert m a t
>>= check
staticCallX callback convert (StaticH clazz method) args _ = do
vm <- getVM
safe <- getSafe
result <- io $ do
let mkValues = if safe then JNI.mkJValues else Unsafe.mkJValues
jvalues <- mkValues vm $ reverse args
jreturn <- withForeignPtr clazz $
\c -> callback vm c method jvalues
free jvalues
return jreturn
convert result
callMethod :: (MethodCall p b)
=> JMethod p
-> JObject
-> b
callMethod (JMethod _ ptr t) object =
_methodCall (MethodH (jobjectPtr object) ptr) [] t
callMethodE :: (MethodCallE p b)
=> JMethod p
-> JObject
-> b
callMethodE (JMethod _ ptr t) object =
_methodCallE (MethodH (jobjectPtr object) ptr) [] t
callMethodX :: (MethodCallX p b) => JMethod p -> JObject -> b
callMethodX (JMethod _ ptr t) object =
_methodCallX (MethodH (jobjectPtr object) ptr) [] t
data MethodH = MethodH (ForeignPtr Core.JObjectRef) (Ptr Core.JMethodID)
deriving Show
class MethodCall a b | a -> b
where _methodCall :: MethodH -> [Core.JArg] -> a -> b
class MethodCallE a b | a -> b
where _methodCallE :: MethodH -> [Core.JArg] -> a -> b
class MethodCallX a b | a -> b
where _methodCallX :: MethodH -> [Core.JArg] -> a -> b
instance (JArg t v, MethodCall x b) => MethodCall (P t x) (v -> b)
where _methodCall m args (P t x) val =
_methodCall m (jarg t val : args) x
instance (JArg t v, MethodCallE x b) => MethodCallE (P t x) (v -> b)
where _methodCallE m args (P t x) val =
_methodCallE m (jarg t val : args) x
instance (JArg t v, MethodCallX x b) => MethodCallX (P t x) (v -> b)
where _methodCallX m args (P t x) val =
_methodCallX m (jarg t val : args) x
#define METHOD_CALL(TYPE, RESULT, RETURN, SAFE, UNSAFE) \
instance MethodCall TYPE (Java RESULT) where {\
_methodCall m a t = do safe <- getSafe ;\
methodCall (if safe then SAFE \
else UNSAFE) \
RETURN m a t };\
\
instance MethodCallE TYPE (Java (Either JThrowable RESULT)) where {\
_methodCallE m a t = do safe <- getSafe ;\
methodCallE (if safe then SAFE \
else UNSAFE) \
RETURN m a t };\
\
instance MethodCallX TYPE (Java RESULT) where {\
_methodCallX m a t = do safe <- getSafe ;\
methodCallX (if safe then SAFE \
else UNSAFE) \
RETURN m a t }
METHOD_CALL(V, (), return, JNI.callVoidMethod,
Unsafe.callVoidMethod)
METHOD_CALL(Z, Bool, return, JNI.callBooleanMethod,
Unsafe.callBooleanMethod)
METHOD_CALL(C, Word16, return, JNI.callCharMethod,
Unsafe.callCharMethod)
METHOD_CALL(B, Int8, return, JNI.callByteMethod,
Unsafe.callByteMethod)
METHOD_CALL(S, Int16, return, JNI.callShortMethod,
Unsafe.callShortMethod)
METHOD_CALL(I, Int32, return, JNI.callIntMethod,
Unsafe.callIntMethod)
METHOD_CALL(J, Int64, return, JNI.callLongMethod,
Unsafe.callLongMethod)
METHOD_CALL(F, Float, (return . realToFrac),
JNI.callFloatMethod, Unsafe.callFloatMethod)
METHOD_CALL(D, Double, (return . realToFrac),
JNI.callDoubleMethod, Unsafe.callDoubleMethod)
METHOD_CALL(X, (Maybe String), returnString,
JNI.callStringMethod, Unsafe.callStringMethod)
METHOD_CALL(L, (Maybe JObject), returnObject,
JNI.callObjectMethod, Unsafe.callObjectMethod)
METHOD_CALL(Q, (Maybe JObject), returnObject,
JNI.callObjectMethod, Unsafe.callObjectMethod)
METHOD_CALL((A e), (Maybe (JArray e)), returnArray,
JNI.callObjectMethod, Unsafe.callObjectMethod)
methodCall, methodCallX
:: (Ptr Core.JVM -> Ptr Core.JObjectRef -> Ptr Core.JMethodID
-> Ptr Core.JValues -> IO a)
-> (a -> Java b)
-> MethodH
-> [Core.JArg]
-> x
-> Java b
methodCall callback convert m a t = methodCallE callback convert m a t
>>= either throwJavaException return
methodCallE
:: (Ptr Core.JVM -> Ptr Core.JObjectRef -> Ptr Core.JMethodID
-> Ptr Core.JValues -> IO a)
-> (a -> Java b)
-> MethodH
-> [Core.JArg]
-> x
-> Java (Either JThrowable b)
methodCallE callback convert m a t =
methodCallX callback convert m a t >>= check
methodCallX callback convert (MethodH object method) args _ = do
vm <- getVM
safe <- getSafe
result <- io $ do
let mkValues = if safe then JNI.mkJValues else Unsafe.mkJValues
jvalues <- mkValues vm $ reverse args
jreturn <- withForeignPtr object $
\obj -> callback vm obj method jvalues
free jvalues
return jreturn
convert result
data JField a = JField (ForeignPtr Core.JClassRef) (Ptr Core.JFieldID)
deriving Show
data JStaticField a = JStaticField (ForeignPtr Core.JClassRef)
(Ptr Core.JStaticFieldID)
deriving Show
_getField :: Param a => (ForeignPtr Core.JClassRef -> Ptr x -> c a)
-> (Ptr Core.JVM -> Ptr Core.JClassRef -> CString -> CString
-> IO (Ptr x))
-> (Ptr Core.JVM -> Ptr Core.JClassRef -> CString -> CString
-> IO (Ptr x))
-> JClass
-> String
-> a
-> Java (Maybe (c a))
_getField constructor safeGet unsafeGet (JClass clazz) name p = do
safe <- getSafe
vm <- getVM
ptr <- io $ do
cname <- newCString name
csig <- newCString $ fieldSignature p
let get = if safe then safeGet else unsafeGet
fieldID <- withForeignPtr clazz $ \p -> get vm p cname csig
free cname >> free csig
return fieldID
if ptr == nullPtr
then return (fail "No such field.")
else return $ return $ constructor clazz ptr
getField :: Param a => JClass -> String -> a -> Java (Maybe (JField a))
getField = _getField JField JNI.getFieldID Unsafe.getFieldID
getStaticField :: Param a
=> JClass
-> String
-> a
-> Java (Maybe (JStaticField a))
getStaticField = _getField JStaticField JNI.getStaticFieldID
Unsafe.getStaticFieldID
class Field a b | a -> b where
readStaticField :: JStaticField a -> Java b
writeStaticField :: JStaticField a -> b -> Java ()
readField :: JField a -> JObject -> Java b
writeField :: JField a -> JObject -> b -> Java ()
#define FIELD(TYPE, RESULT, GETSS, GETS, GETSU, GETU, \
SETSS, SETS, SETSU, SETU, READ, WRITE) \
instance Field TYPE RESULT where {\
readStaticField (JStaticField c fieldID) = do {\
vm <- getVM ; safe <- getSafe ;\
io (withForeignPtr c $ \p -> ((if safe then GETSS \
else GETSU) vm p fieldID)) \
READ >>= return \
} ;\
writeStaticField (JStaticField c fieldID) v = do {\
vm <- getVM ; safe <- getSafe ;\
return v >>= WRITE \
io . (\t -> withForeignPtr c (\ptr -> \
(if safe then SETSS else SETSU) vm ptr fieldID t)) \
} ;\
readField (JField _ fieldID) (JObject o) = do {\
vm <- getVM ; safe <- getSafe ;\
io (withForeignPtr o $ \p -> (if safe then GETS \
else GETU) vm p fieldID) \
READ >>= return \
} ;\
writeField (JField _ fieldID) (JObject obj) v = do {\
vm <- getVM ; safe <- getSafe ;\
return v >>= WRITE \
io . (\t -> withForeignPtr obj (\ptr -> \
(if safe then SETS else SETU) vm ptr fieldID t)) \
} \
}
FIELD(Z, Bool, JNI.getStaticBooleanField, JNI.getBooleanField,
Unsafe.getStaticBooleanField, Unsafe.getBooleanField,
JNI.setStaticBooleanField, JNI.setBooleanField,
Unsafe.setStaticBooleanField, Unsafe.setBooleanField,,)
FIELD(C, Word16, JNI.getStaticCharField, JNI.getCharField,
Unsafe.getStaticCharField, Unsafe.getCharField,
JNI.setStaticCharField, JNI.setCharField,
Unsafe.setStaticCharField, Unsafe.setCharField,,)
FIELD(B, Int8, JNI.getStaticByteField, JNI.getByteField,
Unsafe.getStaticByteField, Unsafe.getByteField,
JNI.setStaticByteField, JNI.setByteField,
Unsafe.setStaticByteField, Unsafe.setByteField,,)
FIELD(S, Int16, JNI.getStaticShortField, JNI.getShortField,
Unsafe.getStaticShortField, Unsafe.getShortField,
JNI.setStaticShortField, JNI.setShortField,
Unsafe.setStaticShortField, Unsafe.setShortField,,)
FIELD(I, Int32, JNI.getStaticIntField, JNI.getIntField,
Unsafe.getStaticIntField, Unsafe.getIntField,
JNI.setStaticIntField, JNI.setIntField,
Unsafe.setStaticIntField, Unsafe.setIntField,,)
FIELD(J, Int64, JNI.getStaticLongField, JNI.getLongField,
Unsafe.getStaticLongField, Unsafe.getLongField,
JNI.setStaticLongField, JNI.setLongField,
Unsafe.setStaticLongField, Unsafe.setLongField,,)
FIELD(D, Double, JNI.getStaticDoubleField, JNI.getDoubleField,
Unsafe.getStaticDoubleField, Unsafe.getDoubleField,
JNI.setStaticDoubleField, JNI.setDoubleField,
Unsafe.setStaticDoubleField, Unsafe.setDoubleField,
$> realToFrac, return . realToFrac >>=)
FIELD(F, Float, JNI.getStaticFloatField, JNI.getFloatField,
Unsafe.getStaticFloatField, Unsafe.getFloatField,
JNI.setStaticFloatField, JNI.setFloatField,
Unsafe.setStaticFloatField, Unsafe.setFloatField,
$> realToFrac, return . realToFrac >>=)
instance Field L (Maybe JObject) where
readStaticField (JStaticField c fieldID) = do
vm <- getVM
safe <- getSafe
let readField = if safe then JNI.getStaticObjectField
else Unsafe.getStaticObjectField
result <- io $ withForeignPtr c
$ \ptr -> readField vm ptr fieldID
if result == nullPtr
then return Nothing
else do
let release = if safe then JNI.release
else Unsafe.release
io (newForeignPtr release result)
>>= return . Just . JObject
writeStaticField (JStaticField c fieldID) Nothing = do
vm <- getVM
safe <- getSafe
let writeField = if safe then JNI.setStaticObjectField
else Unsafe.setStaticObjectField
io $ withForeignPtr c
$ \ptr -> writeField vm ptr fieldID nullPtr
writeStaticField (JStaticField c fieldID) (Just (JObject obj)) = do
vm <- getVM
safe <- getSafe
let writeField = if safe then JNI.setStaticObjectField
else Unsafe.setStaticObjectField
io $ withForeignPtr c
$ \clazz -> withForeignPtr obj
$ \value -> writeField vm clazz fieldID value
readField (JField _ fieldID) (JObject obj) = do
vm <- getVM
safe <- getSafe
let readField = if safe then JNI.getObjectField
else Unsafe.getObjectField
result <- io $ withForeignPtr obj
$ \ptr -> readField vm ptr fieldID
if result == nullPtr
then return Nothing
else do
let release = if safe then JNI.release
else Unsafe.release
io (newForeignPtr release result)
>>= return . Just . JObject
writeField (JField _ fieldID) (JObject o) Nothing = do
vm <- getVM
safe <- getSafe
let writeField = if safe then JNI.setObjectField
else Unsafe.setObjectField
io $ withForeignPtr o
$ \this -> writeField vm this fieldID nullPtr
writeField (JField _ fieldID) (JObject o) (Just (JObject obj)) = do
vm <- getVM
safe <- getSafe
let writeField = if safe then JNI.setObjectField
else Unsafe.setObjectField
io $ withForeignPtr o
$ \this -> withForeignPtr obj
$ \value -> writeField vm this fieldID value
returnObject ptr = do
safe <- getSafe
io $ if ptr == nullPtr
then return $ fail "null returned"
else newForeignPtr (if safe then JNI.release else Unsafe.release) ptr
>>= return . return . JObject
returnString ptr = io $ if ptr == nullPtr
then return $ fail "null returned instead of String object"
else peekCString ptr >>= \string -> free ptr >> return (return string)
returnArray ptr = if ptr == nullPtr
then return $ fail "null returned"
else do
vm <- getVM
safe <- getSafe
length <- io $ (if safe then JNI.getArrayLength
else Unsafe.getArrayLength) vm ptr
ptr' <- io $ newForeignPtr (if safe then JNI.release
else Unsafe.release) ptr
return $ return $ JArray length ptr'
-- | Finds and loads a class.
--
-- Note that this function can indeed fail with an exception and
-- may execute code from the class to be loaded inside the virtual
-- machine.
--
-- This is due to the fact that @getClass@ is a translation of the
-- @findClass@ function in the JNI which loads *and* resolves the class.
-- If you want to get a class definition without resolving the class,
-- use the method @loadClass(String,boolean)@ on a @ClassLoader@.
--
-- Here is an example of how to do that:
--
-- > main' = runJava $ do
-- > (Just classLoader) <- getClass "java.lang.ClassLoader"
-- > getSystemClassLoader <- classLoader `bindStaticMethod` "getSystemClassLoader"
-- > ::= object "java.lang.ClassLoader"
-- > (Just systemClassLoader) <- getSystemClassLoader
-- >
-- > loadClass <- classLoader `bindMethod` "loadClass"
-- > ::= string --> boolean --> object "java.lang.Class"
-- > (Just clazz) <- loadClass systemClassLoader "java.awt.EventQueue" False
-- > io$ print clazz
getClass :: String
-- ^ The name of the class. This should be a name
-- as would be returned by the @getName()@ method
-- of the class object, for example
-- @java.lang.Thread$State@ or @java.util.Map@.
-> Java (Maybe JClass)
-- ^ Returns Just the JClass or Nothing, if
-- the class does not exist.
getClass name = do
vm <- getVM
safe <- getSafe
ptr <- io $ do
cname <- newCString $ tr '.' '/' name
let findClass = if safe then JNI.findClass
else Unsafe.findClass
ptr <- findClass vm cname
free cname
return ptr
if ptr == nullPtr
then return $ fail "class not found"
else io (newForeignPtr (if safe then JNI.release
else Unsafe.release) ptr)
>>= return . return . JClass
isInstanceOf :: JObject -> JClass -> Java Bool
-- ^ Check whether the given object is an instance of the
-- given class.
isInstanceOf (JObject objectPtr) (JClass classPtr) = do
vm <- getVM
safe <- getSafe
let isInstanceOf = if safe then JNI.isInstanceOf
else JNI.isInstanceOf
io $ withForeignPtr objectPtr
$ \obj -> withForeignPtr classPtr
$ \clazz -> isInstanceOf vm obj clazz
------------------------------------------------------------------------
-- More Documentation
------------------------------------------------------------------------
{- $medium_level_intro
The medium level interface tries to take all the pain from the JNI.
It automatically manages references (i.e. garbage collection) for
you and makes sure that all operations take place in the presence of
a virtual machine.
This module contains the 'Java' monad which basically wraps the IO
monad but allows for actions to be executed in a virtual machine.
Such actions on the other hand can only be executed within the Java
monad and not within the IO monad. See 'runJava', 'runJavaGUI', and
'initJava' for information on how to run a computation in the JVM.
Using the medium level interface you will need to obtain references
to classes and methods manually. You can avoid this by creating high
level bindings (effectively some glue code) via
"Foreign.Java.Bindings".
-}
{- $obtaining_references
In order to invoke methods in the virtual machine you first need a
reference of these methods. These can be retrieved via
'getMethod', 'getStaticMethod', 'bindMethod', and
'bindStaticMethod'. References to constructors can be obtained using
'getConstructor'. All of these functions require a class.
'getClass' will lookup and load Java classes.
Here is an example for calling @Thread.currentThread().getName()@
and printing the result.
> import Foreign.Java
>
> main = runJava $ do
> (Just threadClass) <- getClass "java.lang.Thread"
> currentThread <- threadClass `bindStaticMethod`
> "currentThread" ::= object "java.lang.Thread"
> getName <- threadClass `bindMethod` "getName" ::= string
>
> (Just thread) <- currentThread
> (Just name) <- getName thread
>
> io$ putStrLn name
NOTE: The boilerplate of retrieving class and method references can
be avoided by using the high level java bindings offered by
"Foreign.Java.Bindings".
-}
{- $calling_methods
All the functions that involve calling a method ('callMethod',
'callStaticMethod', and 'newObject') come in three versions: E, X,
and with no suffix.
The X functions will not check for exceptions. Use them if your
absolutely sure that you are calling a total function.
The E functions will check for exceptions and return a value of type
@Either JThrowable a@. A Left value is returned iff an exception
occured (carrying the exception thrown) whereas a Right value
carries the result of the function. Note that such a correct result
may be Nothing (which resembles the @null@ reference) or void
(i.e. unit: @()@).
The functions without any suffix will check for exceptions and throw
a Haskell exception. Throwing that exception will cause the
computation in the JVM to be cancelled. This means that it is not
possible to catch the exception within the Java monad, as the
computation will be cancelled already. You can however catch such
exceptions in the IO monad.
In general you should use E functions if a method throws any checked
exceptions and a function without suffix if a method does not throw
any checked exceptions. This way runtime exceptions will still be
propagated. If you know by heart that a function can not throw any
exceptions, neither checked nor unchecked exceptions, you can use
an X method, which is faster as it does not check for exceptions at
all. If however the method does throw an exception and you do not
check it, you are entering a world of pain.
-}