#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. -}