#line 1 "src/Foreign/Java.cpphs"
module Foreign.Java (
Java,
runJava,
runJava',
initJava,
setUnsafe,
runJavaGui,
runJavaGui',
getClass,
getConstructor,
newObject,
newObjectE,
newObjectX,
newObjectFrom,
newObjectFromE,
newObjectFromX,
getMethod,
getStaticMethod,
bindMethod,
bindStaticMethod,
callMethod,
callMethodE,
callMethodX,
callStaticMethod,
callStaticMethodE,
callStaticMethodX,
getField,
getStaticField,
readField,
readStaticField,
writeField,
writeStaticField,
arrayLength,
JavaArray (..),
JavaObject (..),
isInstanceOf,
io,
module Foreign.Java.Value,
liftIO,
forkJava,
waitJava,
JVM,
JClass,
JObject,
JArray,
JField,
JStaticField,
JMethod,
JStaticMethod,
JConstructor,
JThrowable,
JavaThreadId,
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
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
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
throwJavaException throwable = do
strMessage <- toString throwable
io $ throw $ JavaException strMessage throwable
class JavaObject a where
toString :: a -> Java String
hashCode :: a -> Java Int32
asObject :: a -> Java JObject
classOf :: a -> Java JClass
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
instance JavaObject (JArray L) where
toString arr = toList arr
>>= mapM (maybe (return "null") toString)
>>= return . show
asObject (JArray _ ptr) = return (JObject ptr)
instance JavaObject JClass where
asObject (JClass ptr) = return (JObject $ castForeignPtr ptr)
instance JavaObject JThrowable where
asObject (JThrowable ptr) = return (JObject $ castForeignPtr ptr)
arrayLength :: JArray e -> Java Int32
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..size1] (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
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
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
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
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
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
infixl 7 `bindStaticMethod`
bindStaticMethod :: (Method (p -> String), StaticCall p b)
=> JClass
-> MethodDescriptor p
-> Java b
bindStaticMethod c m =
getStaticMethod c m $> fromJust $> callStaticMethod
infixl 7 `bindMethod`
bindMethod :: (Method (p -> String), MethodCall p b)
=> JClass
-> MethodDescriptor p
-> Java (JObject -> b)
bindMethod c m = getMethod c m $> fromJust $> callMethod
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'
getClass :: String
-> Java (Maybe JClass)
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
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