java-bridge-0.20130606.3: dist/build/Foreign/Java.hs
#line 1 "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
-- | 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
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`)
instance JavaArray Z Bool where { at = _get "getBoolean" jvmGetZ (\s v -> s { jvmGetZ = v }) boolean ; write = _set "setBoolean" jvmSetZ (\s v -> s { jvmSetZ = v }) boolean } ; instance JavaObject (JArray Z) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray C Word16 where { at = _get "getChar" jvmGetC (\s v -> s { jvmGetC = v }) char ; write = _set "setChar" jvmSetC (\s v -> s { jvmSetC = v }) char } ; instance JavaObject (JArray C) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray B Int8 where { at = _get "getByte" jvmGetB (\s v -> s { jvmGetB = v }) byte ; write = _set "setByte" jvmSetB (\s v -> s { jvmSetB = v }) byte } ; instance JavaObject (JArray B) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray S Int16 where { at = _get "getShort" jvmGetS (\s v -> s { jvmGetS = v }) short ; write = _set "setShort" jvmSetS (\s v -> s { jvmSetS = v }) short } ; instance JavaObject (JArray S) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray I Int32 where { at = _get "getInt" jvmGetI (\s v -> s { jvmGetI = v }) int ; write = _set "setInt" jvmSetI (\s v -> s { jvmSetI = v }) int } ; instance JavaObject (JArray I) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray J Int64 where { at = _get "getLong" jvmGetJ (\s v -> s { jvmGetJ = v }) long ; write = _set "setLong" jvmSetJ (\s v -> s { jvmSetJ = v }) long } ; instance JavaObject (JArray J) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray D Double where { at = _get "getDouble" jvmGetD (\s v -> s { jvmGetD = v }) double ; write = _set "setDouble" jvmSetD (\s v -> s { jvmSetD = v }) double } ; instance JavaObject (JArray D) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
instance JavaArray F Float where { at = _get "getFloat" jvmGetF (\s v -> s { jvmGetF = v }) float ; write = _set "setFloat" jvmSetF (\s v -> s { jvmSetF = v }) float } ; instance JavaObject (JArray F) where { toString arr = toList arr >>= return . show ; asObject (JArray _ ptr) = return (JObject ptr) }
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
instance NewObject Z (Bool -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX Z (Bool -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE Z (Bool -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject C (Word16 -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX C (Word16 -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE C (Word16 -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject B (Int8 -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX B (Int8 -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE B (Int8 -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject S (Int16 -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX S (Int16 -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE S (Int16 -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject I (Int32 -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX I (Int32 -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE I (Int32 -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject J (Int64 -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX J (Int64 -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE J (Int64 -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject F (Float -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX F (Float -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE F (Float -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject D (Double -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX D (Double -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE D (Double -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject L (Maybe JObject -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX L (Maybe JObject -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE L (Maybe JObject -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject Q (Maybe JObject -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX Q (Maybe JObject -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE Q (Maybe JObject -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject X (String -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX X (String -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE X (String -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
instance NewObject (A e) (Maybe (JArray e) -> Java (Maybe JObject)) where { _newObject = nuObject } ; instance NewObjectX (A e) (Maybe (JArray e) -> Java (Maybe JObject)) where { _newObjectX = nuObjectX } ; instance NewObjectE (A e) (Maybe (JArray e) -> Java (Either JThrowable (Maybe JObject))) where { _newObjectE = nuObjectE }
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
instance StaticCall V (Java ()) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticVoidMethod else Unsafe.callStaticVoidMethod) return m a t } ; instance StaticCallE V (Java (Either JThrowable ())) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticVoidMethod else Unsafe.callStaticVoidMethod) return m a t } ; instance StaticCallX V (Java ()) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticVoidMethod else Unsafe.callStaticVoidMethod) return m a t }
instance StaticCall Z (Java Bool) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticBooleanMethod else Unsafe.callStaticBooleanMethod) return m a t } ; instance StaticCallE Z (Java (Either JThrowable Bool)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticBooleanMethod else Unsafe.callStaticBooleanMethod) return m a t } ; instance StaticCallX Z (Java Bool) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticBooleanMethod else Unsafe.callStaticBooleanMethod) return m a t }
instance StaticCall C (Java Word16) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticCharMethod else Unsafe.callStaticCharMethod) return m a t } ; instance StaticCallE C (Java (Either JThrowable Word16)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticCharMethod else Unsafe.callStaticCharMethod) return m a t } ; instance StaticCallX C (Java Word16) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticCharMethod else Unsafe.callStaticCharMethod) return m a t }
instance StaticCall B (Java Int8) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticByteMethod else Unsafe.callStaticByteMethod) return m a t } ; instance StaticCallE B (Java (Either JThrowable Int8)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticByteMethod else Unsafe.callStaticByteMethod) return m a t } ; instance StaticCallX B (Java Int8) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticByteMethod else Unsafe.callStaticByteMethod) return m a t }
instance StaticCall S (Java Int16) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticShortMethod else Unsafe.callStaticShortMethod) return m a t } ; instance StaticCallE S (Java (Either JThrowable Int16)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticShortMethod else Unsafe.callStaticShortMethod) return m a t } ; instance StaticCallX S (Java Int16) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticShortMethod else Unsafe.callStaticShortMethod) return m a t }
instance StaticCall I (Java Int32) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticIntMethod else Unsafe.callStaticIntMethod) return m a t } ; instance StaticCallE I (Java (Either JThrowable Int32)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticIntMethod else Unsafe.callStaticIntMethod) return m a t } ; instance StaticCallX I (Java Int32) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticIntMethod else Unsafe.callStaticIntMethod) return m a t }
instance StaticCall J (Java Int64) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticLongMethod else Unsafe.callStaticLongMethod) return m a t } ; instance StaticCallE J (Java (Either JThrowable Int64)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticLongMethod else Unsafe.callStaticLongMethod) return m a t } ; instance StaticCallX J (Java Int64) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticLongMethod else Unsafe.callStaticLongMethod) return m a t }
instance StaticCall F (Java Float) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticFloatMethod else Unsafe.callStaticFloatMethod) (return . realToFrac) m a t } ; instance StaticCallE F (Java (Either JThrowable Float)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticFloatMethod else Unsafe.callStaticFloatMethod) (return . realToFrac) m a t } ; instance StaticCallX F (Java Float) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticFloatMethod else Unsafe.callStaticFloatMethod) (return . realToFrac) m a t }
instance StaticCall D (Java Double) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticDoubleMethod else Unsafe.callStaticDoubleMethod) (return . realToFrac) m a t } ; instance StaticCallE D (Java (Either JThrowable Double)) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticDoubleMethod else Unsafe.callStaticDoubleMethod) (return . realToFrac) m a t } ; instance StaticCallX D (Java Double) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticDoubleMethod else Unsafe.callStaticDoubleMethod) (return . realToFrac) m a t }
instance StaticCall X (Java (Maybe String)) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticStringMethod else Unsafe.callStaticStringMethod) returnString m a t } ; instance StaticCallE X (Java (Either JThrowable (Maybe String))) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticStringMethod else Unsafe.callStaticStringMethod) returnString m a t } ; instance StaticCallX X (Java (Maybe String)) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticStringMethod else Unsafe.callStaticStringMethod) returnString m a t }
instance StaticCall L (Java (Maybe JObject)) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t } ; instance StaticCallE L (Java (Either JThrowable (Maybe JObject))) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t } ; instance StaticCallX L (Java (Maybe JObject)) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t }
instance StaticCall Q (Java (Maybe JObject)) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t } ; instance StaticCallE Q (Java (Either JThrowable (Maybe JObject))) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t } ; instance StaticCallX Q (Java (Maybe JObject)) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnObject m a t }
instance StaticCall (A e) (Java (Maybe (JArray e))) where { _staticCall m a t = do safe <- getSafe ; staticCall (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnArray m a t } ; instance StaticCallE (A e) (Java (Either JThrowable (Maybe (JArray e)))) where { _staticCallE m a t = do safe <- getSafe ; staticCallE (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnArray m a t } ; instance StaticCallX (A e) (Java (Maybe (JArray e))) where { _staticCallX m a t = do safe <- getSafe ; staticCallX (if safe then JNI.callStaticObjectMethod else Unsafe.callStaticObjectMethod) returnArray m a t }
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
instance MethodCall V (Java ()) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callVoidMethod else Unsafe.callVoidMethod) return m a t }; instance MethodCallE V (Java (Either JThrowable ())) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callVoidMethod else Unsafe.callVoidMethod) return m a t }; instance MethodCallX V (Java ()) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callVoidMethod else Unsafe.callVoidMethod) return m a t }
instance MethodCall Z (Java Bool) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callBooleanMethod else Unsafe.callBooleanMethod) return m a t }; instance MethodCallE Z (Java (Either JThrowable Bool)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callBooleanMethod else Unsafe.callBooleanMethod) return m a t }; instance MethodCallX Z (Java Bool) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callBooleanMethod else Unsafe.callBooleanMethod) return m a t }
instance MethodCall C (Java Word16) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callCharMethod else Unsafe.callCharMethod) return m a t }; instance MethodCallE C (Java (Either JThrowable Word16)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callCharMethod else Unsafe.callCharMethod) return m a t }; instance MethodCallX C (Java Word16) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callCharMethod else Unsafe.callCharMethod) return m a t }
instance MethodCall B (Java Int8) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callByteMethod else Unsafe.callByteMethod) return m a t }; instance MethodCallE B (Java (Either JThrowable Int8)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callByteMethod else Unsafe.callByteMethod) return m a t }; instance MethodCallX B (Java Int8) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callByteMethod else Unsafe.callByteMethod) return m a t }
instance MethodCall S (Java Int16) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callShortMethod else Unsafe.callShortMethod) return m a t }; instance MethodCallE S (Java (Either JThrowable Int16)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callShortMethod else Unsafe.callShortMethod) return m a t }; instance MethodCallX S (Java Int16) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callShortMethod else Unsafe.callShortMethod) return m a t }
instance MethodCall I (Java Int32) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callIntMethod else Unsafe.callIntMethod) return m a t }; instance MethodCallE I (Java (Either JThrowable Int32)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callIntMethod else Unsafe.callIntMethod) return m a t }; instance MethodCallX I (Java Int32) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callIntMethod else Unsafe.callIntMethod) return m a t }
instance MethodCall J (Java Int64) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callLongMethod else Unsafe.callLongMethod) return m a t }; instance MethodCallE J (Java (Either JThrowable Int64)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callLongMethod else Unsafe.callLongMethod) return m a t }; instance MethodCallX J (Java Int64) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callLongMethod else Unsafe.callLongMethod) return m a t }
instance MethodCall F (Java Float) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callFloatMethod else Unsafe.callFloatMethod) (return . realToFrac) m a t }; instance MethodCallE F (Java (Either JThrowable Float)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callFloatMethod else Unsafe.callFloatMethod) (return . realToFrac) m a t }; instance MethodCallX F (Java Float) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callFloatMethod else Unsafe.callFloatMethod) (return . realToFrac) m a t }
instance MethodCall D (Java Double) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callDoubleMethod else Unsafe.callDoubleMethod) (return . realToFrac) m a t }; instance MethodCallE D (Java (Either JThrowable Double)) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callDoubleMethod else Unsafe.callDoubleMethod) (return . realToFrac) m a t }; instance MethodCallX D (Java Double) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callDoubleMethod else Unsafe.callDoubleMethod) (return . realToFrac) m a t }
instance MethodCall X (Java (Maybe String)) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callStringMethod else Unsafe.callStringMethod) returnString m a t }; instance MethodCallE X (Java (Either JThrowable (Maybe String))) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callStringMethod else Unsafe.callStringMethod) returnString m a t }; instance MethodCallX X (Java (Maybe String)) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callStringMethod else Unsafe.callStringMethod) returnString m a t }
instance MethodCall L (Java (Maybe JObject)) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }; instance MethodCallE L (Java (Either JThrowable (Maybe JObject))) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }; instance MethodCallX L (Java (Maybe JObject)) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }
instance MethodCall Q (Java (Maybe JObject)) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }; instance MethodCallE Q (Java (Either JThrowable (Maybe JObject))) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }; instance MethodCallX Q (Java (Maybe JObject)) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnObject m a t }
instance MethodCall (A e) (Java (Maybe (JArray e))) where { _methodCall m a t = do safe <- getSafe ; methodCall (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnArray m a t }; instance MethodCallE (A e) (Java (Either JThrowable (Maybe (JArray e)))) where { _methodCallE m a t = do safe <- getSafe ; methodCallE (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnArray m a t }; instance MethodCallX (A e) (Java (Maybe (JArray e))) where { _methodCallX m a t = do safe <- getSafe ; methodCallX (if safe then JNI.callObjectMethod else Unsafe.callObjectMethod) returnArray m a t }
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 ()
instance Field Z Bool where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticBooleanField else Unsafe.getStaticBooleanField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticBooleanField else Unsafe.setStaticBooleanField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getBooleanField else Unsafe.getBooleanField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setBooleanField else Unsafe.setBooleanField) vm ptr fieldID t)) } }
instance Field C Word16 where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticCharField else Unsafe.getStaticCharField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticCharField else Unsafe.setStaticCharField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getCharField else Unsafe.getCharField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setCharField else Unsafe.setCharField) vm ptr fieldID t)) } }
instance Field B Int8 where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticByteField else Unsafe.getStaticByteField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticByteField else Unsafe.setStaticByteField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getByteField else Unsafe.getByteField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setByteField else Unsafe.setByteField) vm ptr fieldID t)) } }
instance Field S Int16 where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticShortField else Unsafe.getStaticShortField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticShortField else Unsafe.setStaticShortField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getShortField else Unsafe.getShortField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setShortField else Unsafe.setShortField) vm ptr fieldID t)) } }
instance Field I Int32 where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticIntField else Unsafe.getStaticIntField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticIntField else Unsafe.setStaticIntField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getIntField else Unsafe.getIntField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setIntField else Unsafe.setIntField) vm ptr fieldID t)) } }
instance Field J Int64 where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticLongField else Unsafe.getStaticLongField) vm p fieldID)) >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticLongField else Unsafe.setStaticLongField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getLongField else Unsafe.getLongField) vm p fieldID) >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setLongField else Unsafe.setLongField) vm ptr fieldID t)) } }
instance Field D Double where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticDoubleField else Unsafe.getStaticDoubleField) vm p fieldID)) $> realToFrac >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= return . realToFrac >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticDoubleField else Unsafe.setStaticDoubleField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getDoubleField else Unsafe.getDoubleField) vm p fieldID) $> realToFrac >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= return . realToFrac >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setDoubleField else Unsafe.setDoubleField) vm ptr fieldID t)) } }
instance Field F Float where { readStaticField (JStaticField c fieldID) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr c $ \p -> ((if safe then JNI.getStaticFloatField else Unsafe.getStaticFloatField) vm p fieldID)) $> realToFrac >>= return } ; writeStaticField (JStaticField c fieldID) v = do { vm <- getVM ; safe <- getSafe ; return v >>= return . realToFrac >>= io . (\t -> withForeignPtr c (\ptr -> (if safe then JNI.setStaticFloatField else Unsafe.setStaticFloatField) vm ptr fieldID t)) } ; readField (JField _ fieldID) (JObject o) = do { vm <- getVM ; safe <- getSafe ; io (withForeignPtr o $ \p -> (if safe then JNI.getFloatField else Unsafe.getFloatField) vm p fieldID) $> realToFrac >>= return } ; writeField (JField _ fieldID) (JObject obj) v = do { vm <- getVM ; safe <- getSafe ; return v >>= return . realToFrac >>= io . (\t -> withForeignPtr obj (\ptr -> (if safe then JNI.setFloatField else Unsafe.setFloatField) vm ptr fieldID t)) } }
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.
-}