java-bridge (empty) → 0.9
raw patch · 29 files changed
+9346/−0 lines, 29 filesdep +basedep +cpphsdep +directorybuild-type:Customsetup-changed
Dependencies added: base, cpphs, directory, filepath, mtl, strings, transformers, unix
Files
- GetProperty.java +7/−0
- HACKING.txt +259/−0
- HFunction.java +50/−0
- ISSUES.txt +10/−0
- LICENSE +18/−0
- README.md +2/−0
- ReadClass.java +33/−0
- Setup.hs +300/−0
- dist/build/Foreign/Java.hs +1155/−0
- dist/build/Foreign/Java/Bindings.hs +359/−0
- dist/build/Foreign/Java/JNI/Safe.hs +683/−0
- dist/build/Foreign/Java/JNI/Unsafe.hs +683/−0
- include/jni.h +714/−0
- java-bridge.cabal +196/−0
- src/Foreign/Java.cpphs +1206/−0
- src/Foreign/Java/Bindings.cpphs +358/−0
- src/Foreign/Java/JNI.hs +52/−0
- src/Foreign/Java/JNI/Safe.tpl +1/−0
- src/Foreign/Java/JNI/Types.hs +72/−0
- src/Foreign/Java/JNI/Unsafe.tpl +1/−0
- src/Foreign/Java/JNI/core.hs +683/−0
- src/Foreign/Java/JavaMonad.hs +296/−0
- src/Foreign/Java/Types.hs +259/−0
- src/Foreign/Java/Util.hs +41/−0
- src/Foreign/Java/Utils.hs +191/−0
- src/Foreign/Java/Value.hs +37/−0
- src/ffijni.c +1230/−0
- src/ffijni.h +378/−0
- src/hfunction.h +72/−0
+ GetProperty.java view
@@ -0,0 +1,7 @@+public class GetProperty {+ public static void main(String... args) {+ for (String arg : args) {+ System.out.println(System.getProperty(arg));+ }+ }+}
+ HACKING.txt view
@@ -0,0 +1,259 @@+Author : Julian Fleischer++Changes : 2013-05-28 First version+ 2013-06-01 Added *.cpphs+ 2013-06-03 +Roadmap, +Coding Guidelines, few quirks fixed+++What you should know up front+=============================+++WORKSPACE REQUIREMENTS+----------------------++This library has proudly been built using a Terminal and VIM,+which is all you need to start developing.++( well, the Haskell Platform and a JDK would be necessary too,+ but hey, you surely figured /that/. )++++USE OF PREPROCESSORS+--------------------++In order to reduce code duplication and enhance both the readability+and the ease of writing code, two preprocessors are used throughout+the package. They are defined in `Setup.hs'. Thus this package+requires to be built with cabal.++The following file types are specially treated:+++*.tpl+ Used for Foreign.Java.JNI.{Safe|Unsafe}. Both of these files+ are nearly identical to each other, except for having "safe"+ or "unsafe" along foreign imports. A *.tpl file contains a+ relative path to a template file and a list of key/value pairs.+ The key/value pairs are replaced in the template and a regular+ Haskell file is generated.++ Example.tpl:+ > ("example-template.hs", [("SAFETY"), ("safe")])++ example-template.hs+ > main = "This is the %SAFETY% version."++ yields Example.hs:+ > main = "This is the safe version."++ The preprocessor is defined in `Setup.hs'+ in the function `transformTpl'.+++*.hss+ Haskell with syntactic sugar for multiline strings and+ string interpolation. It allows for the following:++ > aRatherComplexString :: String -> [String] -> Int -> String+ > aRatherComplexString x y z = """+ > The arguments are+ > x = #{x}+ > y = #{unlines y}+ > z = #{show z}+ > """++ The preprocessor is defined in `Setup.hs'+ in the function `transformHss'.++ HSS files are used wherever large amounts of dull string+ processing are required, such as when generating code.+++*.cpphs+ Haskell with cpp (c preprocessor) directives. This is mostly the+ same as using the CPP extension (-XCPP). The CPPHS preprocessor+ uses the implementation from the hackage package `cpphs').+ The cpphs preprocessor allows for modern ansi features such as+ stringification and token pasting (the CPP extension runs cpp in+ traditional mode, which does not include modern ansi features).++ cpphs is used through out this project to reduce the amount+ or repetetive code and is considered a simpler alternative to+ Template Haskell. -XCPP instead of cpphs is used wherever a+ value from the outside (-D... -> #ifdef) is needed.++ -> http://projects.haskell.org/cpphs/+ -> http://hackage.haskell.org/package/cpphs++++WHAT GOES WHERE+---------------++src/ffijni.h src/foreign.c+ Hand-written glue code for interfacing the FFI with the JNI.++src/Foreign/Java/JNI/*.{tpl|hs}+ These files contain the Core JNI binding.++src/Foreign/Java.hs+ This file contains the medium level API.++src/Foreign/Java/Bindings.hss src/Foreign/Java/Bindings/...+ These files contain functions for reflecting+ Java classes and Haskell modules, and generating+ high level glue code.++src/Foreign/Java/Bindings/Support.cpphs+ This file contains more-or-less private definitions+ that are used by the generated Haskell modules only.+ The module is public (that is "not hidden") so that+ bindings can live in a package other than java-bridge.+ It should however be considered an internal package.++src/Foreign/Java/{all other files}+ Utilities (Foreign.Java.{IO / Maybe / Print / ...})++examples/+ Examples. Don't forget to add files and executables in+ java-bridge.cabal when adding examples or anything.+ Most examples are not that impressive, but offer simple+ tutorials of various aspects of the API of the java-bridge.++hs2j/ j2hs/+ The respective tools. Mostly boring code to orchestrate the+ interplay of functions from Foreign.Java.Bindings.*++GetProperty.java+ This file is used for setup on Linux/Unix to retrieve system+ properties form the JVM.++Makefile+ Does little more than calling cabal. Use as inspiration on how to+ use cabal for building (which is really easy).++Setup.hs+ The project uses a Custom build type, which is defined in here.+ Preprocessors and functions for finding libjvm live here.++++CODING GUIDELINES+-----------------++Please try to stick to a maximum line width of 80 characters, 72 if+possible. Sometimes that limit is exceeded, however 100 characters+should really never be reached. Thus:++ Soft constraint:+ 72 characters per line.+ Hard constraint:+ 80 characters per line.+ Do-not-cross-never-ever:+ 100 characters.+++When defining methods that perform case analysis, use a case construct+rather than multiple method definitions:++GOOD:++> function x = case x of+> C1 -> ...+> C2 -> ...++BAD:++> function C1 = ...+> function C2 = ...++This greatly enhances maintainability `plus` it safes a few keystrokes.++++DISTRIBUTION+------------++Due to the use of preprocessors the regular `cabal sdist' will fail.+This seems to be a known bug. The workaround is to manually invoke the+build script:++$ ./dist/setup/setup sdist++( you need to have invoked `cabal configure' first,+ otherwise `setup' will not have been built yet. )++-or-++$ runhaskell Setup.hs sdist++( note that on some machines this fails badly with a GHCi runtime error+ (issues with linking), so it's probably better to compile and run+ `setup', as shown above. )++The matter has been discussed on stackoverflow:++-> Haskell - Packaging cabal package with custom preprocessors+ http://stackoverflow.com/q/16256987/471478+++Roadmap+=======++This section describes known issues that will be worked on.+++OS X (GUI) QUIRKS+-----------------++See also:++-> Java JNI: Creating a Swing Window using JNI from C+ http://stackoverflow.com/q/14661249/471478++-> Linking a library with GHC and Cabal in Mac OS X+ http://stackoverflow.com/q/16383988/471478++Starting points:++ Foreign.Java+ -> runJavaGui and runJavaGui'+ Foreign.Java.JNI.{Safe/Unsafe}+ -> runCocoaMain :: IO ()+ src/ffijni.c+ -> void runCocoaMain()++++CLASS CACHE (ENHANCEMENT)+-------------------------++Would it speed things up if class references were cached in the Java+monad? Currently every invocation of a method (especially in the high+level bindings) does a new lookup.++The medium level bindings are not affected.++++OVERHAUL *.hss PREPROCESSOR+---------------------------++The current implementation is uggly hackery. Overhaul and maybe release+as a package in its own right.++++JAVADOC -> HADDOCK+------------------++It would be really great if the generated haddock documentation for the+high level bindings would contain the javadoc of the translated classes+and methods.+++++
+ HFunction.java view
@@ -0,0 +1,50 @@+import java.lang.reflect.*;++/**+ * An HFunction can be used as a invocation handler which actually+ * handles the invocation by calling a Haskell function.+ *+ * @author Julian Fleischer+ */+public class HFunction implements InvocationHandler {++ private final long hFunction;++ static native void release(long func);+ static native Object call(long func, Method self, Object[] args);++ /**+ * Creates an HFunction from a function pointer.+ *+ * @param func+ */+ public HFunction(long func) {+ hFunction = func;+ }++ public Object invoke(Object proxy, Method method, Object[] args) {+ return call(hFunction, method, args);+ }++ protected void finalize() {+ release(hFunction);+ }++ /**+ * Make an HFunction for a given iface from a function pointer.+ *+ * @param iface+ * @param func+ */+ @SuppressWarnings("unchecked")+ public static <T> T makeFunction(Class<T> iface, long func) {+ InvocationHandler handler = new HFunction(func);+ return (T) Proxy.newProxyInstance(+ iface.getClassLoader(),+ new Class<?>[] { iface },+ handler);+ }+}+++
+ ISSUES.txt view
@@ -0,0 +1,10 @@+OS X is complicated. Cocoa is a beast. As a result, windows+created using AWT/Swing are not properly registered with+the window management. Keyboard focus is difficult...++An application is not properly initialized as @NSApplication@,+thus the above mentioned quirks. If someone knows how to+properly and manually initialize a Cocoa application please+get in touch with me. The current workaround is in the function+@runCocoaMain@ in @src/ffijni.c@.+
+ LICENSE view
@@ -0,0 +1,18 @@+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.+
+ README.md view
@@ -0,0 +1,2 @@+java-bridge+===========
+ ReadClass.java view
@@ -0,0 +1,33 @@+import java.io.*;++public class ReadClass {++ public static void main(String... args) throws Exception {++ File file = new File("HFunction.class");+ int size = (int) file.length();+ + FileInputStream stream = new FileInputStream(file);+ PrintStream out = new PrintStream("src/hfunction.h");++ byte[] bytes = new byte[size];++ stream.read(bytes);++ out.printf("\n#define FFIJNI_HFUNCTION_LENGTH %d\n\n", size);+ out.print("static jbyte hFunctionClass[FFIJNI_HFUNCTION_LENGTH] = {");+ for (int i = 0; i < size; i++) {+ if (i % 16 == 0) {+ out.println();+ out.print(" ");+ }+ out.print(bytes[i]);+ if (i+1 < size) {+ out.print(", ");+ }+ }+ out.println("\n};");+ }+}++
+ Setup.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE Haskell2010+ , ScopedTypeVariables+ , CPP+ #-}+{-# OPTIONS+ -Wall+ -fno-warn-missing-signatures+ -fno-warn-name-shadowing+ #-}++import Prelude+import qualified Prelude as P++import qualified Control.Exception as Exc+import Control.Monad (when)++import Data.List++import Distribution.PackageDescription+import Distribution.System+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.PreProcess+import Distribution.Simple.Utils+import Distribution.Verbosity++import System.Environment+import System.Exit (ExitCode (..))+import System.Directory+import System.FilePath++import Text.Printf++import Language.Preprocessor.Cpphs++#if linux_HOST_OS == 1 || darwin_HOST_OS == 1+import System.Posix.Files+#endif++main = do+ let verb = verbose++ args <- getArgs++ args' <- case args of+ "configure" : _ -> do+ notice verb ("OS=" ++ show buildOS)+ notice verb ("ARCH=" ++ show buildArch)+ args_ <- Exc.catch (configure verb args buildOS) $ \exc -> do+ warn verb $+ "Could not find a JDK. Continuing anyway.\n"+ ++ "The error is: "+ ++ ((show :: Exc.SomeException -> String) exc)+ return $+ args ++ ["--extra-include-dirs=./include",+ "--ghc-option=-optc-DFFIJNI_LIBJVM=!404!"]+ return args_+ _ -> return args++ let hooks = simpleUserHooks {+ hookedPreProcessors = [ ("tpl", transformTpl)+ , ("hss", transformHss)+ , ("cpphs", transformCpphs) ]+ }++ defaultMainWithHooksArgs hooks args'+++transformCpphs :: BuildInfo -> LocalBuildInfo -> PreProcessor+transformCpphs _ _ = PreProcessor True $ \(inDir, inFile) (outDir, outFile) _ -> do+ source <- readFile (inDir </> inFile)++ _ <- printf "Preprocessing (CPPHS) %s -> %s\n"+ (inDir </> inFile) (outDir </> outFile)++ let options = defaultCpphsOptions {+ boolopts = (defaultBoolOptions { ansi = True })+ }++ runCpphs options (inDir </> inFile) source+ >>= writeFile (outDir </> outFile)+++transformTpl :: BuildInfo -> LocalBuildInfo -> PreProcessor+transformTpl _ _ = PreProcessor True $ \(inDir, inFile) (outDir, outFile) _ -> do+ let (baseDir, _) = splitFileName (inDir </> inFile)+ template <- readFile (inDir </> inFile)++ let (templateFile, params) = read (filter (/= '\n') template)+ :: (String, [(String, String)])++ _ <- printf "Preprocessing (TPL) %s -> %s (using %s)\n"+ (inDir </> inFile) (outDir </> outFile) templateFile++ template <- readFile (baseDir ++ templateFile)++ writeFile (outDir </> outFile) (processTpl params template)++processTpl params xss = case xss of+ ('%':xs) -> let (var, (_:rest)) = break (== '%') xs+ in maybe "" id (lookup var params) ++ processTpl params rest+ (x:xs) -> x : processTpl params xs+ "" -> ""+++transformHss :: BuildInfo -> LocalBuildInfo -> PreProcessor+-- ^ Transforms a *.hss file containing TriString-literals ("""triString""")+-- into an ordinary *.hs file.+transformHss _ _ = PreProcessor True $ \(inDir, inFile) (outDir, outFile) _ -> do+ source <- readFile (inDir </> inFile)++ _ <- printf "Preprocessing (HSS) %s -> %s\n"+ (inDir </> inFile) (outDir </> outFile)++ writeFile (outDir </> outFile) (doProcessHss inFile source)++-- | The actual processing of 'transformHss'. No advanced method of parsing+-- have been used in order to reduce the dependencies of the Setup script+-- and to now blow it up by a whole combinator library or auto generated code.+--+-- Every triString is replaced by the concatenation of ordinary haskell+-- strings. Code embedded in curly braces (introduced by a hash sign) is+-- embedded literally. LINE pragmas keep the line numbers consistent.+doProcessHss file = processHss (1 :: Int)+ where+ processHss n xs = case xs of+ ('"':'"':'"':xs) -> triString n xs+ ('{':'-':xs) -> '{' : '-' : comment n (1 :: Int) xs+ ('"':xs) -> '"' : string n xs+ ('\n':xs) -> '\n' : processHss (succ n) xs+ (x:xs) -> x : processHss n xs+ "" -> ""+ where+ triString n xs = case breakIt xs of+ (str, xs) -> concat [ "((\\_ -> let { __ = "+ , "\n{-# LINE ", show n, " ", show file, " #-}\n"+ , sanitizeIt (mkTriString str)+ , "\n{-# LINE ", show n', " ", show file, " #-}\n"+ , "} in __) undefined)"+ , processHss n' xs ]+ where n' = n + length (filter (== '\n') str)++ breakIt xs = case xs of+ ('"':'"':'"':xs) -> ("", xs)+ (x:xs) -> case breakIt xs of (y, ys) -> (x : y, ys)+ "" -> ("", "")++ sanitizeIt xs = case xs of+ ('\\':'\\':'n':xs) -> sanitizeIt xs+ (x:xs) -> x : sanitizeIt xs+ "" -> ""++ mkTriString xs = "concat [\"" ++ process string ++ "\"]"+ where+ string = concat $ intersperse "\\n" lines+ process xs = case xs of+ ('#':'{':xs) -> case break (== '}') xs of+ (ls, (_:rs)) -> "\", (" ++ ls ++ "), \"" ++ process rs+ _ -> error "could not match closing curly brace"+ ('"':xs) -> '\\' : '"' : process xs+ (x:xs) -> x : process xs+ [] -> []+ lines = case P.lines xs of+ ("":lines) -> map (dedent (indent lines)) lines+ (line:[]) -> [line]+ lines@(_:lines') -> map (dedent (indent lines')) lines+ [] -> []+ indent xs = case xs of+ [] -> 0+ _ -> minimum $ map (length . takeWhile (== ' ')) xs+ dedent n line = case splitAt n line of+ (ls, rs) -> dropWhile (== ' ') ls ++ rs++ comment l 1 ('-':'}':xs) = '-' : '}' : processHss l xs+ comment l n xs = case xs of+ ('{':'-':xs) -> '{' : '-' : comment l (succ n) xs+ ('-':'}':xs) -> '-' : '}' : comment l (pred n) xs+ ('\n':xs) -> '\n' : comment (succ l) n xs+ (x:xs) -> x : comment l n xs+ "" -> ""++ string l xs = case xs of+ ('\\':'"':xs) -> '\\' : '"' : string l xs+ ('"':xs) -> '"' : processHss l xs+ (x:xs) -> x : string l xs+ "" -> ""++ +configure verb args OSX = do+ -- In Mac OS X there is the tool /usr/libexec/java_home which tells+ -- us where JRE and JDK are installed.++ javaHome <- findFirstFile id ["/usr/libexec/java_home"]+ >>= maybe (fail "Could not determine JAVA_HOME using /usr/libexec/java_home - is there a JDK installed?")+ return+ >>= (\cmd -> rawSystemStdout silent cmd [])+ >>= return . head . lines++ libjvmPath <- getEnvironment >>= return . lookup "FFIJNI_LIBJVM"+ >>= maybe (return $ javaHome ++ "/jre/lib/server/libjvm.dylib") return++ notice verb $ "JAVA_HOME=" ++ javaHome+ notice verb $ "FFIJNI_LIBJVM=" ++ libjvmPath++ return $ args ++ ["--extra-include-dirs=" ++ javaHome ++ "/include",+ "--extra-include-dirs=" ++ javaHome ++ "/include/darwin",+ "--ghc-option=-optc-DFFIJNI_LIBJVM=" ++ libjvmPath]+++configure verb args Linux = do+ -- In Linux we find out where javac lives and resolve all+ -- symlinks until we find the JDK home.++ let lookupJavac = findExecutable "javac"+ >>= maybe (fail "Could not determine path to javac. Try setting JAVA_HOME.") return+ >>= resolve >>= return . takeDirectory . takeDirectory++ javaHome <- getEnvironment >>= return . lookup "JAVA_HOME"+ >>= maybe lookupJavac return++ when (verb >= deafening) $ do+ getDirectoryContentsRecursive javaHome >>= mapM_ (debug verb)++ rawSystemExitCode normal (javaHome ++ "/bin/javac") ["GetProperty.java"]+ >>= (\exit -> case exit of+ ExitSuccess -> return ()+ ExitFailure code -> fail $ "javac exited with ExitCode " ++ show code)++ javaArch <- rawSystemStdout normal (javaHome ++ "/bin/java") ["GetProperty", "os.arch"]+ >>= return . head . lines++ notice verb $ "os.arch=" ++ javaArch++ libjvmPath <- getEnvironment >>= return . lookup "FFIJNI_LIBJVM"+ >>= maybe (return $ javaHome ++ "/jre/lib/" ++ javaArch ++ "/server/libjvm.so") return++ notice verb $ "JAVA_HOME=" ++ javaHome+ notice verb $ "FFIJNI_LIBJVM=" ++ libjvmPath++ findFirstFile id [javaHome ++ "/include/jni.h"]+ >>= maybe (fail $ "jni.h was not found in " ++ javaHome ++ "/include")+ (return . const ())++ findFirstFile id [javaHome ++ "/include/linux/jni_md.h"]+ >>= maybe (fail $ "jni_md.h was not found in " ++ javaHome ++ "/include/linux")+ (return . const ())++ return $ args ++ ["--extra-include-dirs=" ++ javaHome ++ "/include",+ "--extra-include-dirs=" ++ javaHome ++ "/include/linux",+ "--ghc-option=-optc-DFFIJNI_LIBJVM=" ++ libjvmPath]+++configure verb args Windows = do+ -- The strategy for finding a JDK in Windows is rather simplistic.+ -- Typically the JDK is installed in %ProgramFiles%/Java, so we look+ -- into that directory for directories starting with @jdk@. We choose+ -- the one with the highest version number (that's what sort is for).++ programFiles <- getEnv "ProgramFiles"++ javaHome <- getDirectoryContents (programFiles ++ "\\Java")+ >>= return . (programFiles ++) . ("\\Java\\" ++) . last . sort . filter ("jdk" `isPrefixOf`)++ libjvmPath <- getEnvironment >>= return . lookup "FFIJNI_LIBJVM"+ >>= maybe (return $ javaHome ++ "\\jre\\bin\\server\\jvm.dll") return+ >>= return . replace '\\' '/'++ notice verb $ "JAVA_HOME=" ++ javaHome+ notice verb $ "FFIJNI_LIBJVM=" ++ libjvmPath++ findFirstFile id [javaHome ++ "/include/jni.h"]+ >>= maybe (fail $ "jni.h was not found in " ++ javaHome ++ "/include")+ (return . const ())++ return $ args ++ ["--extra-include-dirs=" ++ javaHome ++ "/include",+ "--extra-include-dirs=" ++ javaHome ++ "/include/win32",+ "--ghc-option=-optc-DFFIJNI_LIBJVM=" ++ libjvmPath]++configure verb args os = do+ warn verb $ "Unknown platform: " ++ show os+ -- default, nothing+ return args++replace :: Char -> Char -> String -> String+replace needle replacement haystack = case haystack of+ (x:xs) -> (if x == needle then replacement else x) : replace needle replacement xs+ [] -> []++resolve :: FilePath -> IO FilePath+#if linux_HOST_OS == 1 || darwin_HOST_OS == 1+resolve filePath = do+ stat <- getSymbolicLinkStatus filePath+ if isSymbolicLink stat+ then readSymbolicLink filePath >>= resolve+ else return filePath+#else+-- in Windows there are no Symlinks, thus resolve does nothing.+resolve = return+#endif+
+ dist/build/Foreign/Java.hs view
@@ -0,0 +1,1155 @@+#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.+-}+
+ dist/build/Foreign/Java/Bindings.hs view
@@ -0,0 +1,359 @@+#line 1 "src/Foreign/Java/Bindings.cpphs"+{-# LANGUAGE Haskell2010+ , TypeFamilies+ , FlexibleContexts+ , FlexibleInstances+ , TypeSynonymInstances+ #-}+{-# OPTIONS+ -Wall+ #-}++-- |+-- Module : Foreign.Java.Bindings.Support+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : experimental+-- Portability : non-portable (TypeFamilies)+--+-- This module provides type classes and instances for+-- supporting the high level bindings. This module should+-- not be imported directly.+module Foreign.Java.Bindings where++import Control.Monad.State hiding (void)++import Data.Int+import Data.Word+import Data.Maybe++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.Types++import Foreign.Java+import Foreign.Java.JavaMonad+import Foreign.Java.Types as T+import qualified Foreign.Java.JNI.Safe as JNI+import qualified Foreign.Java.JNI.Types as Core+++---------------+-- Utilities --+---------------+++object' :: String -> Q+object' = T.object'+++------------------------------+-- Primitive argument types --+------------------------------++class JBoolean a where toBoolean :: a -> Java Bool+class JChar a where toChar :: a -> Java Word16+class JByte a where toByte :: a -> Java Int8+class JShort a where toShort :: a -> Java Int16+class JInt a where toInt :: a -> Java Int32+class JLong a where toLong :: a -> Java Int64+class JFloat a where toFloat :: a -> Java Float+class JDouble a where toDouble :: a -> Java Double+++instance JBoolean Bool where toBoolean = return++instance JChar Char where toChar = return . fromIntegral . fromEnum+instance JChar Int8 where toChar = return . fromIntegral+instance JChar Word16 where toChar = return++instance JByte Int8 where toByte = return++instance JShort Int8 where toShort = return . fromIntegral+instance JShort Word8 where toShort = return . fromIntegral+instance JShort Int16 where toShort = return++instance JInt Int where toInt = return . fromIntegral+instance JInt Int8 where toInt = return . fromIntegral+instance JInt Word8 where toInt = return . fromIntegral+instance JInt Int16 where toInt = return . fromIntegral+instance JInt Word16 where toInt = return . fromIntegral+instance JInt Int32 where toInt = return++instance JLong Int where toLong = return . fromIntegral+instance JLong Int8 where toLong = return . fromIntegral+instance JLong Word8 where toLong = return . fromIntegral+instance JLong Int16 where toLong = return . fromIntegral+instance JLong Word16 where toLong = return . fromIntegral+instance JLong Int32 where toLong = return . fromIntegral+instance JLong Word32 where toLong = return . fromIntegral+instance JLong Int64 where toLong = return++instance JFloat CFloat where toFloat = return . realToFrac+instance JFloat Float where toFloat = return++instance JDouble CDouble where toDouble = return . realToFrac+instance JDouble Double where toDouble = return+++--------------------------+-- Array argument types --+--------------------------++class Array a where+ asMaybeArrayObject :: a -> Java (Maybe JObject)+++----------------------------+-- Primitive result types --+----------------------------++++++++++++-- | The result of a function call that is of type @boolean@.+class BooleanResult m where { toBooleanResult :: Either JThrowable Bool -> Java m } ; instance BooleanResult Bool where { toBooleanResult = either (\exc -> toString exc >>= fail) return } ; instance BooleanResult (Either JThrowable Bool) where { toBooleanResult = return }+-- | The result of a function call that is of type @char@.+class CharResult m where { toCharResult :: Either JThrowable Word16 -> Java m } ; instance CharResult Word16 where { toCharResult = either (\exc -> toString exc >>= fail) return } ; instance CharResult (Either JThrowable Word16) where { toCharResult = return }+-- | The result of a function call that is of type @byte@.+class ByteResult m where { toByteResult :: Either JThrowable Int8 -> Java m } ; instance ByteResult Int8 where { toByteResult = either (\exc -> toString exc >>= fail) return } ; instance ByteResult (Either JThrowable Int8) where { toByteResult = return }+-- | The result of a function call that is of type @short@.+class ShortResult m where { toShortResult :: Either JThrowable Int16 -> Java m } ; instance ShortResult Int16 where { toShortResult = either (\exc -> toString exc >>= fail) return } ; instance ShortResult (Either JThrowable Int16) where { toShortResult = return }+-- | The result of a function call that is of type @int@.+class IntResult m where { toIntResult :: Either JThrowable Int32 -> Java m } ; instance IntResult Int32 where { toIntResult = either (\exc -> toString exc >>= fail) return } ; instance IntResult (Either JThrowable Int32) where { toIntResult = return }+-- | The result of a function call that is of type @long@.+class LongResult m where { toLongResult :: Either JThrowable Int64 -> Java m } ; instance LongResult Int64 where { toLongResult = either (\exc -> toString exc >>= fail) return } ; instance LongResult (Either JThrowable Int64) where { toLongResult = return }+-- | The result of a function call that is of type @float@.+class FloatResult m where { toFloatResult :: Either JThrowable Float -> Java m } ; instance FloatResult Float where { toFloatResult = either (\exc -> toString exc >>= fail) return } ; instance FloatResult (Either JThrowable Float) where { toFloatResult = return }+-- | The result of a function call that is of type @double@.+class DoubleResult m where { toDoubleResult :: Either JThrowable Double -> Java m } ; instance DoubleResult Double where { toDoubleResult = either (\exc -> toString exc >>= fail) return } ; instance DoubleResult (Either JThrowable Double) where { toDoubleResult = return }++-- | The result of a function call that is of type @void@.+class VoidResult m where+ toVoidResult :: Either JThrowable () -> Java m+ +instance VoidResult () where+ toVoidResult = either (\exc -> toString exc >>= fail) return++instance VoidResult (Either JThrowable ()) where+ toVoidResult = return+ +instance VoidResult (Maybe JThrowable) where+ toVoidResult = return . either Just (const Nothing)+++------------------------+-- Array result types --+------------------------++-- | An array result of a function call.+class JavaArray (ArrayResultType m) (ArrayResultComponent m) => ArrayResult m where+ -- | The JVM machine type of the components of the array.+ type ArrayResultType m++ -- | The type of the component of the array as returned by+ -- the low level JNI call.+ type ArrayResultComponent m++ -- | Convert the array to a sophisticated type.+ toArrayResult :: Either JThrowable (Maybe (JArray (ArrayResultType m))) -> Java m++instance ArrayResult a => ArrayResult (Either JThrowable a) where+ type ArrayResultType (Either JThrowable a) = ArrayResultType a+ type ArrayResultComponent (Either JThrowable a) = ArrayResultComponent a++ toArrayResult = either (return . Left) (toArrayResult . Right)++++++++++instance ArrayResult [Bool] where { type ArrayResultType [Bool] = T.Z ; type ArrayResultComponent [Bool] = Bool ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Word16] where { type ArrayResultType [Word16] = T.C ; type ArrayResultComponent [Word16] = Word16 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Int8] where { type ArrayResultType [Int8] = T.B ; type ArrayResultComponent [Int8] = Int8 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Int16] where { type ArrayResultType [Int16] = T.S ; type ArrayResultComponent [Int16] = Int16 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Int32] where { type ArrayResultType [Int32] = T.I ; type ArrayResultComponent [Int32] = Int32 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Int64] where { type ArrayResultType [Int64] = T.J ; type ArrayResultComponent [Int64] = Int64 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Float] where { type ArrayResultType [Float] = T.F ; type ArrayResultComponent [Float] = Float ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+instance ArrayResult [Double] where { type ArrayResultType [Double] = T.D ; type ArrayResultComponent [Double] = Double ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }+++instance ArrayResult [Char] where+ type ArrayResultType [Char] = T.C+ type ArrayResultComponent [Char] = Word16++ toArrayResult = either (\exc -> toString exc >>= fail)+ (maybe (return [])+ (fmap (map (toEnum . fromIntegral)) . toList))++instance ArrayResult [String] where+ type ArrayResultType [String] = T.L+ type ArrayResultComponent [String] = Maybe JObject++ toArrayResult =+ either (\exc -> toString exc >>= fail)+ (maybe (return [])+ (\arr -> toList arr >>= mapM (maybe (return "") toString)))++++-----------------------+-- All other objects --+-----------------------+++-- | The result of a function call that is of type @object@.+class ObjectResult m where+ -- | + toObjectResult :: Either JThrowable (Maybe JObject) -> Java m++instance UnsafeCast a => ObjectResult (Value JThrowable a) where+ toObjectResult = either (return . Fail)+ (maybe (return NoValue)+ (fmap Value . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Either (Maybe JThrowable) a) where+ toObjectResult = either (return . Left . Just)+ (maybe (return (Left Nothing))+ (fmap Right . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Either JThrowable (Maybe a)) where+ toObjectResult = either (return . Left)+ (fmap Right . maybe (return Nothing)+ (fmap Just . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Maybe a) where+ toObjectResult = either (\exc -> toString exc >>= fail)+ (maybe (return Nothing)+ (fmap Just . unsafeFromJObject))++instance ObjectResult [Char] where+ toObjectResult = either (\exc -> toString exc >>= fail)+ (maybe (return "null") toString)+++---------------------------------------------------+-- Advanced features (Callbacks, Subtyping, ...) --+---------------------------------------------------+++-- | A convenient alternative to 'isInstanceOf'.+--+-- Minimal complete definition: 'coerce' or 'whenInstanceOf'.+class InstanceOf a where+ type CoercedType a++ -- | Check if the object of type @a@ is an instance+ -- of the type represented by @b@. + instanceOf :: JavaObject o => o -> a -> Java Bool++ -- | Check if the object of type @a@ is an instance+ -- of the type @c@, represented by @b@. If so, it will coerce+ -- the object of type @a@ and pass it to the given action.+ --+ -- If @a@ was an instance of @c@ (where @c@ is represented+ -- by @b@) this function will return @'Just' d@, where @d@ is+ -- the result of the optional computation. If not, 'Nothing'+ -- is returned.+ whenInstanceOf :: JavaObject o => o -> a -> (CoercedType a -> Java d) -> Java (Maybe d)++ -- | Coerces the given object of type @a@ to an object of+ -- @c@, where @c@ is represented by a value of type @b@.+ -- Returns @'Nothing'@ if this is not possible.+ coerce :: JavaObject o => o -> a -> Java (Maybe (CoercedType a))++ instanceOf o t =+ whenInstanceOf o t (return . const ())+ >>= return . maybe False (const True)++ whenInstanceOf o t a =+ coerce o t >>= maybe (return Nothing) (fmap Just . a)++ coerce o t = whenInstanceOf o t return++-- | For INTERNAL use only. Is however not in a hidden module,+-- so that other libraries can link against it.+class UnsafeCast a where+ -- | For INTERNAL use only. Do not use yourself.+ unsafeFromJObject :: JObject -> Java a++++---------------+-- Callbacks --+---------------+++registerCallbacks :: Core.JClass -> Java Bool+-- ^ Yepp. Register callbacks. Do it.+registerCallbacks (Core.JClass ptr) = do+ vm <- getVM+ io $ withForeignPtr ptr $ \clazz -> JNI.registerCallbacks vm clazz++-- | A wrapped function can be used as a callback from the+-- JVM into the Haskell runtime environment.+type WrappedFun = Ptr Core.JVM -- Ptr to JEnv+ -> Ptr Core.JObjectRef -- Ptr to this, a proxy+ -> Ptr Core.JObjectRef -- Ptr to method, the requested method+ -> Ptr Core.JObjectRef -- Ptr to a JObject-Array (Object[]), the arguments+ -> IO (Ptr Core.JObjectRef) -- Returns a pointer to the result+++runJava_ :: Ptr Core.JVM -> Java a -> IO a+runJava_ vm f = runStateT (_runJava f) (newJVMState vm) >>= return . fst++foreign import ccall safe "wrapper"+ wrap_ :: WrappedFun -> IO (FunPtr WrappedFun)++foreign export ccall freeFunPtr :: FunPtr WrappedFun -> IO ()+++freeFunPtr :: FunPtr WrappedFun -> IO ()+freeFunPtr ptr = freeHaskellFunPtr ptr+++wrap :: Java () -> IO (FunPtr WrappedFun)+wrap f = do++ let func vm _self _method _args = do+ runJava_ vm f+ return nullPtr+ + func' <- wrap_ func++ return func'++intify :: Java () -> IO Int64+intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap+++sushimaki :: String -> Java () -> Java JObject+sushimaki ifaceName func = do+ iface <- getClass ifaceName >>= asObject . fromJust+ (Just clazz) <- getClass "HFunction"+ _success <- registerCallbacks clazz+ makeFunction <- clazz `bindStaticMethod` "makeFunction"+ ::= object "java.lang.Class" --> long --> object "java.lang.Object"+ (Just impl) <- io (intify func) >>= makeFunction (Just iface)+ return impl+++delete :: Core.JObject -> Java ()+delete (Core.JObject ptr) = io $ do+ finalizeForeignPtr ptr+++
+ dist/build/Foreign/Java/JNI/Safe.hs view
@@ -0,0 +1,683 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++-- |+-- Module : Foreign.Java.JNI.Safe+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : stable+-- Portability : portable (Haskell2010)+--+-- Low level interface to the Java Virtual Machine.+-- This module is a very thin wrapper over the Java Native Interface.+--+-- Note that all functions that return references (of type @Ptr JObjectRef@)+-- return global references which you will need to free manually.+-- +-- This module contains safe bindings, see also+-- "Foreign.Java.JNI.Unsafe".+-- +-- Read the /The Java Native Interface - Programmer's Guide and Specification/+-- for further information on the Java Native Interface+-- (available at <http://www.soi.city.ac.uk/~kloukin/IN2P3/material/jni.pdf>,+-- and <http://192.9.162.55/docs/books/jni/>).+module Foreign.Java.JNI.Safe (++-- * Controlling the virtual machine++JVM,++createVM,+createVM',+destroyVM,+persistVM,++-- * Discovering classes++JClassRef,+findClass,++-- * Object creation++JConstructorID,+JObjectRef,++getConstructorID,+newObject,++-- ** Array creation++newBooleanArray,+newCharArray,+newLongArray,+newIntArray,+newShortArray,+newByteArray,+newFloatArray,+newDoubleArray,+newObjectArray,++-- * Method access++JStaticMethodID,+JMethodID,++getStaticMethodID,+getMethodID,++-- ** Static method invocation++callStaticVoidMethod,+callStaticBooleanMethod,+callStaticCharMethod,+callStaticByteMethod,+callStaticShortMethod,+callStaticIntMethod,+callStaticLongMethod,+callStaticFloatMethod,+callStaticDoubleMethod,+callStaticObjectMethod,+callStaticStringMethod,++-- ** Method invocation++callVoidMethod,+callBooleanMethod,+callCharMethod,+callByteMethod,+callShortMethod,+callIntMethod,+callLongMethod,+callFloatMethod,+callDoubleMethod,+callObjectMethod,+callStringMethod,++-- * Field access++JFieldID,+JStaticFieldID,++getFieldID,+getStaticFieldID,++-- ** Static getters++getStaticBooleanField,+getStaticCharField,+getStaticByteField,+getStaticShortField,+getStaticIntField,+getStaticLongField,+getStaticFloatField,+getStaticDoubleField,+getStaticObjectField,+getStaticStringField,++-- ** Static setters++setStaticBooleanField,+setStaticCharField,+setStaticByteField,+setStaticShortField,+setStaticIntField,+setStaticLongField,+setStaticFloatField,+setStaticDoubleField,+setStaticObjectField,+setStaticStringField,++-- ** Member getters++getBooleanField,+getCharField,+getByteField,+getShortField,+getIntField,+getLongField,+getFloatField,+getDoubleField,+getObjectField,+getStringField,++-- ** Member setters++setBooleanField,+setCharField,+setByteField,+setShortField,+setIntField,+setLongField,+setFloatField,+setDoubleField,+setObjectField,+setStringField,++-- * Argument passing++JValues,+JArg (..),++mkJValues,++newJValues,+setJValueByte,+setJValueShort,+setJValueInt,+setJValueLong,+setJValueFloat,+setJValueDouble,+setJValueObject,+setJValueString,++-- * Releasing resources++releaseJObjectRef,+releaseJClassRef,+releaseJThrowableRef,+release,++-- * Special data types++-- ** String handling++JChars,+JBytes,++newJString,+charsFromJString,+bytesFromJString,+releaseJChars,+releaseJBytes,+jStringToCString,++-- ** Array handling++getArrayLength,++-- ** Reflection++getObjectClass,+isInstanceOf,++-- ** Exception handling++JThrowableRef,++exceptionCheck,+exceptionOccurred,+exceptionOccurredClear,+exceptionClear,+exceptionDescribe,++-- * Debugging++getDebugStatus,+setDebugStatus,++-- * libjvm initialization++getLibjvmPath,+getCompiledLibjvmPath,+setLibjvmPath,+registerCallbacks,++-- * Primitive types++Z (Z), C (C), B (B), S (S), I (I), J (J),+D (D), F (F), L (L), V (V), A (A), X (X),++-- * Workarounds for certain platforms++runCocoaMain++) where++import Data.Int+import Data.Word++import Foreign+import Foreign.C.Types+import Foreign.C.String++import Foreign.Java.JNI.Types++-- | Create a JValues Array which can be used for argument+-- passing to a multi parameter method. You need to free the+-- Ptr object manually using 'free'.+--+-- This method is implemented using @calloc@ internally.+-- See the native implementation of @newJValues@.+mkJValues :: Ptr JVM -> [JArg] -> IO (Ptr JValues)+mkJValues vm args = do+ jvalues <- newJValues $ fromIntegral $ length args+ fillJValuesArray vm (0 :: CInt) args jvalues++fillJValuesArray :: Ptr JVM -> CInt -> [JArg] -> Ptr JValues -> IO (Ptr JValues)+fillJValuesArray _ _ [] jvalues = return jvalues+fillJValuesArray vm ix (x:xs) jvalues = setValue >> fillJValuesArray vm (ix+1) xs jvalues+ where+ setValue =+ case x of+ (BooleanA v) -> setJValueBoolean jvalues ix v+ (CharA v) -> setJValueChar jvalues ix v+ (ByteA v) -> setJValueByte jvalues ix v+ (ShortA v) -> setJValueShort jvalues ix v+ (IntA v) -> setJValueInt jvalues ix v+ (LongA v) -> setJValueLong jvalues ix v+ (FloatA v) -> setJValueFloat jvalues ix $ realToFrac v+ (DoubleA v) -> setJValueDouble jvalues ix $ realToFrac v+ (ObjectA (Just v)) -> withForeignPtr (jobjectPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ObjectA Nothing) -> setJValueObject jvalues ix nullPtr+ (ArrayA (Just v)) -> withForeignPtr (jarrayPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ArrayA Nothing) -> setJValueObject jvalues ix nullPtr+ (StringA v) -> do+ cstring <- newCString v+ setJValueString vm jvalues ix cstring+ free cstring++foreign import ccall safe "ffijni.h createVM"+ createVM :: IO (Ptr JVM)++foreign import ccall safe "ffijni.h createVM2"+ createVM' :: Word32 -- ^ The number of arguments (like argc)+ -> Ptr CString -- ^ A @char**@ to the arguments (like argv)+ -> IO (Ptr JVM) -- ^ Returns a Ptr to the newly running JVM++foreign import ccall safe "ffijni.h destroyVM"+ destroyVM :: Ptr JVM -> IO ()++foreign import ccall safe "ffijni.h persistVM"+ persistVM :: Ptr JVM -> IO ()++foreign import ccall safe "ffijni.h findClass"+ findClass :: Ptr JVM -> CString -> IO (Ptr JClassRef)++foreign import ccall safe "ffijni.h newObject"+ newObject :: Ptr JVM -> Ptr JClassRef -> Ptr JConstructorID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h getConstructorID"+ getConstructorID :: Ptr JVM -> Ptr JClassRef -> CString -> IO (Ptr JConstructorID)++foreign import ccall safe "ffijni.h getStaticMethodID"+ getStaticMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticMethodID)++foreign import ccall safe "ffijni.h getMethodID"+ getMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JMethodID)++foreign import ccall safe "ffijni.h getStaticFieldID"+ getStaticFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticFieldID)++foreign import ccall safe "ffijni.h getFieldID"+ getFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JFieldID)++foreign import ccall safe "ffijni.h callStaticVoidMethod"+ callStaticVoidMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO ()++foreign import ccall safe "ffijni.h callStaticIntMethod"+ callStaticIntMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int32++foreign import ccall safe "ffijni.h callStaticLongMethod"+ callStaticLongMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int64++foreign import ccall safe "ffijni.h callStaticShortMethod"+ callStaticShortMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int16++foreign import ccall safe "ffijni.h callStaticByteMethod"+ callStaticByteMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int8++foreign import ccall safe "ffijni.h callStaticFloatMethod"+ callStaticFloatMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CFloat++foreign import ccall safe "ffijni.h callStaticDoubleMethod"+ callStaticDoubleMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CDouble++foreign import ccall safe "ffijni.h callStaticBooleanMethod"+ callStaticBooleanMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Bool++foreign import ccall safe "ffijni.h callStaticCharMethod"+ callStaticCharMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Word16++foreign import ccall safe "ffijni.h callStaticObjectMethod"+ callStaticObjectMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h callStaticStringMethod"+ callStaticStringMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CString++foreign import ccall safe "ffijni.h callVoidMethod"+ callVoidMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO ()++foreign import ccall safe "ffijni.h callLongMethod"+ callLongMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int64++foreign import ccall safe "ffijni.h callIntMethod"+ callIntMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int32++foreign import ccall safe "ffijni.h callShortMethod"+ callShortMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int16++foreign import ccall safe "ffijni.h callByteMethod"+ callByteMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int8++foreign import ccall safe "ffijni.h callFloatMethod"+ callFloatMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CFloat++foreign import ccall safe "ffijni.h callDoubleMethod"+ callDoubleMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CDouble++foreign import ccall safe "ffijni.h callBooleanMethod"+ callBooleanMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Bool++foreign import ccall safe "ffijni.h callCharMethod"+ callCharMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Word16++foreign import ccall safe "ffijni.h callObjectMethod"+ callObjectMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h callStringMethod"+ callStringMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CString++foreign import ccall safe "ffijni.h getStaticLongField"+ getStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int64++foreign import ccall safe "ffijni.h getStaticIntField"+ getStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int32++foreign import ccall safe "ffijni.h getStaticShortField"+ getStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int16++foreign import ccall safe "ffijni.h getStaticByteField"+ getStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int8++foreign import ccall safe "ffijni.h getStaticFloatField"+ getStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CFloat++foreign import ccall safe "ffijni.h getStaticDoubleField"+ getStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CDouble++foreign import ccall safe "ffijni.h getStaticBooleanField"+ getStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Bool++foreign import ccall safe "ffijni.h getStaticCharField"+ getStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Word16++foreign import ccall safe "ffijni.h getStaticObjectField"+ getStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h getStaticStringField"+ getStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CString++foreign import ccall safe "ffijni.h getLongField"+ getLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int64++foreign import ccall safe "ffijni.h getIntField"+ getIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int32++foreign import ccall safe "ffijni.h getShortField"+ getShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int16++foreign import ccall safe "ffijni.h getByteField"+ getByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int8++foreign import ccall safe "ffijni.h getFloatField"+ getFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CFloat++foreign import ccall safe "ffijni.h getDoubleField"+ getDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CDouble++foreign import ccall safe "ffijni.h getBooleanField"+ getBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Bool++foreign import ccall safe "ffijni.h getCharField"+ getCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Word16++foreign import ccall safe "ffijni.h getObjectField"+ getObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h getStringField"+ getStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CString++foreign import ccall safe "ffijni.h setStaticLongField"+ setStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int64 -> IO ()++foreign import ccall safe "ffijni.h setStaticIntField"+ setStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int32 -> IO ()++foreign import ccall safe "ffijni.h setStaticShortField"+ setStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int16 -> IO ()++foreign import ccall safe "ffijni.h setStaticByteField"+ setStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int8 -> IO ()++foreign import ccall safe "ffijni.h setStaticFloatField"+ setStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CFloat -> IO ()++foreign import ccall safe "ffijni.h setStaticDoubleField"+ setStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CDouble -> IO ()++foreign import ccall safe "ffijni.h setStaticBooleanField"+ setStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Bool -> IO ()++foreign import ccall safe "ffijni.h setStaticCharField"+ setStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Word16 -> IO ()++foreign import ccall safe "ffijni.h setStaticObjectField"+ setStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall safe "ffijni.h setStaticStringField"+ setStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CString -> IO ()++foreign import ccall safe "ffijni.h setLongField"+ setLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int64 -> IO ()++foreign import ccall safe "ffijni.h setIntField"+ setIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int32 -> IO ()++foreign import ccall safe "ffijni.h setShortField"+ setShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int16 -> IO ()++foreign import ccall safe "ffijni.h setByteField"+ setByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int8 -> IO ()++foreign import ccall safe "ffijni.h setFloatField"+ setFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CFloat -> IO ()++foreign import ccall safe "ffijni.h setDoubleField"+ setDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CDouble -> IO ()++foreign import ccall safe "ffijni.h setBooleanField"+ setBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Bool -> IO ()++foreign import ccall safe "ffijni.h setCharField"+ setCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Word16 -> IO ()++foreign import ccall safe "ffijni.h setObjectField"+ setObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall safe "ffijni.h setStringField"+ setStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CString -> IO ()++foreign import ccall safe "ffijni.h newJValues"+ newJValues :: CInt -> IO (Ptr JValues)++foreign import ccall safe "ffijni.h setJValueLong"+ setJValueLong :: Ptr JValues -> CInt -> Int64 -> IO ()++foreign import ccall safe "ffijni.h setJValueInt"+ setJValueInt :: Ptr JValues -> CInt -> Int32 -> IO ()++foreign import ccall safe "ffijni.h setJValueShort"+ setJValueShort :: Ptr JValues -> CInt -> Int16 -> IO ()++foreign import ccall safe "ffijni.h setJValueByte"+ setJValueByte :: Ptr JValues -> CInt -> Int8 -> IO ()++foreign import ccall safe "ffijni.h setJValueFloat"+ setJValueFloat :: Ptr JValues -> CInt -> CFloat -> IO ()++foreign import ccall safe "ffijni.h setJValueDouble"+ setJValueDouble :: Ptr JValues -> CInt -> CDouble -> IO ()++foreign import ccall safe "ffijni.h setJValueBoolean"+ setJValueBoolean :: Ptr JValues -> CInt -> Bool -> IO ()++foreign import ccall safe "ffijni.h setJValueChar"+ setJValueChar :: Ptr JValues -> CInt -> Word16 -> IO ()++foreign import ccall safe "ffijni.h setJValueObject"+ setJValueObject :: Ptr JValues -> CInt -> Ptr JObjectRef -> IO ()++foreign import ccall safe "ffijni.h setJValueString"+ setJValueString :: Ptr JVM -> Ptr JValues -> CInt -> CString -> IO ()++foreign import ccall safe "ffijni.h newBooleanArray"+ newBooleanArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newCharArray"+ newCharArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newLongArray"+ newLongArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newIntArray"+ newIntArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newShortArray"+ newShortArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newByteArray"+ newByteArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newFloatArray"+ newFloatArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newDoubleArray"+ newDoubleArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newObjectArray"+ newObjectArray :: Ptr JVM -> Int32 -> Ptr JClass -> Ptr JObjectRef++foreign import ccall safe "ffijni.h newJString"+ newJString :: Ptr JVM -> CString -> IO (Ptr JObjectRef)++foreign import ccall safe "ffijni.h charsFromJString"+ charsFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JChars)++foreign import ccall safe "ffijni.h bytesFromJString"+ bytesFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JBytes)++foreign import ccall safe "ffijni.h releaseJChars"+ releaseJChars :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall safe "ffijni.h releaseJBytes"+ releaseJBytes :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall safe "ffijni.h jStringToCString"+ jStringToCString :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall safe "ffijni.h getArrayLength"+ getArrayLength :: Ptr JVM -> Ptr JObjectRef -> IO Int32++foreign import ccall safe "ffijni.h getObjectClass"+ getObjectClass :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JClassRef)++foreign import ccall safe "ffijni.h isInstanceOf"+ isInstanceOf :: Ptr JVM -> Ptr JObjectRef -> Ptr JClassRef -> IO Bool++-- | Returns the path to libjvm that is used by this library.+-- Note that this will return the @nullPtr@ if the library has not+-- yet been initialized. The library is lazily initialized the first+-- time that 'runJava'' is used. 'runJava' is implemented in terms of+-- 'runJava', as is 'initJava'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall safe "ffijni.h getLibjvmPath"+ getLibjvmPath :: IO CString++-- | Returns the path to libjvm with which this library has been+-- compiled. This is guaranteed to never return 'nullPtr'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall safe "ffijni.h getCompiledLibjvmPath"+ getCompiledLibjvmPath :: IO CString++-- | Sets the path to libjvm. Note that this will only have an+-- effect if the library has not yet been initialized, that is+-- before any of the following functions is used: 'runJava',+-- 'runJava'', and 'initJava'.+--+-- Do not invoke 'free' on the cstring passed to this function,+-- as this function will not set a copy but the object given.+-- It is only ever used once during the lifecycle of your+-- application.+foreign import ccall safe "ffijni.h setLibjvmPath"+ setLibjvmPath :: CString -> IO ()++-- | Checks whether an exception has occured in the virtual+-- machine or not.+foreign import ccall safe "ffijni.h exceptionCheck"+ exceptionCheck :: Ptr JVM -> IO Bool++foreign import ccall safe "ffijni.h exceptionClear"+ exceptionClear :: Ptr JVM -> IO ()++foreign import ccall safe "ffijni.h exceptionDescribe"+ exceptionDescribe :: Ptr JVM -> IO ()++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will return a local reference only, so beware that the+-- obtained Ptr will not be valid for too long.+foreign import ccall safe "ffijni.h exceptionOccurred"+ exceptionOccurred :: Ptr JVM -> IO (Ptr JThrowableRef)++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will also call exceptionClear which means that it can+-- not be called twice. This method will return a global reference+-- - as opposed to 'exceptionOccurred', which will return a local+-- reference only.+foreign import ccall safe "ffijni.h exceptionOccurredClear"+ exceptionOccurredClear :: Ptr JVM -> IO (Ptr JThrowableRef)++foreign import ccall safe "ffijni.h releaseJObjectRef"+ releaseJObjectRef :: Ptr JVM -> Ptr JObjectRef -> IO ()++foreign import ccall safe "ffijni.h releaseJClassRef"+ releaseJClassRef :: Ptr JVM -> Ptr JClassRef -> IO ()++foreign import ccall safe "ffijni.h releaseJThrowableRef"+ releaseJThrowableRef :: Ptr JVM -> Ptr JThrowableRef -> IO ()++foreign import ccall safe "ffijni.h &release"+ release_ :: FunPtr (Ptr a -> IO ())++class ReleaseGlobalReference a where+ release :: FunPtr (Ptr a -> IO ())+ -- ^ @release@ is a special function which can be used to create a+ -- 'ForeignPtr'. A ForeignPtr does not carry a reference to a virtual+ -- machine (no @Ptr JVM@), thus this function will lookup the current+ -- virtual machine or do nothing if it can not find one. It is+ -- realised as a 'FunPtr' as this is what 'newForeignPtr' expects.+ release = release_++instance ReleaseGlobalReference JObjectRef+instance ReleaseGlobalReference JClassRef+instance ReleaseGlobalReference JThrowableRef++foreign import ccall safe "ffijni.h registerCallbacks"+ registerCallbacks :: Ptr JVM -> Ptr JClassRef -> IO Bool++foreign import ccall safe "ffijni.h getDebugStatus"+ getDebugStatus :: IO Bool++foreign import ccall safe "ffijni.h setDebugStatus"+ setDebugStatus :: Bool -> IO ()++foreign import ccall safe "ffijni.h runCocoaMain"+ runCocoaMain :: IO ()+
+ dist/build/Foreign/Java/JNI/Unsafe.hs view
@@ -0,0 +1,683 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++-- |+-- Module : Foreign.Java.JNI.Unsafe+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : stable+-- Portability : portable (Haskell2010)+--+-- Low level interface to the Java Virtual Machine.+-- This module is a very thin wrapper over the Java Native Interface.+--+-- Note that all functions that return references (of type @Ptr JObjectRef@)+-- return global references which you will need to free manually.+-- +-- This module contains unsafe bindings, see also+-- "Foreign.Java.JNI.Safe".+-- +-- Read the /The Java Native Interface - Programmer's Guide and Specification/+-- for further information on the Java Native Interface+-- (available at <http://www.soi.city.ac.uk/~kloukin/IN2P3/material/jni.pdf>,+-- and <http://192.9.162.55/docs/books/jni/>).+module Foreign.Java.JNI.Unsafe (++-- * Controlling the virtual machine++JVM,++createVM,+createVM',+destroyVM,+persistVM,++-- * Discovering classes++JClassRef,+findClass,++-- * Object creation++JConstructorID,+JObjectRef,++getConstructorID,+newObject,++-- ** Array creation++newBooleanArray,+newCharArray,+newLongArray,+newIntArray,+newShortArray,+newByteArray,+newFloatArray,+newDoubleArray,+newObjectArray,++-- * Method access++JStaticMethodID,+JMethodID,++getStaticMethodID,+getMethodID,++-- ** Static method invocation++callStaticVoidMethod,+callStaticBooleanMethod,+callStaticCharMethod,+callStaticByteMethod,+callStaticShortMethod,+callStaticIntMethod,+callStaticLongMethod,+callStaticFloatMethod,+callStaticDoubleMethod,+callStaticObjectMethod,+callStaticStringMethod,++-- ** Method invocation++callVoidMethod,+callBooleanMethod,+callCharMethod,+callByteMethod,+callShortMethod,+callIntMethod,+callLongMethod,+callFloatMethod,+callDoubleMethod,+callObjectMethod,+callStringMethod,++-- * Field access++JFieldID,+JStaticFieldID,++getFieldID,+getStaticFieldID,++-- ** Static getters++getStaticBooleanField,+getStaticCharField,+getStaticByteField,+getStaticShortField,+getStaticIntField,+getStaticLongField,+getStaticFloatField,+getStaticDoubleField,+getStaticObjectField,+getStaticStringField,++-- ** Static setters++setStaticBooleanField,+setStaticCharField,+setStaticByteField,+setStaticShortField,+setStaticIntField,+setStaticLongField,+setStaticFloatField,+setStaticDoubleField,+setStaticObjectField,+setStaticStringField,++-- ** Member getters++getBooleanField,+getCharField,+getByteField,+getShortField,+getIntField,+getLongField,+getFloatField,+getDoubleField,+getObjectField,+getStringField,++-- ** Member setters++setBooleanField,+setCharField,+setByteField,+setShortField,+setIntField,+setLongField,+setFloatField,+setDoubleField,+setObjectField,+setStringField,++-- * Argument passing++JValues,+JArg (..),++mkJValues,++newJValues,+setJValueByte,+setJValueShort,+setJValueInt,+setJValueLong,+setJValueFloat,+setJValueDouble,+setJValueObject,+setJValueString,++-- * Releasing resources++releaseJObjectRef,+releaseJClassRef,+releaseJThrowableRef,+release,++-- * Special data types++-- ** String handling++JChars,+JBytes,++newJString,+charsFromJString,+bytesFromJString,+releaseJChars,+releaseJBytes,+jStringToCString,++-- ** Array handling++getArrayLength,++-- ** Reflection++getObjectClass,+isInstanceOf,++-- ** Exception handling++JThrowableRef,++exceptionCheck,+exceptionOccurred,+exceptionOccurredClear,+exceptionClear,+exceptionDescribe,++-- * Debugging++getDebugStatus,+setDebugStatus,++-- * libjvm initialization++getLibjvmPath,+getCompiledLibjvmPath,+setLibjvmPath,+registerCallbacks,++-- * Primitive types++Z (Z), C (C), B (B), S (S), I (I), J (J),+D (D), F (F), L (L), V (V), A (A), X (X),++-- * Workarounds for certain platforms++runCocoaMain++) where++import Data.Int+import Data.Word++import Foreign+import Foreign.C.Types+import Foreign.C.String++import Foreign.Java.JNI.Types++-- | Create a JValues Array which can be used for argument+-- passing to a multi parameter method. You need to free the+-- Ptr object manually using 'free'.+--+-- This method is implemented using @calloc@ internally.+-- See the native implementation of @newJValues@.+mkJValues :: Ptr JVM -> [JArg] -> IO (Ptr JValues)+mkJValues vm args = do+ jvalues <- newJValues $ fromIntegral $ length args+ fillJValuesArray vm (0 :: CInt) args jvalues++fillJValuesArray :: Ptr JVM -> CInt -> [JArg] -> Ptr JValues -> IO (Ptr JValues)+fillJValuesArray _ _ [] jvalues = return jvalues+fillJValuesArray vm ix (x:xs) jvalues = setValue >> fillJValuesArray vm (ix+1) xs jvalues+ where+ setValue =+ case x of+ (BooleanA v) -> setJValueBoolean jvalues ix v+ (CharA v) -> setJValueChar jvalues ix v+ (ByteA v) -> setJValueByte jvalues ix v+ (ShortA v) -> setJValueShort jvalues ix v+ (IntA v) -> setJValueInt jvalues ix v+ (LongA v) -> setJValueLong jvalues ix v+ (FloatA v) -> setJValueFloat jvalues ix $ realToFrac v+ (DoubleA v) -> setJValueDouble jvalues ix $ realToFrac v+ (ObjectA (Just v)) -> withForeignPtr (jobjectPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ObjectA Nothing) -> setJValueObject jvalues ix nullPtr+ (ArrayA (Just v)) -> withForeignPtr (jarrayPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ArrayA Nothing) -> setJValueObject jvalues ix nullPtr+ (StringA v) -> do+ cstring <- newCString v+ setJValueString vm jvalues ix cstring+ free cstring++foreign import ccall unsafe "ffijni.h createVM"+ createVM :: IO (Ptr JVM)++foreign import ccall unsafe "ffijni.h createVM2"+ createVM' :: Word32 -- ^ The number of arguments (like argc)+ -> Ptr CString -- ^ A @char**@ to the arguments (like argv)+ -> IO (Ptr JVM) -- ^ Returns a Ptr to the newly running JVM++foreign import ccall unsafe "ffijni.h destroyVM"+ destroyVM :: Ptr JVM -> IO ()++foreign import ccall unsafe "ffijni.h persistVM"+ persistVM :: Ptr JVM -> IO ()++foreign import ccall unsafe "ffijni.h findClass"+ findClass :: Ptr JVM -> CString -> IO (Ptr JClassRef)++foreign import ccall unsafe "ffijni.h newObject"+ newObject :: Ptr JVM -> Ptr JClassRef -> Ptr JConstructorID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h getConstructorID"+ getConstructorID :: Ptr JVM -> Ptr JClassRef -> CString -> IO (Ptr JConstructorID)++foreign import ccall unsafe "ffijni.h getStaticMethodID"+ getStaticMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticMethodID)++foreign import ccall unsafe "ffijni.h getMethodID"+ getMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JMethodID)++foreign import ccall unsafe "ffijni.h getStaticFieldID"+ getStaticFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticFieldID)++foreign import ccall unsafe "ffijni.h getFieldID"+ getFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JFieldID)++foreign import ccall unsafe "ffijni.h callStaticVoidMethod"+ callStaticVoidMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO ()++foreign import ccall unsafe "ffijni.h callStaticIntMethod"+ callStaticIntMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int32++foreign import ccall unsafe "ffijni.h callStaticLongMethod"+ callStaticLongMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int64++foreign import ccall unsafe "ffijni.h callStaticShortMethod"+ callStaticShortMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int16++foreign import ccall unsafe "ffijni.h callStaticByteMethod"+ callStaticByteMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int8++foreign import ccall unsafe "ffijni.h callStaticFloatMethod"+ callStaticFloatMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CFloat++foreign import ccall unsafe "ffijni.h callStaticDoubleMethod"+ callStaticDoubleMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CDouble++foreign import ccall unsafe "ffijni.h callStaticBooleanMethod"+ callStaticBooleanMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Bool++foreign import ccall unsafe "ffijni.h callStaticCharMethod"+ callStaticCharMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Word16++foreign import ccall unsafe "ffijni.h callStaticObjectMethod"+ callStaticObjectMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h callStaticStringMethod"+ callStaticStringMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CString++foreign import ccall unsafe "ffijni.h callVoidMethod"+ callVoidMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO ()++foreign import ccall unsafe "ffijni.h callLongMethod"+ callLongMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int64++foreign import ccall unsafe "ffijni.h callIntMethod"+ callIntMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int32++foreign import ccall unsafe "ffijni.h callShortMethod"+ callShortMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int16++foreign import ccall unsafe "ffijni.h callByteMethod"+ callByteMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int8++foreign import ccall unsafe "ffijni.h callFloatMethod"+ callFloatMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CFloat++foreign import ccall unsafe "ffijni.h callDoubleMethod"+ callDoubleMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CDouble++foreign import ccall unsafe "ffijni.h callBooleanMethod"+ callBooleanMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Bool++foreign import ccall unsafe "ffijni.h callCharMethod"+ callCharMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Word16++foreign import ccall unsafe "ffijni.h callObjectMethod"+ callObjectMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h callStringMethod"+ callStringMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CString++foreign import ccall unsafe "ffijni.h getStaticLongField"+ getStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int64++foreign import ccall unsafe "ffijni.h getStaticIntField"+ getStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int32++foreign import ccall unsafe "ffijni.h getStaticShortField"+ getStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int16++foreign import ccall unsafe "ffijni.h getStaticByteField"+ getStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int8++foreign import ccall unsafe "ffijni.h getStaticFloatField"+ getStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CFloat++foreign import ccall unsafe "ffijni.h getStaticDoubleField"+ getStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CDouble++foreign import ccall unsafe "ffijni.h getStaticBooleanField"+ getStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Bool++foreign import ccall unsafe "ffijni.h getStaticCharField"+ getStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Word16++foreign import ccall unsafe "ffijni.h getStaticObjectField"+ getStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h getStaticStringField"+ getStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CString++foreign import ccall unsafe "ffijni.h getLongField"+ getLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int64++foreign import ccall unsafe "ffijni.h getIntField"+ getIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int32++foreign import ccall unsafe "ffijni.h getShortField"+ getShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int16++foreign import ccall unsafe "ffijni.h getByteField"+ getByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int8++foreign import ccall unsafe "ffijni.h getFloatField"+ getFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CFloat++foreign import ccall unsafe "ffijni.h getDoubleField"+ getDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CDouble++foreign import ccall unsafe "ffijni.h getBooleanField"+ getBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Bool++foreign import ccall unsafe "ffijni.h getCharField"+ getCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Word16++foreign import ccall unsafe "ffijni.h getObjectField"+ getObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h getStringField"+ getStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CString++foreign import ccall unsafe "ffijni.h setStaticLongField"+ setStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int64 -> IO ()++foreign import ccall unsafe "ffijni.h setStaticIntField"+ setStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int32 -> IO ()++foreign import ccall unsafe "ffijni.h setStaticShortField"+ setStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int16 -> IO ()++foreign import ccall unsafe "ffijni.h setStaticByteField"+ setStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int8 -> IO ()++foreign import ccall unsafe "ffijni.h setStaticFloatField"+ setStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CFloat -> IO ()++foreign import ccall unsafe "ffijni.h setStaticDoubleField"+ setStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CDouble -> IO ()++foreign import ccall unsafe "ffijni.h setStaticBooleanField"+ setStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Bool -> IO ()++foreign import ccall unsafe "ffijni.h setStaticCharField"+ setStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Word16 -> IO ()++foreign import ccall unsafe "ffijni.h setStaticObjectField"+ setStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall unsafe "ffijni.h setStaticStringField"+ setStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CString -> IO ()++foreign import ccall unsafe "ffijni.h setLongField"+ setLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int64 -> IO ()++foreign import ccall unsafe "ffijni.h setIntField"+ setIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int32 -> IO ()++foreign import ccall unsafe "ffijni.h setShortField"+ setShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int16 -> IO ()++foreign import ccall unsafe "ffijni.h setByteField"+ setByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int8 -> IO ()++foreign import ccall unsafe "ffijni.h setFloatField"+ setFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CFloat -> IO ()++foreign import ccall unsafe "ffijni.h setDoubleField"+ setDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CDouble -> IO ()++foreign import ccall unsafe "ffijni.h setBooleanField"+ setBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Bool -> IO ()++foreign import ccall unsafe "ffijni.h setCharField"+ setCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Word16 -> IO ()++foreign import ccall unsafe "ffijni.h setObjectField"+ setObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall unsafe "ffijni.h setStringField"+ setStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CString -> IO ()++foreign import ccall unsafe "ffijni.h newJValues"+ newJValues :: CInt -> IO (Ptr JValues)++foreign import ccall unsafe "ffijni.h setJValueLong"+ setJValueLong :: Ptr JValues -> CInt -> Int64 -> IO ()++foreign import ccall unsafe "ffijni.h setJValueInt"+ setJValueInt :: Ptr JValues -> CInt -> Int32 -> IO ()++foreign import ccall unsafe "ffijni.h setJValueShort"+ setJValueShort :: Ptr JValues -> CInt -> Int16 -> IO ()++foreign import ccall unsafe "ffijni.h setJValueByte"+ setJValueByte :: Ptr JValues -> CInt -> Int8 -> IO ()++foreign import ccall unsafe "ffijni.h setJValueFloat"+ setJValueFloat :: Ptr JValues -> CInt -> CFloat -> IO ()++foreign import ccall unsafe "ffijni.h setJValueDouble"+ setJValueDouble :: Ptr JValues -> CInt -> CDouble -> IO ()++foreign import ccall unsafe "ffijni.h setJValueBoolean"+ setJValueBoolean :: Ptr JValues -> CInt -> Bool -> IO ()++foreign import ccall unsafe "ffijni.h setJValueChar"+ setJValueChar :: Ptr JValues -> CInt -> Word16 -> IO ()++foreign import ccall unsafe "ffijni.h setJValueObject"+ setJValueObject :: Ptr JValues -> CInt -> Ptr JObjectRef -> IO ()++foreign import ccall unsafe "ffijni.h setJValueString"+ setJValueString :: Ptr JVM -> Ptr JValues -> CInt -> CString -> IO ()++foreign import ccall unsafe "ffijni.h newBooleanArray"+ newBooleanArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newCharArray"+ newCharArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newLongArray"+ newLongArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newIntArray"+ newIntArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newShortArray"+ newShortArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newByteArray"+ newByteArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newFloatArray"+ newFloatArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newDoubleArray"+ newDoubleArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newObjectArray"+ newObjectArray :: Ptr JVM -> Int32 -> Ptr JClass -> Ptr JObjectRef++foreign import ccall unsafe "ffijni.h newJString"+ newJString :: Ptr JVM -> CString -> IO (Ptr JObjectRef)++foreign import ccall unsafe "ffijni.h charsFromJString"+ charsFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JChars)++foreign import ccall unsafe "ffijni.h bytesFromJString"+ bytesFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JBytes)++foreign import ccall unsafe "ffijni.h releaseJChars"+ releaseJChars :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall unsafe "ffijni.h releaseJBytes"+ releaseJBytes :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall unsafe "ffijni.h jStringToCString"+ jStringToCString :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall unsafe "ffijni.h getArrayLength"+ getArrayLength :: Ptr JVM -> Ptr JObjectRef -> IO Int32++foreign import ccall unsafe "ffijni.h getObjectClass"+ getObjectClass :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JClassRef)++foreign import ccall unsafe "ffijni.h isInstanceOf"+ isInstanceOf :: Ptr JVM -> Ptr JObjectRef -> Ptr JClassRef -> IO Bool++-- | Returns the path to libjvm that is used by this library.+-- Note that this will return the @nullPtr@ if the library has not+-- yet been initialized. The library is lazily initialized the first+-- time that 'runJava'' is used. 'runJava' is implemented in terms of+-- 'runJava', as is 'initJava'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall unsafe "ffijni.h getLibjvmPath"+ getLibjvmPath :: IO CString++-- | Returns the path to libjvm with which this library has been+-- compiled. This is guaranteed to never return 'nullPtr'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall unsafe "ffijni.h getCompiledLibjvmPath"+ getCompiledLibjvmPath :: IO CString++-- | Sets the path to libjvm. Note that this will only have an+-- effect if the library has not yet been initialized, that is+-- before any of the following functions is used: 'runJava',+-- 'runJava'', and 'initJava'.+--+-- Do not invoke 'free' on the cstring passed to this function,+-- as this function will not set a copy but the object given.+-- It is only ever used once during the lifecycle of your+-- application.+foreign import ccall unsafe "ffijni.h setLibjvmPath"+ setLibjvmPath :: CString -> IO ()++-- | Checks whether an exception has occured in the virtual+-- machine or not.+foreign import ccall unsafe "ffijni.h exceptionCheck"+ exceptionCheck :: Ptr JVM -> IO Bool++foreign import ccall unsafe "ffijni.h exceptionClear"+ exceptionClear :: Ptr JVM -> IO ()++foreign import ccall unsafe "ffijni.h exceptionDescribe"+ exceptionDescribe :: Ptr JVM -> IO ()++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will return a local reference only, so beware that the+-- obtained Ptr will not be valid for too long.+foreign import ccall unsafe "ffijni.h exceptionOccurred"+ exceptionOccurred :: Ptr JVM -> IO (Ptr JThrowableRef)++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will also call exceptionClear which means that it can+-- not be called twice. This method will return a global reference+-- - as opposed to 'exceptionOccurred', which will return a local+-- reference only.+foreign import ccall unsafe "ffijni.h exceptionOccurredClear"+ exceptionOccurredClear :: Ptr JVM -> IO (Ptr JThrowableRef)++foreign import ccall unsafe "ffijni.h releaseJObjectRef"+ releaseJObjectRef :: Ptr JVM -> Ptr JObjectRef -> IO ()++foreign import ccall unsafe "ffijni.h releaseJClassRef"+ releaseJClassRef :: Ptr JVM -> Ptr JClassRef -> IO ()++foreign import ccall unsafe "ffijni.h releaseJThrowableRef"+ releaseJThrowableRef :: Ptr JVM -> Ptr JThrowableRef -> IO ()++foreign import ccall unsafe "ffijni.h &release"+ release_ :: FunPtr (Ptr a -> IO ())++class ReleaseGlobalReference a where+ release :: FunPtr (Ptr a -> IO ())+ -- ^ @release@ is a special function which can be used to create a+ -- 'ForeignPtr'. A ForeignPtr does not carry a reference to a virtual+ -- machine (no @Ptr JVM@), thus this function will lookup the current+ -- virtual machine or do nothing if it can not find one. It is+ -- realised as a 'FunPtr' as this is what 'newForeignPtr' expects.+ release = release_++instance ReleaseGlobalReference JObjectRef+instance ReleaseGlobalReference JClassRef+instance ReleaseGlobalReference JThrowableRef++foreign import ccall unsafe "ffijni.h registerCallbacks"+ registerCallbacks :: Ptr JVM -> Ptr JClassRef -> IO Bool++foreign import ccall unsafe "ffijni.h getDebugStatus"+ getDebugStatus :: IO Bool++foreign import ccall unsafe "ffijni.h setDebugStatus"+ setDebugStatus :: Bool -> IO ()++foreign import ccall unsafe "ffijni.h runCocoaMain"+ runCocoaMain :: IO ()+
+ include/jni.h view
@@ -0,0 +1,714 @@+#ifndef _JNI_H_+#define _JNI_H_++#include <stdio.h>+#include <stdarg.h>+#include <stdint.h>++#define JNI_VERSION_1_1 0x00010001+#define JNI_VERSION_1_2 0x00010002+#define JNI_VERSION_1_4 0x00010004+#define JNI_VERSION_1_6 0x00010006++#define JNICALL++#define JNI_FALSE 0+#define JNI_TRUE 1++#define JNI_OK 0+#define JNI_ERR (-1)+#define JNI_EDETACHED (-2)+#define JNI_EVERSION (-3)+#define JNI_ENOMEM (-4)+#define JNI_EEXIST (-5)+#define JNI_EINVAL (-6)++#define JNI_COMMIT 1+#define JNI_ABORT 2+++typedef int8_t jbyte;+typedef int32_t jint;+typedef int64_t jlong;++typedef uint8_t jboolean;+typedef uint16_t jchar;+typedef int16_t jshort;+typedef float jfloat;+typedef double jdouble;++typedef jint jsize;+++struct _jobject;++typedef struct _jobject *jobject;+typedef jobject jclass;+typedef jobject jthrowable;+typedef jobject jstring;+typedef jobject jarray;+typedef jarray jbooleanArray;+typedef jarray jbyteArray;+typedef jarray jcharArray;+typedef jarray jshortArray;+typedef jarray jintArray;+typedef jarray jlongArray;+typedef jarray jfloatArray;+typedef jarray jdoubleArray;+typedef jarray jobjectArray;+++typedef jobject jweak;++typedef union jvalue {+ jboolean z;+ jbyte b;+ jchar c;+ jshort s;+ jint i;+ jlong j;+ jfloat f;+ jdouble d;+ jobject l;+} jvalue;++struct _jfieldID;+typedef struct _jfieldID *jfieldID;++struct _jmethodID;+typedef struct _jmethodID *jmethodID;++typedef enum _jobjectType {+ JNIInvalidRefType = 0,+ JNILocalRefType = 1,+ JNIGlobalRefType = 2,+ JNIWeakGlobalRefType = 3+} jobjectRefType;+++typedef struct {+ char *name;+ char *signature;+ void *fnPtr;+} JNINativeMethod;+++struct JNINativeInterface_;++struct JNIEnv_;++typedef const struct JNINativeInterface_ *JNIEnv;+++struct JNIInvokeInterface_;++struct JavaVM_;++typedef const struct JNIInvokeInterface_ *JavaVM;++++struct JNINativeInterface_ {+ void *reserved0;+ void *reserved1;+ void *reserved2;++ void *reserved3;+ jint (JNICALL *GetVersion)(JNIEnv *env);++ jclass (JNICALL *DefineClass)+ (JNIEnv *env, const char *name, jobject loader, const jbyte *buf,+ jsize len);+ jclass (JNICALL *FindClass)+ (JNIEnv *env, const char *name);++ jmethodID (JNICALL *FromReflectedMethod)+ (JNIEnv *env, jobject method);+ jfieldID (JNICALL *FromReflectedField)+ (JNIEnv *env, jobject field);++ jobject (JNICALL *ToReflectedMethod)+ (JNIEnv *env, jclass cls, jmethodID methodID, jboolean isStatic);++ jclass (JNICALL *GetSuperclass)+ (JNIEnv *env, jclass sub);+ jboolean (JNICALL *IsAssignableFrom)+ (JNIEnv *env, jclass sub, jclass sup);++ jobject (JNICALL *ToReflectedField)+ (JNIEnv *env, jclass cls, jfieldID fieldID, jboolean isStatic);++ jint (JNICALL *Throw)+ (JNIEnv *env, jthrowable obj);+ jint (JNICALL *ThrowNew)+ (JNIEnv *env, jclass clazz, const char *msg);+ jthrowable (JNICALL *ExceptionOccurred)+ (JNIEnv *env);+ void (JNICALL *ExceptionDescribe)+ (JNIEnv *env);+ void (JNICALL *ExceptionClear)+ (JNIEnv *env);+ void (JNICALL *FatalError)+ (JNIEnv *env, const char *msg);++ jint (JNICALL *PushLocalFrame)+ (JNIEnv *env, jint capacity);+ jobject (JNICALL *PopLocalFrame)+ (JNIEnv *env, jobject result);++ jobject (JNICALL *NewGlobalRef)+ (JNIEnv *env, jobject lobj);+ void (JNICALL *DeleteGlobalRef)+ (JNIEnv *env, jobject gref);+ void (JNICALL *DeleteLocalRef)+ (JNIEnv *env, jobject obj);+ jboolean (JNICALL *IsSameObject)+ (JNIEnv *env, jobject obj1, jobject obj2);+ jobject (JNICALL *NewLocalRef)+ (JNIEnv *env, jobject ref);+ jint (JNICALL *EnsureLocalCapacity)+ (JNIEnv *env, jint capacity);++ jobject (JNICALL *AllocObject)+ (JNIEnv *env, jclass clazz);+ jobject (JNICALL *NewObject)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jobject (JNICALL *NewObjectV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jobject (JNICALL *NewObjectA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jclass (JNICALL *GetObjectClass)+ (JNIEnv *env, jobject obj);+ jboolean (JNICALL *IsInstanceOf)+ (JNIEnv *env, jobject obj, jclass clazz);++ jmethodID (JNICALL *GetMethodID)+ (JNIEnv *env, jclass clazz, const char *name, const char *sig);++ jobject (JNICALL *CallObjectMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jobject (JNICALL *CallObjectMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jobject (JNICALL *CallObjectMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue * args);++ jboolean (JNICALL *CallBooleanMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jboolean (JNICALL *CallBooleanMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jboolean (JNICALL *CallBooleanMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue * args);++ jbyte (JNICALL *CallByteMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jbyte (JNICALL *CallByteMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jbyte (JNICALL *CallByteMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jchar (JNICALL *CallCharMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jchar (JNICALL *CallCharMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jchar (JNICALL *CallCharMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jshort (JNICALL *CallShortMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jshort (JNICALL *CallShortMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jshort (JNICALL *CallShortMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jint (JNICALL *CallIntMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jint (JNICALL *CallIntMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jint (JNICALL *CallIntMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jlong (JNICALL *CallLongMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jlong (JNICALL *CallLongMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jlong (JNICALL *CallLongMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jfloat (JNICALL *CallFloatMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jfloat (JNICALL *CallFloatMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jfloat (JNICALL *CallFloatMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ jdouble (JNICALL *CallDoubleMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ jdouble (JNICALL *CallDoubleMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ jdouble (JNICALL *CallDoubleMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue *args);++ void (JNICALL *CallVoidMethod)+ (JNIEnv *env, jobject obj, jmethodID methodID, ...);+ void (JNICALL *CallVoidMethodV)+ (JNIEnv *env, jobject obj, jmethodID methodID, va_list args);+ void (JNICALL *CallVoidMethodA)+ (JNIEnv *env, jobject obj, jmethodID methodID, const jvalue * args);++ jobject (JNICALL *CallNonvirtualObjectMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jobject (JNICALL *CallNonvirtualObjectMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jobject (JNICALL *CallNonvirtualObjectMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue * args);++ jboolean (JNICALL *CallNonvirtualBooleanMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jboolean (JNICALL *CallNonvirtualBooleanMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jboolean (JNICALL *CallNonvirtualBooleanMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue * args);++ jbyte (JNICALL *CallNonvirtualByteMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jbyte (JNICALL *CallNonvirtualByteMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jbyte (JNICALL *CallNonvirtualByteMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jchar (JNICALL *CallNonvirtualCharMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jchar (JNICALL *CallNonvirtualCharMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jchar (JNICALL *CallNonvirtualCharMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jshort (JNICALL *CallNonvirtualShortMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jshort (JNICALL *CallNonvirtualShortMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jshort (JNICALL *CallNonvirtualShortMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jint (JNICALL *CallNonvirtualIntMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jint (JNICALL *CallNonvirtualIntMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jint (JNICALL *CallNonvirtualIntMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jlong (JNICALL *CallNonvirtualLongMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jlong (JNICALL *CallNonvirtualLongMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jlong (JNICALL *CallNonvirtualLongMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jfloat (JNICALL *CallNonvirtualFloatMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jfloat (JNICALL *CallNonvirtualFloatMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jfloat (JNICALL *CallNonvirtualFloatMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ jdouble (JNICALL *CallNonvirtualDoubleMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ jdouble (JNICALL *CallNonvirtualDoubleMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ jdouble (JNICALL *CallNonvirtualDoubleMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue *args);++ void (JNICALL *CallNonvirtualVoidMethod)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID, ...);+ void (JNICALL *CallNonvirtualVoidMethodV)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ va_list args);+ void (JNICALL *CallNonvirtualVoidMethodA)+ (JNIEnv *env, jobject obj, jclass clazz, jmethodID methodID,+ const jvalue * args);++ jfieldID (JNICALL *GetFieldID)+ (JNIEnv *env, jclass clazz, const char *name, const char *sig);++ jobject (JNICALL *GetObjectField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jboolean (JNICALL *GetBooleanField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jbyte (JNICALL *GetByteField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jchar (JNICALL *GetCharField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jshort (JNICALL *GetShortField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jint (JNICALL *GetIntField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jlong (JNICALL *GetLongField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jfloat (JNICALL *GetFloatField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);+ jdouble (JNICALL *GetDoubleField)+ (JNIEnv *env, jobject obj, jfieldID fieldID);++ void (JNICALL *SetObjectField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jobject val);+ void (JNICALL *SetBooleanField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jboolean val);+ void (JNICALL *SetByteField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jbyte val);+ void (JNICALL *SetCharField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jchar val);+ void (JNICALL *SetShortField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jshort val);+ void (JNICALL *SetIntField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jint val);+ void (JNICALL *SetLongField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jlong val);+ void (JNICALL *SetFloatField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jfloat val);+ void (JNICALL *SetDoubleField)+ (JNIEnv *env, jobject obj, jfieldID fieldID, jdouble val);++ jmethodID (JNICALL *GetStaticMethodID)+ (JNIEnv *env, jclass clazz, const char *name, const char *sig);++ jobject (JNICALL *CallStaticObjectMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jobject (JNICALL *CallStaticObjectMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jobject (JNICALL *CallStaticObjectMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jboolean (JNICALL *CallStaticBooleanMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jboolean (JNICALL *CallStaticBooleanMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jboolean (JNICALL *CallStaticBooleanMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jbyte (JNICALL *CallStaticByteMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jbyte (JNICALL *CallStaticByteMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jbyte (JNICALL *CallStaticByteMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jchar (JNICALL *CallStaticCharMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jchar (JNICALL *CallStaticCharMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jchar (JNICALL *CallStaticCharMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jshort (JNICALL *CallStaticShortMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jshort (JNICALL *CallStaticShortMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jshort (JNICALL *CallStaticShortMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jint (JNICALL *CallStaticIntMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jint (JNICALL *CallStaticIntMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jint (JNICALL *CallStaticIntMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jlong (JNICALL *CallStaticLongMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jlong (JNICALL *CallStaticLongMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jlong (JNICALL *CallStaticLongMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jfloat (JNICALL *CallStaticFloatMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jfloat (JNICALL *CallStaticFloatMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jfloat (JNICALL *CallStaticFloatMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ jdouble (JNICALL *CallStaticDoubleMethod)+ (JNIEnv *env, jclass clazz, jmethodID methodID, ...);+ jdouble (JNICALL *CallStaticDoubleMethodV)+ (JNIEnv *env, jclass clazz, jmethodID methodID, va_list args);+ jdouble (JNICALL *CallStaticDoubleMethodA)+ (JNIEnv *env, jclass clazz, jmethodID methodID, const jvalue *args);++ void (JNICALL *CallStaticVoidMethod)+ (JNIEnv *env, jclass cls, jmethodID methodID, ...);+ void (JNICALL *CallStaticVoidMethodV)+ (JNIEnv *env, jclass cls, jmethodID methodID, va_list args);+ void (JNICALL *CallStaticVoidMethodA)+ (JNIEnv *env, jclass cls, jmethodID methodID, const jvalue * args);++ jfieldID (JNICALL *GetStaticFieldID)+ (JNIEnv *env, jclass clazz, const char *name, const char *sig);+ jobject (JNICALL *GetStaticObjectField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jboolean (JNICALL *GetStaticBooleanField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jbyte (JNICALL *GetStaticByteField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jchar (JNICALL *GetStaticCharField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jshort (JNICALL *GetStaticShortField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jint (JNICALL *GetStaticIntField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jlong (JNICALL *GetStaticLongField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jfloat (JNICALL *GetStaticFloatField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);+ jdouble (JNICALL *GetStaticDoubleField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID);++ void (JNICALL *SetStaticObjectField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jobject value);+ void (JNICALL *SetStaticBooleanField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jboolean value);+ void (JNICALL *SetStaticByteField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jbyte value);+ void (JNICALL *SetStaticCharField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jchar value);+ void (JNICALL *SetStaticShortField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jshort value);+ void (JNICALL *SetStaticIntField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jint value);+ void (JNICALL *SetStaticLongField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jlong value);+ void (JNICALL *SetStaticFloatField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jfloat value);+ void (JNICALL *SetStaticDoubleField)+ (JNIEnv *env, jclass clazz, jfieldID fieldID, jdouble value);++ jstring (JNICALL *NewString)+ (JNIEnv *env, const jchar *unicode, jsize len);+ jsize (JNICALL *GetStringLength)+ (JNIEnv *env, jstring str);+ const jchar *(JNICALL *GetStringChars)+ (JNIEnv *env, jstring str, jboolean *isCopy);+ void (JNICALL *ReleaseStringChars)+ (JNIEnv *env, jstring str, const jchar *chars);++ jstring (JNICALL *NewStringUTF)+ (JNIEnv *env, const char *utf);+ jsize (JNICALL *GetStringUTFLength)+ (JNIEnv *env, jstring str);+ const char* (JNICALL *GetStringUTFChars)+ (JNIEnv *env, jstring str, jboolean *isCopy);+ void (JNICALL *ReleaseStringUTFChars)+ (JNIEnv *env, jstring str, const char* chars);+++ jsize (JNICALL *GetArrayLength)+ (JNIEnv *env, jarray array);++ jobjectArray (JNICALL *NewObjectArray)+ (JNIEnv *env, jsize len, jclass clazz, jobject init);+ jobject (JNICALL *GetObjectArrayElement)+ (JNIEnv *env, jobjectArray array, jsize index);+ void (JNICALL *SetObjectArrayElement)+ (JNIEnv *env, jobjectArray array, jsize index, jobject val);++ jbooleanArray (JNICALL *NewBooleanArray)+ (JNIEnv *env, jsize len);+ jbyteArray (JNICALL *NewByteArray)+ (JNIEnv *env, jsize len);+ jcharArray (JNICALL *NewCharArray)+ (JNIEnv *env, jsize len);+ jshortArray (JNICALL *NewShortArray)+ (JNIEnv *env, jsize len);+ jintArray (JNICALL *NewIntArray)+ (JNIEnv *env, jsize len);+ jlongArray (JNICALL *NewLongArray)+ (JNIEnv *env, jsize len);+ jfloatArray (JNICALL *NewFloatArray)+ (JNIEnv *env, jsize len);+ jdoubleArray (JNICALL *NewDoubleArray)+ (JNIEnv *env, jsize len);++ jboolean * (JNICALL *GetBooleanArrayElements)+ (JNIEnv *env, jbooleanArray array, jboolean *isCopy);+ jbyte * (JNICALL *GetByteArrayElements)+ (JNIEnv *env, jbyteArray array, jboolean *isCopy);+ jchar * (JNICALL *GetCharArrayElements)+ (JNIEnv *env, jcharArray array, jboolean *isCopy);+ jshort * (JNICALL *GetShortArrayElements)+ (JNIEnv *env, jshortArray array, jboolean *isCopy);+ jint * (JNICALL *GetIntArrayElements)+ (JNIEnv *env, jintArray array, jboolean *isCopy);+ jlong * (JNICALL *GetLongArrayElements)+ (JNIEnv *env, jlongArray array, jboolean *isCopy);+ jfloat * (JNICALL *GetFloatArrayElements)+ (JNIEnv *env, jfloatArray array, jboolean *isCopy);+ jdouble * (JNICALL *GetDoubleArrayElements)+ (JNIEnv *env, jdoubleArray array, jboolean *isCopy);++ void (JNICALL *ReleaseBooleanArrayElements)+ (JNIEnv *env, jbooleanArray array, jboolean *elems, jint mode);+ void (JNICALL *ReleaseByteArrayElements)+ (JNIEnv *env, jbyteArray array, jbyte *elems, jint mode);+ void (JNICALL *ReleaseCharArrayElements)+ (JNIEnv *env, jcharArray array, jchar *elems, jint mode);+ void (JNICALL *ReleaseShortArrayElements)+ (JNIEnv *env, jshortArray array, jshort *elems, jint mode);+ void (JNICALL *ReleaseIntArrayElements)+ (JNIEnv *env, jintArray array, jint *elems, jint mode);+ void (JNICALL *ReleaseLongArrayElements)+ (JNIEnv *env, jlongArray array, jlong *elems, jint mode);+ void (JNICALL *ReleaseFloatArrayElements)+ (JNIEnv *env, jfloatArray array, jfloat *elems, jint mode);+ void (JNICALL *ReleaseDoubleArrayElements)+ (JNIEnv *env, jdoubleArray array, jdouble *elems, jint mode);++ void (JNICALL *GetBooleanArrayRegion)+ (JNIEnv *env, jbooleanArray array, jsize start, jsize l, jboolean *buf);+ void (JNICALL *GetByteArrayRegion)+ (JNIEnv *env, jbyteArray array, jsize start, jsize len, jbyte *buf);+ void (JNICALL *GetCharArrayRegion)+ (JNIEnv *env, jcharArray array, jsize start, jsize len, jchar *buf);+ void (JNICALL *GetShortArrayRegion)+ (JNIEnv *env, jshortArray array, jsize start, jsize len, jshort *buf);+ void (JNICALL *GetIntArrayRegion)+ (JNIEnv *env, jintArray array, jsize start, jsize len, jint *buf);+ void (JNICALL *GetLongArrayRegion)+ (JNIEnv *env, jlongArray array, jsize start, jsize len, jlong *buf);+ void (JNICALL *GetFloatArrayRegion)+ (JNIEnv *env, jfloatArray array, jsize start, jsize len, jfloat *buf);+ void (JNICALL *GetDoubleArrayRegion)+ (JNIEnv *env, jdoubleArray array, jsize start, jsize len, jdouble *buf);++ void (JNICALL *SetBooleanArrayRegion)+ (JNIEnv *env, jbooleanArray array, jsize start, jsize l, const jboolean *buf);+ void (JNICALL *SetByteArrayRegion)+ (JNIEnv *env, jbyteArray array, jsize start, jsize len, const jbyte *buf);+ void (JNICALL *SetCharArrayRegion)+ (JNIEnv *env, jcharArray array, jsize start, jsize len, const jchar *buf);+ void (JNICALL *SetShortArrayRegion)+ (JNIEnv *env, jshortArray array, jsize start, jsize len, const jshort *buf);+ void (JNICALL *SetIntArrayRegion)+ (JNIEnv *env, jintArray array, jsize start, jsize len, const jint *buf);+ void (JNICALL *SetLongArrayRegion)+ (JNIEnv *env, jlongArray array, jsize start, jsize len, const jlong *buf);+ void (JNICALL *SetFloatArrayRegion)+ (JNIEnv *env, jfloatArray array, jsize start, jsize len, const jfloat *buf);+ void (JNICALL *SetDoubleArrayRegion)+ (JNIEnv *env, jdoubleArray array, jsize start, jsize len, const jdouble *buf);++ jint (JNICALL *RegisterNatives)+ (JNIEnv *env, jclass clazz, const JNINativeMethod *methods,+ jint nMethods);+ jint (JNICALL *UnregisterNatives)+ (JNIEnv *env, jclass clazz);++ jint (JNICALL *MonitorEnter)+ (JNIEnv *env, jobject obj);+ jint (JNICALL *MonitorExit)+ (JNIEnv *env, jobject obj);++ jint (JNICALL *GetJavaVM)+ (JNIEnv *env, JavaVM **vm);++ void (JNICALL *GetStringRegion)+ (JNIEnv *env, jstring str, jsize start, jsize len, jchar *buf);+ void (JNICALL *GetStringUTFRegion)+ (JNIEnv *env, jstring str, jsize start, jsize len, char *buf);++ void * (JNICALL *GetPrimitiveArrayCritical)+ (JNIEnv *env, jarray array, jboolean *isCopy);+ void (JNICALL *ReleasePrimitiveArrayCritical)+ (JNIEnv *env, jarray array, void *carray, jint mode);++ const jchar * (JNICALL *GetStringCritical)+ (JNIEnv *env, jstring string, jboolean *isCopy);+ void (JNICALL *ReleaseStringCritical)+ (JNIEnv *env, jstring string, const jchar *cstring);++ jweak (JNICALL *NewWeakGlobalRef)+ (JNIEnv *env, jobject obj);+ void (JNICALL *DeleteWeakGlobalRef)+ (JNIEnv *env, jweak ref);++ jboolean (JNICALL *ExceptionCheck)+ (JNIEnv *env);++ jobject (JNICALL *NewDirectByteBuffer)+ (JNIEnv* env, void* address, jlong capacity);+ void* (JNICALL *GetDirectBufferAddress)+ (JNIEnv* env, jobject buf);+ jlong (JNICALL *GetDirectBufferCapacity)+ (JNIEnv* env, jobject buf);++ jobjectRefType (JNICALL *GetObjectRefType)+ (JNIEnv* env, jobject obj);+};+++struct JNIEnv_ {+ const struct JNINativeInterface_ *functions;+};+++typedef struct JavaVMOption {+ char *optionString;+ void *extraInfo;+} JavaVMOption;++typedef struct JavaVMInitArgs {+ jint version;++ jint nOptions;+ JavaVMOption *options;+ jboolean ignoreUnrecognized;+} JavaVMInitArgs;++typedef struct JavaVMAttachArgs {+ jint version;++ char *name;+ jobject group;+} JavaVMAttachArgs;+++struct JNIInvokeInterface_ {+ void *reserved0;+ void *reserved1;+ void *reserved2;++ jint (JNICALL *DestroyJavaVM)(JavaVM *vm);++ jint (JNICALL *AttachCurrentThread)(JavaVM *vm, void **penv, void *args);++ jint (JNICALL *DetachCurrentThread)(JavaVM *vm);++ jint (JNICALL *GetEnv)(JavaVM *vm, void **penv, jint version);++ jint (JNICALL *AttachCurrentThreadAsDaemon)(JavaVM *vm, void **penv, void *args);+};++struct JavaVM_ {+ const struct JNIInvokeInterface_ *functions;+};++#endif /*_JNI_H_*/++
+ java-bridge.cabal view
@@ -0,0 +1,196 @@+name: java-bridge+version: 0.9++license: MIT+license-file: LICENSE++author: Julian Fleischer <julian.fleischer@fu-berlin.de>+maintainer: Julian Fleischer <julian.fleischer@fu-berlin.de>++stability: experimental+category: Foreign, Java, JVM, FFI Tools++cabal-version: >= 1.8++synopsis: Bindings to the JNI and a high level interface generator.+description: This package offers bindings to the+ /Java Native Interface/ and a high level interface+ generator.+ .+ [@low level bindings to the JNI@]+ The low level bindings are located in+ "Foreign.Java.JNI.Safe" and "Foreign.Java.JNI.Unsafe".+ When using these bindings you will have to deal with+ pointers and manage global references manually.+ .+ [@medium level interface@]+ The medium level interface is located in+ "Foreign.Java". It offers an abstraction over the JNI,+ i.e. you will not have to deal with pointers+ explicitly nor do you need to manually do conversions+ between native types and Haskell types.+ Also references will automatically be released by+ the Haskell runtime when no longer needed. You will+ still need to manually lookup classes and methods in+ order to use them.+ .+ .+ >>> INSTALLATION / USAGE+ .+ It should suffice to do @cabal install@ (or+ @cabal install java-bridge@ when installing from+ hackageDB). /You need to have a JDK installed prior to+ installing this library/.+ .+ Setup will try to find the location of your java+ installation automatically. This is needed in order to+ load @libjvm@. Note that this library is loaded+ dynamically, which means that linking errors might not+ show up during installation.+ .+ You can specify the location of @libjvm@ manually using+ the environment variable @FFIJNI_LIBJVM@. This+ environment variable is consulted by @Setup.hs@ as well+ as by the library each time @libjvm@ is loaded - which+ means that you can override the path to @libjvm@ at any+ time. The function @getCompiledLibjvmPath@ in+ "Foreign.Java.JNI.Safe" will tell you what path to+ @libjvm@ has been set during compilation of the library.+ .+ .+ >>> FUN WITH (cabal-) FLAGS+ .+ The following cabal flags are available to you for+ configuring your installation:+ .+ [@ONLY_CORE@]+ Build only the Core Modules which offer a+ direct binding to the Java Native Interface.+ The core modules are "Foreign.Java.JNI",+ "Foreign.Java.JNI.Safe",+ and "Foreign.Java.JNI.Unsafe".+ This implies @NO_TOOLS@.+ Defaults to @False@.+ .+ [@DEBUG@]+ Enable a debug build. Defaults to @False@.+ .+ [@OSX_GUI@]+ Build the library with special support for+ Cocoa on Mac OS X (you will not be able to+ use AWT or Swing without). Defaults to @True@+ on Darwin (OS X).+ .+ [@OSX_FRAMEWORK@]+ Use the JavaVM framework on MacOS X instead+ of loading the dynamic library. Defaults to+ @False@. Enable this flag if building on your+ OS X machine fails. Defaults to @False@.+ .+ Use for example+ @cabal install -f OSX_FRAMEWORK -f EXAMPLES@+ or @cabal configure -f DEBUG@.+ +build-type: Custom++extra-source-files: include/jni.h,+ src/Foreign/Java/JNI/core.hs,+ src/ffijni.h,+ src/hfunction.h,+ GetProperty.java,+ HFunction.java,+ ReadClass.java,+ HACKING.txt,+ ISSUES.txt,+ README.md++flag ONLY_CORE+ Description: Build only the Core Modules which offer a+ direct binding to the Java Native Interface.+ Default: False++flag DEBUG+ Description: Enable a debug build.+ Default: False++flag OSX_GUI+ Description: Build the library with special support for+ Cocoa on Mac OS X.+ Default: True++flag OSX_FRAMEWORK+ Description: Use the JavaVM framework on MacOS X instead+ of loading the dynamic library.+ Default: False+++Library+ cc-options: -DFFIJNI_BRIDGE_VERSION="1.0"+ cpp-options: -DFFIJNI_BRIDGE_VERSION="1.0"++ build-depends: base >= 4.5 && < 5+ , directory >= 1.1.0.2+ , filepath >= 1.3++ hs-source-dirs: src++ exposed-modules: Foreign.Java.JNI,+ Foreign.Java.JNI.Safe,+ Foreign.Java.JNI.Unsafe++ other-modules: Foreign.Java.JNI.Types++ if flag(ONLY_CORE)+ cc-options: -DFFIJNI_ONLY_CORE+ cpp-options: -DFFIJNI_ONLY_CORE++ else+ exposed-modules: Foreign.Java+ , Foreign.Java.Bindings+ , Foreign.Java.Utils+ , Foreign.Java.Value++ build-depends: cpphs >= 1.16+ , strings >= 1.1+ , mtl >= 2.1.1+ , transformers >= 0.3++ other-modules: Foreign.Java.Types+ , Foreign.Java.JavaMonad+ , Foreign.Java.Util++ if flag(DEBUG)+ cc-options: -DFFIJNI_DEBUG+ cpp-options: -DFFIJNI_DEBUG++ c-sources: src/ffijni.c+ includes: src/ffijni.h+ cc-options: -Wall --std=c99++ if os(darwin)+ buildable: True+ cc-options: -Wno-deprecated-declarations -DFFIJNI_MACOSX+ cpp-options: -DFFIJNI_MACOSX+ build-depends: unix+ if flag(OSX_GUI)+ cc-options: -DFFIJNI_OSX_GUI+ cpp-options: -DFFIJNI_OSX_GUI+ frameworks: Cocoa+ if flag(OSX_FRAMEWORK)+ cc-options: -DFFIJNI_OSX_FRAMEWORK+ cpp-options: -DFFIJNI_OSX_FRAMEWORK+ frameworks: JavaVM+ else+ if os(linux)+ buildable: True+ cc-options: -DFFIJNI_LINUX+ cpp-options: -DFFIJNI_LINUX+ build-depends: unix+ else+ if os(windows)+ buildable: True+ cc-options: -DFFIJNI_WINDOWS+ cpp-options: -DFFIJNI_WINDOWS+ else+ buildable: False+
+ src/Foreign/Java.cpphs view
@@ -0,0 +1,1206 @@+{-# 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`)++#define JAVA_ARRAY(TYPE, RESULT, GETTER, SETTER, ARG, GET, SET) \+ instance JavaArray TYPE RESULT where {\+ at = _get GETTER GET (\s v -> s { GET = v }) ARG ;\+ write = _set SETTER SET (\s v -> s { SET = v }) ARG }\+ ;\+ instance JavaObject (JArray TYPE) where {\+ toString arr = toList arr >>= return . show ;\+ asObject (JArray _ ptr) = return (JObject ptr) }++JAVA_ARRAY(Z, Bool, "getBoolean", "setBoolean", boolean, jvmGetZ, jvmSetZ)+JAVA_ARRAY(C, Word16, "getChar", "setChar", char, jvmGetC, jvmSetC)+JAVA_ARRAY(B, Int8, "getByte", "setByte", byte, jvmGetB, jvmSetB)+JAVA_ARRAY(S, Int16, "getShort", "setShort", short, jvmGetS, jvmSetS)+JAVA_ARRAY(I, Int32, "getInt", "setInt", int, jvmGetI, jvmSetI)+JAVA_ARRAY(J, Int64, "getLong", "setLong", long, jvmGetJ, jvmSetJ)+JAVA_ARRAY(D, Double, "getDouble", "setDouble", double, jvmGetD, jvmSetD)+JAVA_ARRAY(F, Float, "getFloat", "setFloat", float, jvmGetF, jvmSetF)++instance JavaArray L (Maybe JObject) where+ at = _get "get" jvmGetL (\s v -> s { jvmGetL = v }) (object "java.lang.Object")+ write = _set "set" jvmSetL (\s v -> s { jvmSetL = v }) (object "java.lang.Object")++instance JavaArray (A e) (Maybe (JArray e)) where+ at arr ix = do+ let get = _get "get" jvmGetL (\s v -> s { jvmGetL = v }) (object "java.lang.Object")+ result <- get arr ix+ case result of+ (Just (JObject ptr)) -> do+ vm <- getVM+ safe <- getSafe++ length <- io $ withForeignPtr ptr $ \ptr ->+ (if safe then JNI.getArrayLength+ else Unsafe.getArrayLength) vm ptr++ return $ Just $ JArray length ptr+ Nothing -> return Nothing+ + write arr ix arg = do+ let set = _set "set" jvmSetL (\s v -> s { jvmSetL = v }) (object "java.lang.Object")+ case arg of+ Nothing -> set arr ix Nothing+ (Just (JArray _ ptr)) -> set arr ix (Just (JObject ptr))+++_get getter get set result (JArray size arr) ix+ | ix < 0 || ix >= size = fail $ "Index out of bounds (read): " ++ show ix+ | otherwise = do+ state <- State.get+ -- get the getter function cached in the monad+ -- or if there is none look it up in the VM.+ method <- case get state of+ Nothing -> do+ (Just arrayClass) <- getClass "java.lang.reflect.Array"+ m <- arrayClass `bindStaticMethod` getter+ ::= object "java.lang.Object" --> int --> result+ State.put $ set state $ Just $ m+ return m+ Just m -> return m+ method (Just $ JObject arr) ix++_set setter get set arg (JArray size arr) ix value+ | ix < 0 || ix >= size = fail $ "Index out of bounds (write): " ++ show ix+ | otherwise = do+ state <- State.get+ -- get the setter function cached in the monad+ -- of if there is none look it up in the VM.+ method <- case get state of+ Nothing -> do+ (Just arrayClass) <- getClass "java.lang.reflect.Array"+ m <- arrayClass `bindStaticMethod` setter+ ::= object "java.lang.Object" --> int --> arg --> void+ State.put $ set state $ Just $ m+ return m+ Just m -> return m+ method (Just $ JObject arr) ix value+++newObject, newObjectX :: JClass+ -> Java (Maybe JObject)+newObject clazz = newObjectE clazz+ >>= either (\exc -> toString exc >>= fail) return++newObjectE :: JClass+ -> Java (Either JThrowable (Maybe JObject))+newObjectE clazz = newObjectX clazz >>= check++newObjectX clazz = do+ vm <- getVM+ safe <- getSafe++ ptr <- io $ do+ csig <- newCString "()V"+ cptr <- withForeignPtr (jclassPtr clazz) $ \p ->+ (if safe then JNI.getConstructorID+ else Unsafe.getConstructorID) vm p csig+ free csig+ return cptr+ + if ptr == nullPtr+ then return $ fail "no default constructor"+ else do+ obj <- io $ withForeignPtr (jclassPtr clazz) $ \p ->+ (if safe then JNI.newObject+ else Unsafe.newObject) vm p ptr nullPtr+ if obj == nullPtr+ then return (fail "could not create object")+ else io (newForeignPtr (if safe then JNI.release+ else Unsafe.release) obj)+ >>= return . return . JObject+++-- getConstructor++data JConstructor a = JConstructor (ForeignPtr Core.JClassRef)+ (Ptr Core.JConstructorID) a+ deriving Show++infixl 7 `getConstructor`++getConstructor clazz p = do+ vm <- getVM+ safe <- getSafe++ ptr <- io $ do+ csig <- newCString $ constructorSignature p++ cID <- withForeignPtr (jclassPtr clazz) $ \p -> do+ (if safe then JNI.getConstructorID+ else Unsafe.getConstructorID) vm p csig+ free csig+ return cID++ return $ if ptr == nullPtr+ then fail "No such constructor"+ else return $ JConstructor (jclassPtr clazz) ptr p+++-- createObject++newObjectFrom :: (NewObject p b) => JConstructor p -> b+newObjectFrom (JConstructor clazz ptr t) =+ _newObject (ConstructorH clazz ptr) [] t++newObjectFromE :: (NewObjectE p b) => JConstructor p -> b+newObjectFromE (JConstructor clazz ptr t) =+ _newObjectE (ConstructorH clazz ptr) [] t++newObjectFromX :: (NewObjectX p b) => JConstructor p -> b+newObjectFromX (JConstructor clazz ptr t) =+ _newObjectX (ConstructorH clazz ptr) [] t+++data ConstructorH = ConstructorH (ForeignPtr Core.JClassRef)+ (Ptr Core.JConstructorID) deriving Show++class NewObject a b | a -> b+ where _newObject :: ConstructorH -> [Core.JArg] -> a -> b+class NewObjectE a b | a -> b+ where _newObjectE :: ConstructorH -> [Core.JArg] -> a -> b+class NewObjectX a b | a -> b+ where _newObjectX :: ConstructorH -> [Core.JArg] -> a -> b++instance (JArg t v, NewObject x b) => NewObject (P t x) (v -> b) where+ _newObject m args (P t x) val = _newObject m (jarg t val : args) x+instance (JArg t v, NewObjectE x b) => NewObjectE (P t x) (v -> b) where+ _newObjectE m args (P t x) val = _newObjectE m (jarg t val : args) x+instance (JArg t v, NewObjectX x b) => NewObjectX (P t x) (v -> b) where+ _newObjectX m args (P t x) val = _newObjectX m (jarg t val : args) x++#define NEW_OBJECT(TYPE, RESULT) \+ instance NewObject TYPE (RESULT -> Java (Maybe JObject)) \+ where { _newObject = nuObject }\+ ;\+ instance NewObjectX TYPE (RESULT -> Java (Maybe JObject)) \+ where { _newObjectX = nuObjectX }\+ ;\+ instance NewObjectE TYPE \+ (RESULT -> Java (Either JThrowable (Maybe JObject))) where \+ { _newObjectE = nuObjectE }++NEW_OBJECT(Z, Bool)+NEW_OBJECT(C, Word16)+NEW_OBJECT(B, Int8)+NEW_OBJECT(S, Int16)+NEW_OBJECT(I, Int32)+NEW_OBJECT(J, Int64)+NEW_OBJECT(F, Float)+NEW_OBJECT(D, Double)+NEW_OBJECT(L, Maybe JObject)+NEW_OBJECT(Q, Maybe JObject)+NEW_OBJECT(X, String)+NEW_OBJECT((A e), Maybe (JArray e))+++nuObject c args t val = nuObjectE c args t val+ >>= either (\exc -> toString exc >>= fail) return++nuObjectE c args t val = nuObjectX c args t val >>= check++nuObjectX (ConstructorH clazz cid) args t val = do+ vm <- getVM+ safe <- getSafe++ ptr <- liftIO $ do+ let mkValues = (if safe then JNI.mkJValues+ else Unsafe.mkJValues)+ jvalues <- mkValues vm $ reverse (jarg t val : args)+ jobject <- withForeignPtr clazz $ \p ->+ (if safe then JNI.newObject+ else Unsafe.newObject) vm p cid jvalues+ free jvalues+ return jobject++ if ptr == nullPtr+ then return (fail "Object could not be created")+ else io (newForeignPtr (if safe then JNI.release+ else Unsafe.release) ptr)+ >>= return . return . JObject+++-- getStaticMethod++data JStaticMethod a = JStaticMethod (ForeignPtr Core.JClassRef)+ (Ptr Core.JStaticMethodID) a+ deriving Show++infixl 7 `getStaticMethod`++getStaticMethod :: (Method (p -> String))+ => JClass+ -> MethodDescriptor p+ -> Java (Maybe (JStaticMethod p))+getStaticMethod clazz (name ::= p) = do+ vm <- getVM+ safe <- getSafe++ ptr <- liftIO $ do+ cname <- newCString name+ csig <- newCString $ methodSignature p++ let getStaticMethodID = if safe then JNI.getStaticMethodID+ else Unsafe.getStaticMethodID+ methodID <- withForeignPtr (jclassPtr clazz) $ \p -> do+ getStaticMethodID vm p cname csig+ free cname >> free csig+ return methodID++ return $ if ptr == nullPtr+ then fail "No such static method"+ else return $ JStaticMethod (jclassPtr clazz) ptr p+++-- bindStaticMethod++infixl 7 `bindStaticMethod`++bindStaticMethod :: (Method (p -> String), StaticCall p b)+ => JClass+ -> MethodDescriptor p+ -> Java b+bindStaticMethod c m =+ getStaticMethod c m $> fromJust $> callStaticMethod+++-- bindMethod++infixl 7 `bindMethod`++bindMethod :: (Method (p -> String), MethodCall p b)+ => JClass+ -> MethodDescriptor p+ -> Java (JObject -> b)+bindMethod c m = getMethod c m $> fromJust $> callMethod+++-- getMethod++data JMethod a = JMethod (ForeignPtr Core.JClassRef) (Ptr Core.JMethodID) a+ deriving Show++infixl 7 `getMethod`++getMethod :: (Method (p -> String))+ => JClass -> MethodDescriptor p -> Java (Maybe (JMethod p))+getMethod clazz (name ::= p) = do+ vm <- getVM+ safe <- getSafe++ ptr <- liftIO $ do+ cname <- newCString name+ csig <- newCString $ methodSignature p++ let getMethod = if safe then JNI.getMethodID+ else Unsafe.getMethodID+ methodID <- withForeignPtr (jclassPtr clazz) $+ \p -> getMethod vm p cname csig+ free cname >> free csig+ return methodID++ return $ if ptr == nullPtr+ then fail "No such method"+ else return $ JMethod (jclassPtr clazz) ptr p+++callStaticMethod :: (StaticCall p b) => JStaticMethod p -> b+callStaticMethod (JStaticMethod clazz ptr t) =+ _staticCall (StaticH clazz ptr) [] t++callStaticMethodE :: (StaticCallE p b) => JStaticMethod p -> b+callStaticMethodE (JStaticMethod clazz ptr t) =+ _staticCallE (StaticH clazz ptr) [] t++callStaticMethodX :: (StaticCallX p b) => JStaticMethod p -> b+callStaticMethodX (JStaticMethod clazz ptr t) =+ _staticCallX (StaticH clazz ptr) [] t+++data StaticH = StaticH (ForeignPtr Core.JClassRef)+ (Ptr Core.JStaticMethodID)+ deriving Show++class StaticCall a b | a -> b+ where _staticCall :: StaticH -> [Core.JArg] -> a -> b+class StaticCallE a b | a -> b+ where _staticCallE :: StaticH -> [Core.JArg] -> a -> b+class StaticCallX a b | a -> b+ where _staticCallX :: StaticH -> [Core.JArg] -> a -> b++instance (JArg t v, StaticCall x b) => StaticCall (P t x) (v -> b)+ where _staticCall m args (P t x) val =+ _staticCall m (jarg t val : args) x+instance (JArg t v, StaticCallE x b) => StaticCallE (P t x) (v -> b)+ where _staticCallE m args (P t x) val =+ _staticCallE m (jarg t val : args) x+instance (JArg t v, StaticCallX x b) => StaticCallX (P t x) (v -> b)+ where _staticCallX m args (P t x) val =+ _staticCallX m (jarg t val : args) x++#define STATIC_CALL(TYPE, RESULT, RETURN, SAFE, UNSAFE) \+ instance StaticCall TYPE (Java RESULT) where {\+ _staticCall m a t = do safe <- getSafe ;\+ staticCall (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t }\+ ;\+ instance StaticCallE TYPE (Java (Either JThrowable RESULT)) where {\+ _staticCallE m a t = do safe <- getSafe ;\+ staticCallE (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t }\+ ;\+ instance StaticCallX TYPE (Java RESULT) where {\+ _staticCallX m a t = do safe <- getSafe ;\+ staticCallX (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t }++STATIC_CALL(V, (), return, JNI.callStaticVoidMethod,+ Unsafe.callStaticVoidMethod)+STATIC_CALL(Z, Bool, return, JNI.callStaticBooleanMethod,+ Unsafe.callStaticBooleanMethod)+STATIC_CALL(C, Word16, return, JNI.callStaticCharMethod,+ Unsafe.callStaticCharMethod)+STATIC_CALL(B, Int8, return, JNI.callStaticByteMethod,+ Unsafe.callStaticByteMethod)+STATIC_CALL(S, Int16, return, JNI.callStaticShortMethod,+ Unsafe.callStaticShortMethod)+STATIC_CALL(I, Int32, return, JNI.callStaticIntMethod,+ Unsafe.callStaticIntMethod)+STATIC_CALL(J, Int64, return, JNI.callStaticLongMethod,+ Unsafe.callStaticLongMethod)++STATIC_CALL(F, Float, (return . realToFrac),+ JNI.callStaticFloatMethod, Unsafe.callStaticFloatMethod)+STATIC_CALL(D, Double, (return . realToFrac),+ JNI.callStaticDoubleMethod, Unsafe.callStaticDoubleMethod)++STATIC_CALL(X, (Maybe String), returnString,+ JNI.callStaticStringMethod,Unsafe.callStaticStringMethod)+STATIC_CALL(L, (Maybe JObject), returnObject,+ JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)+STATIC_CALL(Q, (Maybe JObject), returnObject,+ JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)+STATIC_CALL((A e), (Maybe (JArray e)), returnArray,+ JNI.callStaticObjectMethod, Unsafe.callStaticObjectMethod)++staticCall, staticCallX+ :: (Ptr Core.JVM -> Ptr Core.JClassRef -> Ptr Core.JStaticMethodID+ -> Ptr Core.JValues -> IO a)+ -> (a -> Java b)+ -> StaticH+ -> [Core.JArg]+ -> x+ -> Java b+staticCall callback convert m a t = staticCallE callback convert m a t+ >>= either throwJavaException return++staticCallE+ :: (Ptr Core.JVM -> Ptr Core.JClassRef -> Ptr Core.JStaticMethodID+ -> Ptr Core.JValues -> IO a)+ -> (a -> Java b)+ -> StaticH+ -> [Core.JArg]+ -> x+ -> Java (Either JThrowable b)+staticCallE callback convert m a t = staticCallX callback convert m a t+ >>= check++staticCallX callback convert (StaticH clazz method) args _ = do+ vm <- getVM+ safe <- getSafe++ result <- io $ do+ let mkValues = if safe then JNI.mkJValues else Unsafe.mkJValues+ jvalues <- mkValues vm $ reverse args+ jreturn <- withForeignPtr clazz $+ \c -> callback vm c method jvalues+ free jvalues+ return jreturn++ convert result+++callMethod :: (MethodCall p b)+ => JMethod p+ -> JObject+ -> b+callMethod (JMethod _ ptr t) object =+ _methodCall (MethodH (jobjectPtr object) ptr) [] t++callMethodE :: (MethodCallE p b)+ => JMethod p+ -> JObject+ -> b+callMethodE (JMethod _ ptr t) object =+ _methodCallE (MethodH (jobjectPtr object) ptr) [] t++callMethodX :: (MethodCallX p b) => JMethod p -> JObject -> b+callMethodX (JMethod _ ptr t) object =+ _methodCallX (MethodH (jobjectPtr object) ptr) [] t++data MethodH = MethodH (ForeignPtr Core.JObjectRef) (Ptr Core.JMethodID)+ deriving Show++class MethodCall a b | a -> b+ where _methodCall :: MethodH -> [Core.JArg] -> a -> b+class MethodCallE a b | a -> b+ where _methodCallE :: MethodH -> [Core.JArg] -> a -> b+class MethodCallX a b | a -> b+ where _methodCallX :: MethodH -> [Core.JArg] -> a -> b++instance (JArg t v, MethodCall x b) => MethodCall (P t x) (v -> b)+ where _methodCall m args (P t x) val =+ _methodCall m (jarg t val : args) x+instance (JArg t v, MethodCallE x b) => MethodCallE (P t x) (v -> b)+ where _methodCallE m args (P t x) val =+ _methodCallE m (jarg t val : args) x+instance (JArg t v, MethodCallX x b) => MethodCallX (P t x) (v -> b)+ where _methodCallX m args (P t x) val =+ _methodCallX m (jarg t val : args) x++#define METHOD_CALL(TYPE, RESULT, RETURN, SAFE, UNSAFE) \+ instance MethodCall TYPE (Java RESULT) where {\+ _methodCall m a t = do safe <- getSafe ;\+ methodCall (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t };\+ \+ instance MethodCallE TYPE (Java (Either JThrowable RESULT)) where {\+ _methodCallE m a t = do safe <- getSafe ;\+ methodCallE (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t };\+ \+ instance MethodCallX TYPE (Java RESULT) where {\+ _methodCallX m a t = do safe <- getSafe ;\+ methodCallX (if safe then SAFE \+ else UNSAFE) \+ RETURN m a t }++METHOD_CALL(V, (), return, JNI.callVoidMethod,+ Unsafe.callVoidMethod)+METHOD_CALL(Z, Bool, return, JNI.callBooleanMethod,+ Unsafe.callBooleanMethod)++METHOD_CALL(C, Word16, return, JNI.callCharMethod,+ Unsafe.callCharMethod)+METHOD_CALL(B, Int8, return, JNI.callByteMethod,+ Unsafe.callByteMethod)+METHOD_CALL(S, Int16, return, JNI.callShortMethod,+ Unsafe.callShortMethod)+METHOD_CALL(I, Int32, return, JNI.callIntMethod,+ Unsafe.callIntMethod)+METHOD_CALL(J, Int64, return, JNI.callLongMethod,+ Unsafe.callLongMethod)++METHOD_CALL(F, Float, (return . realToFrac),+ JNI.callFloatMethod, Unsafe.callFloatMethod)+METHOD_CALL(D, Double, (return . realToFrac),+ JNI.callDoubleMethod, Unsafe.callDoubleMethod)++METHOD_CALL(X, (Maybe String), returnString,+ JNI.callStringMethod, Unsafe.callStringMethod)+METHOD_CALL(L, (Maybe JObject), returnObject,+ JNI.callObjectMethod, Unsafe.callObjectMethod)+METHOD_CALL(Q, (Maybe JObject), returnObject,+ JNI.callObjectMethod, Unsafe.callObjectMethod)+METHOD_CALL((A e), (Maybe (JArray e)), returnArray,+ JNI.callObjectMethod, Unsafe.callObjectMethod)++methodCall, methodCallX+ :: (Ptr Core.JVM -> Ptr Core.JObjectRef -> Ptr Core.JMethodID+ -> Ptr Core.JValues -> IO a)+ -> (a -> Java b)+ -> MethodH+ -> [Core.JArg]+ -> x+ -> Java b+methodCall callback convert m a t = methodCallE callback convert m a t+ >>= either throwJavaException return++methodCallE+ :: (Ptr Core.JVM -> Ptr Core.JObjectRef -> Ptr Core.JMethodID+ -> Ptr Core.JValues -> IO a)+ -> (a -> Java b)+ -> MethodH+ -> [Core.JArg]+ -> x+ -> Java (Either JThrowable b)+methodCallE callback convert m a t =+ methodCallX callback convert m a t >>= check++methodCallX callback convert (MethodH object method) args _ = do+ vm <- getVM+ safe <- getSafe++ result <- io $ do+ let mkValues = if safe then JNI.mkJValues else Unsafe.mkJValues+ jvalues <- mkValues vm $ reverse args+ jreturn <- withForeignPtr object $+ \obj -> callback vm obj method jvalues+ free jvalues+ return jreturn++ convert result+++data JField a = JField (ForeignPtr Core.JClassRef) (Ptr Core.JFieldID)+ deriving Show+data JStaticField a = JStaticField (ForeignPtr Core.JClassRef)+ (Ptr Core.JStaticFieldID)+ deriving Show++_getField :: Param a => (ForeignPtr Core.JClassRef -> Ptr x -> c a)+ -> (Ptr Core.JVM -> Ptr Core.JClassRef -> CString -> CString+ -> IO (Ptr x))+ -> (Ptr Core.JVM -> Ptr Core.JClassRef -> CString -> CString+ -> IO (Ptr x))+ -> JClass+ -> String+ -> a+ -> Java (Maybe (c a))+_getField constructor safeGet unsafeGet (JClass clazz) name p = do+ safe <- getSafe+ vm <- getVM++ ptr <- io $ do+ cname <- newCString name+ csig <- newCString $ fieldSignature p++ let get = if safe then safeGet else unsafeGet+ fieldID <- withForeignPtr clazz $ \p -> get vm p cname csig++ free cname >> free csig+ return fieldID++ if ptr == nullPtr+ then return (fail "No such field.")+ else return $ return $ constructor clazz ptr++getField :: Param a => JClass -> String -> a -> Java (Maybe (JField a))+getField = _getField JField JNI.getFieldID Unsafe.getFieldID++getStaticField :: Param a+ => JClass+ -> String+ -> a+ -> Java (Maybe (JStaticField a))+getStaticField = _getField JStaticField JNI.getStaticFieldID+ Unsafe.getStaticFieldID++class Field a b | a -> b where+ readStaticField :: JStaticField a -> Java b+ writeStaticField :: JStaticField a -> b -> Java ()+ readField :: JField a -> JObject -> Java b+ writeField :: JField a -> JObject -> b -> Java ()++#define FIELD(TYPE, RESULT, GETSS, GETS, GETSU, GETU, \+ SETSS, SETS, SETSU, SETU, READ, WRITE) \+ instance Field TYPE RESULT where {\+ readStaticField (JStaticField c fieldID) = do {\+ vm <- getVM ; safe <- getSafe ;\+ io (withForeignPtr c $ \p -> ((if safe then GETSS \+ else GETSU) vm p fieldID)) \+ READ >>= return \+ } ;\+ writeStaticField (JStaticField c fieldID) v = do {\+ vm <- getVM ; safe <- getSafe ;\+ return v >>= WRITE \+ io . (\t -> withForeignPtr c (\ptr -> \+ (if safe then SETSS else SETSU) vm ptr fieldID t)) \+ } ;\+ readField (JField _ fieldID) (JObject o) = do {\+ vm <- getVM ; safe <- getSafe ;\+ io (withForeignPtr o $ \p -> (if safe then GETS \+ else GETU) vm p fieldID) \+ READ >>= return \+ } ;\+ writeField (JField _ fieldID) (JObject obj) v = do {\+ vm <- getVM ; safe <- getSafe ;\+ return v >>= WRITE \+ io . (\t -> withForeignPtr obj (\ptr -> \+ (if safe then SETS else SETU) vm ptr fieldID t)) \+ } \+ }++FIELD(Z, Bool, JNI.getStaticBooleanField, JNI.getBooleanField,+ Unsafe.getStaticBooleanField, Unsafe.getBooleanField,+ JNI.setStaticBooleanField, JNI.setBooleanField,+ Unsafe.setStaticBooleanField, Unsafe.setBooleanField,,)+FIELD(C, Word16, JNI.getStaticCharField, JNI.getCharField,+ Unsafe.getStaticCharField, Unsafe.getCharField,+ JNI.setStaticCharField, JNI.setCharField,+ Unsafe.setStaticCharField, Unsafe.setCharField,,)+FIELD(B, Int8, JNI.getStaticByteField, JNI.getByteField,+ Unsafe.getStaticByteField, Unsafe.getByteField,+ JNI.setStaticByteField, JNI.setByteField,+ Unsafe.setStaticByteField, Unsafe.setByteField,,)+FIELD(S, Int16, JNI.getStaticShortField, JNI.getShortField,+ Unsafe.getStaticShortField, Unsafe.getShortField,+ JNI.setStaticShortField, JNI.setShortField,+ Unsafe.setStaticShortField, Unsafe.setShortField,,)+FIELD(I, Int32, JNI.getStaticIntField, JNI.getIntField,+ Unsafe.getStaticIntField, Unsafe.getIntField,+ JNI.setStaticIntField, JNI.setIntField,+ Unsafe.setStaticIntField, Unsafe.setIntField,,)+FIELD(J, Int64, JNI.getStaticLongField, JNI.getLongField,+ Unsafe.getStaticLongField, Unsafe.getLongField,+ JNI.setStaticLongField, JNI.setLongField,+ Unsafe.setStaticLongField, Unsafe.setLongField,,)++FIELD(D, Double, JNI.getStaticDoubleField, JNI.getDoubleField,+ Unsafe.getStaticDoubleField, Unsafe.getDoubleField,+ JNI.setStaticDoubleField, JNI.setDoubleField,+ Unsafe.setStaticDoubleField, Unsafe.setDoubleField,+ $> realToFrac, return . realToFrac >>=)+FIELD(F, Float, JNI.getStaticFloatField, JNI.getFloatField,+ Unsafe.getStaticFloatField, Unsafe.getFloatField,+ JNI.setStaticFloatField, JNI.setFloatField,+ Unsafe.setStaticFloatField, Unsafe.setFloatField,+ $> realToFrac, return . realToFrac >>=)++instance Field L (Maybe JObject) where+ readStaticField (JStaticField c fieldID) = do+ vm <- getVM+ safe <- getSafe+ let readField = if safe then JNI.getStaticObjectField+ else Unsafe.getStaticObjectField+ result <- io $ withForeignPtr c+ $ \ptr -> readField vm ptr fieldID+ if result == nullPtr+ then return Nothing+ else do+ let release = if safe then JNI.release+ else Unsafe.release+ io (newForeignPtr release result)+ >>= return . Just . JObject++ writeStaticField (JStaticField c fieldID) Nothing = do+ vm <- getVM+ safe <- getSafe+ let writeField = if safe then JNI.setStaticObjectField+ else Unsafe.setStaticObjectField+ io $ withForeignPtr c+ $ \ptr -> writeField vm ptr fieldID nullPtr++ writeStaticField (JStaticField c fieldID) (Just (JObject obj)) = do+ vm <- getVM+ safe <- getSafe+ let writeField = if safe then JNI.setStaticObjectField+ else Unsafe.setStaticObjectField+ io $ withForeignPtr c+ $ \clazz -> withForeignPtr obj+ $ \value -> writeField vm clazz fieldID value++ readField (JField _ fieldID) (JObject obj) = do+ vm <- getVM+ safe <- getSafe+ let readField = if safe then JNI.getObjectField+ else Unsafe.getObjectField+ result <- io $ withForeignPtr obj+ $ \ptr -> readField vm ptr fieldID+ if result == nullPtr+ then return Nothing+ else do+ let release = if safe then JNI.release+ else Unsafe.release+ io (newForeignPtr release result)+ >>= return . Just . JObject++ writeField (JField _ fieldID) (JObject o) Nothing = do+ vm <- getVM+ safe <- getSafe+ let writeField = if safe then JNI.setObjectField+ else Unsafe.setObjectField+ io $ withForeignPtr o+ $ \this -> writeField vm this fieldID nullPtr++ writeField (JField _ fieldID) (JObject o) (Just (JObject obj)) = do+ vm <- getVM+ safe <- getSafe+ let writeField = if safe then JNI.setObjectField+ else Unsafe.setObjectField+ io $ withForeignPtr o+ $ \this -> withForeignPtr obj+ $ \value -> writeField vm this fieldID value+++returnObject ptr = do+ safe <- getSafe+ io $ if ptr == nullPtr+ then return $ fail "null returned"+ else newForeignPtr (if safe then JNI.release else Unsafe.release) ptr+ >>= return . return . JObject++returnString ptr = io $ if ptr == nullPtr+ then return $ fail "null returned instead of String object"+ else peekCString ptr >>= \string -> free ptr >> return (return string)++returnArray ptr = if ptr == nullPtr+ then return $ fail "null returned"+ else do+ vm <- getVM+ safe <- getSafe++ length <- io $ (if safe then JNI.getArrayLength+ else Unsafe.getArrayLength) vm ptr+ ptr' <- io $ newForeignPtr (if safe then JNI.release+ else Unsafe.release) ptr+ return $ return $ JArray length ptr'+++-- | Finds and loads a class.+--+-- Note that this function can indeed fail with an exception and+-- may execute code from the class to be loaded inside the virtual+-- machine.+--+-- This is due to the fact that @getClass@ is a translation of the+-- @findClass@ function in the JNI which loads *and* resolves the class.+-- If you want to get a class definition without resolving the class,+-- use the method @loadClass(String,boolean)@ on a @ClassLoader@.+--+-- Here is an example of how to do that:+--+-- > main' = runJava $ do+-- > (Just classLoader) <- getClass "java.lang.ClassLoader"+-- > getSystemClassLoader <- classLoader `bindStaticMethod` "getSystemClassLoader"+-- > ::= object "java.lang.ClassLoader"+-- > (Just systemClassLoader) <- getSystemClassLoader+-- > +-- > loadClass <- classLoader `bindMethod` "loadClass"+-- > ::= string --> boolean --> object "java.lang.Class"+-- > (Just clazz) <- loadClass systemClassLoader "java.awt.EventQueue" False+-- > io$ print clazz+getClass :: String+ -- ^ The name of the class. This should be a name+ -- as would be returned by the @getName()@ method+ -- of the class object, for example+ -- @java.lang.Thread$State@ or @java.util.Map@.+ -> Java (Maybe JClass)+ -- ^ Returns Just the JClass or Nothing, if+ -- the class does not exist.+getClass name = do+ vm <- getVM+ safe <- getSafe++ ptr <- io $ do+ cname <- newCString $ tr '.' '/' name+ let findClass = if safe then JNI.findClass+ else Unsafe.findClass+ ptr <- findClass vm cname+ free cname+ return ptr++ if ptr == nullPtr+ then return $ fail "class not found"+ else io (newForeignPtr (if safe then JNI.release+ else Unsafe.release) ptr)+ >>= return . return . JClass+++isInstanceOf :: JObject -> JClass -> Java Bool+-- ^ Check whether the given object is an instance of the+-- given class.+isInstanceOf (JObject objectPtr) (JClass classPtr) = do+ vm <- getVM+ safe <- getSafe+ + let isInstanceOf = if safe then JNI.isInstanceOf+ else JNI.isInstanceOf++ io $ withForeignPtr objectPtr+ $ \obj -> withForeignPtr classPtr+ $ \clazz -> isInstanceOf vm obj clazz++------------------------------------------------------------------------+-- More Documentation+------------------------------------------------------------------------++{- $medium_level_intro++ The medium level interface tries to take all the pain from the JNI.+ It automatically manages references (i.e. garbage collection) for+ you and makes sure that all operations take place in the presence of+ a virtual machine.++ This module contains the 'Java' monad which basically wraps the IO+ monad but allows for actions to be executed in a virtual machine.+ Such actions on the other hand can only be executed within the Java+ monad and not within the IO monad. See 'runJava', 'runJavaGUI', and+ 'initJava' for information on how to run a computation in the JVM.++ Using the medium level interface you will need to obtain references+ to classes and methods manually. You can avoid this by creating high+ level bindings (effectively some glue code) via+ "Foreign.Java.Bindings".+-}++{- $obtaining_references++ In order to invoke methods in the virtual machine you first need a+ reference of these methods. These can be retrieved via+ 'getMethod', 'getStaticMethod', 'bindMethod', and+ 'bindStaticMethod'. References to constructors can be obtained using+ 'getConstructor'. All of these functions require a class.+ 'getClass' will lookup and load Java classes.++ Here is an example for calling @Thread.currentThread().getName()@+ and printing the result.++> import Foreign.Java+>+> main = runJava $ do+> (Just threadClass) <- getClass "java.lang.Thread"+> currentThread <- threadClass `bindStaticMethod`+> "currentThread" ::= object "java.lang.Thread"+> getName <- threadClass `bindMethod` "getName" ::= string+>+> (Just thread) <- currentThread+> (Just name) <- getName thread+>+> io$ putStrLn name++ NOTE: The boilerplate of retrieving class and method references can+ be avoided by using the high level java bindings offered by+ "Foreign.Java.Bindings".+-}++{- $calling_methods++ All the functions that involve calling a method ('callMethod',+ 'callStaticMethod', and 'newObject') come in three versions: E, X,+ and with no suffix.++ The X functions will not check for exceptions. Use them if your+ absolutely sure that you are calling a total function.++ The E functions will check for exceptions and return a value of type+ @Either JThrowable a@. A Left value is returned iff an exception+ occured (carrying the exception thrown) whereas a Right value+ carries the result of the function. Note that such a correct result+ may be Nothing (which resembles the @null@ reference) or void+ (i.e. unit: @()@).++ The functions without any suffix will check for exceptions and throw+ a Haskell exception. Throwing that exception will cause the+ computation in the JVM to be cancelled. This means that it is not+ possible to catch the exception within the Java monad, as the+ computation will be cancelled already. You can however catch such+ exceptions in the IO monad.++ In general you should use E functions if a method throws any checked+ exceptions and a function without suffix if a method does not throw+ any checked exceptions. This way runtime exceptions will still be+ propagated. If you know by heart that a function can not throw any+ exceptions, neither checked nor unchecked exceptions, you can use+ an X method, which is faster as it does not check for exceptions at+ all. If however the method does throw an exception and you do not+ check it, you are entering a world of pain.+-}+
+ src/Foreign/Java/Bindings.cpphs view
@@ -0,0 +1,358 @@+{-# LANGUAGE Haskell2010+ , TypeFamilies+ , FlexibleContexts+ , FlexibleInstances+ , TypeSynonymInstances+ #-}+{-# OPTIONS+ -Wall+ #-}++-- |+-- Module : Foreign.Java.Bindings.Support+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : experimental+-- Portability : non-portable (TypeFamilies)+--+-- This module provides type classes and instances for+-- supporting the high level bindings. This module should+-- not be imported directly.+module Foreign.Java.Bindings where++import Control.Monad.State hiding (void)++import Data.Int+import Data.Word+import Data.Maybe++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.Types++import Foreign.Java+import Foreign.Java.JavaMonad+import Foreign.Java.Types as T+import qualified Foreign.Java.JNI.Safe as JNI+import qualified Foreign.Java.JNI.Types as Core+++---------------+-- Utilities --+---------------+++object' :: String -> Q+object' = T.object'+++------------------------------+-- Primitive argument types --+------------------------------++class JBoolean a where toBoolean :: a -> Java Bool+class JChar a where toChar :: a -> Java Word16+class JByte a where toByte :: a -> Java Int8+class JShort a where toShort :: a -> Java Int16+class JInt a where toInt :: a -> Java Int32+class JLong a where toLong :: a -> Java Int64+class JFloat a where toFloat :: a -> Java Float+class JDouble a where toDouble :: a -> Java Double+++instance JBoolean Bool where toBoolean = return++instance JChar Char where toChar = return . fromIntegral . fromEnum+instance JChar Int8 where toChar = return . fromIntegral+instance JChar Word16 where toChar = return++instance JByte Int8 where toByte = return++instance JShort Int8 where toShort = return . fromIntegral+instance JShort Word8 where toShort = return . fromIntegral+instance JShort Int16 where toShort = return++instance JInt Int where toInt = return . fromIntegral+instance JInt Int8 where toInt = return . fromIntegral+instance JInt Word8 where toInt = return . fromIntegral+instance JInt Int16 where toInt = return . fromIntegral+instance JInt Word16 where toInt = return . fromIntegral+instance JInt Int32 where toInt = return++instance JLong Int where toLong = return . fromIntegral+instance JLong Int8 where toLong = return . fromIntegral+instance JLong Word8 where toLong = return . fromIntegral+instance JLong Int16 where toLong = return . fromIntegral+instance JLong Word16 where toLong = return . fromIntegral+instance JLong Int32 where toLong = return . fromIntegral+instance JLong Word32 where toLong = return . fromIntegral+instance JLong Int64 where toLong = return++instance JFloat CFloat where toFloat = return . realToFrac+instance JFloat Float where toFloat = return++instance JDouble CDouble where toDouble = return . realToFrac+instance JDouble Double where toDouble = return+++--------------------------+-- Array argument types --+--------------------------++class Array a where+ asMaybeArrayObject :: a -> Java (Maybe JObject)+++----------------------------+-- Primitive result types --+----------------------------++#define PRIMITIVE_RESULT(NAME, TYPE) \+ class NAME ## Result m where {\+ to ## NAME ## Result :: Either JThrowable TYPE -> Java m }\+ ;\+ instance NAME ## Result TYPE where {\+ to ## NAME ## Result = either (\exc -> toString exc >>= fail) return }\+ ;\+ instance NAME ## Result (Either JThrowable TYPE) where {\+ to ## NAME ## Result = return }++-- | The result of a function call that is of type @boolean@.+PRIMITIVE_RESULT(Boolean, Bool)+-- | The result of a function call that is of type @char@.+PRIMITIVE_RESULT(Char, Word16)+-- | The result of a function call that is of type @byte@.+PRIMITIVE_RESULT(Byte, Int8)+-- | The result of a function call that is of type @short@.+PRIMITIVE_RESULT(Short, Int16)+-- | The result of a function call that is of type @int@.+PRIMITIVE_RESULT(Int, Int32)+-- | The result of a function call that is of type @long@.+PRIMITIVE_RESULT(Long, Int64)+-- | The result of a function call that is of type @float@.+PRIMITIVE_RESULT(Float, Float)+-- | The result of a function call that is of type @double@.+PRIMITIVE_RESULT(Double, Double)++-- | The result of a function call that is of type @void@.+class VoidResult m where+ toVoidResult :: Either JThrowable () -> Java m+ +instance VoidResult () where+ toVoidResult = either (\exc -> toString exc >>= fail) return++instance VoidResult (Either JThrowable ()) where+ toVoidResult = return+ +instance VoidResult (Maybe JThrowable) where+ toVoidResult = return . either Just (const Nothing)+++------------------------+-- Array result types --+------------------------++-- | An array result of a function call.+class JavaArray (ArrayResultType m) (ArrayResultComponent m) => ArrayResult m where+ -- | The JVM machine type of the components of the array.+ type ArrayResultType m++ -- | The type of the component of the array as returned by+ -- the low level JNI call.+ type ArrayResultComponent m++ -- | Convert the array to a sophisticated type.+ toArrayResult :: Either JThrowable (Maybe (JArray (ArrayResultType m))) -> Java m++instance ArrayResult a => ArrayResult (Either JThrowable a) where+ type ArrayResultType (Either JThrowable a) = ArrayResultType a+ type ArrayResultComponent (Either JThrowable a) = ArrayResultComponent a++ toArrayResult = either (return . Left) (toArrayResult . Right)++#define ARRAY_RESULT(TYPE, PRIM) \+ instance ArrayResult [TYPE] where {\+ type ArrayResultType [TYPE] = T.PRIM ;\+ type ArrayResultComponent [TYPE] = TYPE ;\+ \+ toArrayResult = either (\exc -> toString exc >>= fail) \+ (maybe (return []) toList) }++ARRAY_RESULT(Bool, Z)+ARRAY_RESULT(Word16, C)+ARRAY_RESULT(Int8, B)+ARRAY_RESULT(Int16, S)+ARRAY_RESULT(Int32, I)+ARRAY_RESULT(Int64, J)+ARRAY_RESULT(Float, F)+ARRAY_RESULT(Double, D)+++instance ArrayResult [Char] where+ type ArrayResultType [Char] = T.C+ type ArrayResultComponent [Char] = Word16++ toArrayResult = either (\exc -> toString exc >>= fail)+ (maybe (return [])+ (fmap (map (toEnum . fromIntegral)) . toList))++instance ArrayResult [String] where+ type ArrayResultType [String] = T.L+ type ArrayResultComponent [String] = Maybe JObject++ toArrayResult =+ either (\exc -> toString exc >>= fail)+ (maybe (return [])+ (\arr -> toList arr >>= mapM (maybe (return "") toString)))++++-----------------------+-- All other objects --+-----------------------+++-- | The result of a function call that is of type @object@.+class ObjectResult m where+ -- | + toObjectResult :: Either JThrowable (Maybe JObject) -> Java m++instance UnsafeCast a => ObjectResult (Value JThrowable a) where+ toObjectResult = either (return . Fail)+ (maybe (return NoValue)+ (fmap Value . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Either (Maybe JThrowable) a) where+ toObjectResult = either (return . Left . Just)+ (maybe (return (Left Nothing))+ (fmap Right . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Either JThrowable (Maybe a)) where+ toObjectResult = either (return . Left)+ (fmap Right . maybe (return Nothing)+ (fmap Just . unsafeFromJObject))++instance UnsafeCast a => ObjectResult (Maybe a) where+ toObjectResult = either (\exc -> toString exc >>= fail)+ (maybe (return Nothing)+ (fmap Just . unsafeFromJObject))++instance ObjectResult [Char] where+ toObjectResult = either (\exc -> toString exc >>= fail)+ (maybe (return "null") toString)+++---------------------------------------------------+-- Advanced features (Callbacks, Subtyping, ...) --+---------------------------------------------------+++-- | A convenient alternative to 'isInstanceOf'.+--+-- Minimal complete definition: 'coerce' or 'whenInstanceOf'.+class InstanceOf a where+ type CoercedType a++ -- | Check if the object of type @a@ is an instance+ -- of the type represented by @b@. + instanceOf :: JavaObject o => o -> a -> Java Bool++ -- | Check if the object of type @a@ is an instance+ -- of the type @c@, represented by @b@. If so, it will coerce+ -- the object of type @a@ and pass it to the given action.+ --+ -- If @a@ was an instance of @c@ (where @c@ is represented+ -- by @b@) this function will return @'Just' d@, where @d@ is+ -- the result of the optional computation. If not, 'Nothing'+ -- is returned.+ whenInstanceOf :: JavaObject o => o -> a -> (CoercedType a -> Java d) -> Java (Maybe d)++ -- | Coerces the given object of type @a@ to an object of+ -- @c@, where @c@ is represented by a value of type @b@.+ -- Returns @'Nothing'@ if this is not possible.+ coerce :: JavaObject o => o -> a -> Java (Maybe (CoercedType a))++ instanceOf o t =+ whenInstanceOf o t (return . const ())+ >>= return . maybe False (const True)++ whenInstanceOf o t a =+ coerce o t >>= maybe (return Nothing) (fmap Just . a)++ coerce o t = whenInstanceOf o t return++-- | For INTERNAL use only. Is however not in a hidden module,+-- so that other libraries can link against it.+class UnsafeCast a where+ -- | For INTERNAL use only. Do not use yourself.+ unsafeFromJObject :: JObject -> Java a++++---------------+-- Callbacks --+---------------+++registerCallbacks :: Core.JClass -> Java Bool+-- ^ Yepp. Register callbacks. Do it.+registerCallbacks (Core.JClass ptr) = do+ vm <- getVM+ io $ withForeignPtr ptr $ \clazz -> JNI.registerCallbacks vm clazz++-- | A wrapped function can be used as a callback from the+-- JVM into the Haskell runtime environment.+type WrappedFun = Ptr Core.JVM -- Ptr to JEnv+ -> Ptr Core.JObjectRef -- Ptr to this, a proxy+ -> Ptr Core.JObjectRef -- Ptr to method, the requested method+ -> Ptr Core.JObjectRef -- Ptr to a JObject-Array (Object[]), the arguments+ -> IO (Ptr Core.JObjectRef) -- Returns a pointer to the result+++runJava_ :: Ptr Core.JVM -> Java a -> IO a+runJava_ vm f = runStateT (_runJava f) (newJVMState vm) >>= return . fst++foreign import ccall safe "wrapper"+ wrap_ :: WrappedFun -> IO (FunPtr WrappedFun)++foreign export ccall freeFunPtr :: FunPtr WrappedFun -> IO ()+++freeFunPtr :: FunPtr WrappedFun -> IO ()+freeFunPtr ptr = freeHaskellFunPtr ptr+++wrap :: Java () -> IO (FunPtr WrappedFun)+wrap f = do++ let func vm _self _method _args = do+ runJava_ vm f+ return nullPtr+ + func' <- wrap_ func++ return func'++intify :: Java () -> IO Int64+intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap+++sushimaki :: String -> Java () -> Java JObject+sushimaki ifaceName func = do+ iface <- getClass ifaceName >>= asObject . fromJust+ (Just clazz) <- getClass "HFunction"+ _success <- registerCallbacks clazz+ makeFunction <- clazz `bindStaticMethod` "makeFunction"+ ::= object "java.lang.Class" --> long --> object "java.lang.Object"+ (Just impl) <- io (intify func) >>= makeFunction (Just iface)+ return impl+++delete :: Core.JObject -> Java ()+delete (Core.JObject ptr) = io $ do+ finalizeForeignPtr ptr+++
+ src/Foreign/Java/JNI.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE Haskell2010+ , CPP #-}+{-# OPTIONS -Wall #-}++-- | This module contains information about the java bridge on your+-- system. For the low level interface use "Foreign.Java.JNI.Safe" or+-- "Foreign.Java.JNI.Unsafe", for the medium level interface use+-- "Foreign.Java".+--+-- For creating high level bindings between Haskell and Java use+-- "Foreign.Java.Bindings".+module Foreign.Java.JNI where++data JniFlag+ = ONLY_CORE -- ^ The java bridge was compiled with only the+ -- core modules (low level interface).+ | DEBUG -- ^ The java bridge was compiled with debug+ -- symbols.+ | OSX_GUI -- ^ The java bridge was compiled with special+ -- support for Cocoa on Mac OS X.+ | OSX_FRAMEWORK -- ^ The java bridge was linked with the Java+ -- framework on OS X. Otherwise @libjvm@ is+ -- loaded dynamically.+ deriving (Show, Eq)++jniFlags :: [JniFlag]+-- ^ Returns a list of flags which the java bridge was compiled with.+jniFlags =++#ifdef FFIJNI_ONLY_CORE+ ONLY_CORE :+#endif++#ifdef FFIJNI_DEBUG+ DEBUG :+#endif++#ifdef FFIJNI_OSX_GUI+ OSX_GUI :+#endif++#ifdef FFIJNI_OSX_FRAMEWORK+ OSX_FRAMEWORK :+#endif++ []++javaBridgeVersion :: String+-- ^ The version of the java bridge.+javaBridgeVersion = FFIJNI_BRIDGE_VERSION++
+ src/Foreign/Java/JNI/Safe.tpl view
@@ -0,0 +1,1 @@+("core.hs", [("NAME", "Safe"), ("SAFETY", "safe"), ("OPPOSITE", "Unsafe")])
+ src/Foreign/Java/JNI/Types.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE Haskell2010+ , GADTs+ #-}+{-# OPTIONS -Wall #-}++module Foreign.Java.JNI.Types where++import Data.Int+import Data.Word++import Foreign (ForeignPtr)++data Z = Z deriving Show+data C = C deriving Show+data B = B deriving Show+data S = S deriving Show+data I = I deriving Show+data J = J deriving Show+data F = F deriving Show+data D = D deriving Show+data L = L String deriving Show+data V = V deriving Show+data A x = A x deriving Show+data X = X deriving Show++data Q = Q String deriving Show++data JVM+data JObjectRef+data JClassRef+data JThrowableRef+data JMethodID+data JStaticMethodID+data JFieldID+data JStaticFieldID+data JConstructorID+data JValues+data JChars+data JBytes++data JArg where+ BooleanA :: Bool -> JArg+ CharA :: Word16 -> JArg+ ByteA :: Int8 -> JArg+ ShortA :: Int16 -> JArg+ IntA :: Int32 -> JArg+ LongA :: Int64 -> JArg+ FloatA :: Float -> JArg+ DoubleA :: Double -> JArg+ StringA :: String -> JArg+ ObjectA :: (Maybe JObject) -> JArg+ ArrayA :: (Maybe (JArray e)) -> JArg++-- | A reference to an arbitrary Object.+newtype JObject = JObject { jobjectPtr :: ForeignPtr JObjectRef }+ deriving Show++-- | A reference to a Class object.+newtype JClass = JClass { jclassPtr :: ForeignPtr JClassRef }+ deriving Show++-- | A reference to an Exception.+newtype JThrowable = JThrowable { jthrowablePtr :: ForeignPtr JThrowableRef }+ deriving Show++-- | A reference to an Array in the JVM.+data JArray e = JArray {+ jarrayLength :: Int32,+ jarrayPtr :: ForeignPtr JObjectRef+ } deriving Show++
+ src/Foreign/Java/JNI/Unsafe.tpl view
@@ -0,0 +1,1 @@+("core.hs", [("NAME", "Unsafe"), ("SAFETY", "unsafe"), ("OPPOSITE", "Safe")])
+ src/Foreign/Java/JNI/core.hs view
@@ -0,0 +1,683 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++-- |+-- Module : Foreign.Java.JNI.%NAME%+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : stable+-- Portability : portable (Haskell2010)+--+-- Low level interface to the Java Virtual Machine.+-- This module is a very thin wrapper over the Java Native Interface.+--+-- Note that all functions that return references (of type @Ptr JObjectRef@)+-- return global references which you will need to free manually.+-- +-- This module contains %SAFETY% bindings, see also+-- "Foreign.Java.JNI.%OPPOSITE%".+-- +-- Read the /The Java Native Interface - Programmer's Guide and Specification/+-- for further information on the Java Native Interface+-- (available at <http://www.soi.city.ac.uk/~kloukin/IN2P3/material/jni.pdf>,+-- and <http://192.9.162.55/docs/books/jni/>).+module Foreign.Java.JNI.%NAME% (++-- * Controlling the virtual machine++JVM,++createVM,+createVM',+destroyVM,+persistVM,++-- * Discovering classes++JClassRef,+findClass,++-- * Object creation++JConstructorID,+JObjectRef,++getConstructorID,+newObject,++-- ** Array creation++newBooleanArray,+newCharArray,+newLongArray,+newIntArray,+newShortArray,+newByteArray,+newFloatArray,+newDoubleArray,+newObjectArray,++-- * Method access++JStaticMethodID,+JMethodID,++getStaticMethodID,+getMethodID,++-- ** Static method invocation++callStaticVoidMethod,+callStaticBooleanMethod,+callStaticCharMethod,+callStaticByteMethod,+callStaticShortMethod,+callStaticIntMethod,+callStaticLongMethod,+callStaticFloatMethod,+callStaticDoubleMethod,+callStaticObjectMethod,+callStaticStringMethod,++-- ** Method invocation++callVoidMethod,+callBooleanMethod,+callCharMethod,+callByteMethod,+callShortMethod,+callIntMethod,+callLongMethod,+callFloatMethod,+callDoubleMethod,+callObjectMethod,+callStringMethod,++-- * Field access++JFieldID,+JStaticFieldID,++getFieldID,+getStaticFieldID,++-- ** Static getters++getStaticBooleanField,+getStaticCharField,+getStaticByteField,+getStaticShortField,+getStaticIntField,+getStaticLongField,+getStaticFloatField,+getStaticDoubleField,+getStaticObjectField,+getStaticStringField,++-- ** Static setters++setStaticBooleanField,+setStaticCharField,+setStaticByteField,+setStaticShortField,+setStaticIntField,+setStaticLongField,+setStaticFloatField,+setStaticDoubleField,+setStaticObjectField,+setStaticStringField,++-- ** Member getters++getBooleanField,+getCharField,+getByteField,+getShortField,+getIntField,+getLongField,+getFloatField,+getDoubleField,+getObjectField,+getStringField,++-- ** Member setters++setBooleanField,+setCharField,+setByteField,+setShortField,+setIntField,+setLongField,+setFloatField,+setDoubleField,+setObjectField,+setStringField,++-- * Argument passing++JValues,+JArg (..),++mkJValues,++newJValues,+setJValueByte,+setJValueShort,+setJValueInt,+setJValueLong,+setJValueFloat,+setJValueDouble,+setJValueObject,+setJValueString,++-- * Releasing resources++releaseJObjectRef,+releaseJClassRef,+releaseJThrowableRef,+release,++-- * Special data types++-- ** String handling++JChars,+JBytes,++newJString,+charsFromJString,+bytesFromJString,+releaseJChars,+releaseJBytes,+jStringToCString,++-- ** Array handling++getArrayLength,++-- ** Reflection++getObjectClass,+isInstanceOf,++-- ** Exception handling++JThrowableRef,++exceptionCheck,+exceptionOccurred,+exceptionOccurredClear,+exceptionClear,+exceptionDescribe,++-- * Debugging++getDebugStatus,+setDebugStatus,++-- * libjvm initialization++getLibjvmPath,+getCompiledLibjvmPath,+setLibjvmPath,+registerCallbacks,++-- * Primitive types++Z (Z), C (C), B (B), S (S), I (I), J (J),+D (D), F (F), L (L), V (V), A (A), X (X),++-- * Workarounds for certain platforms++runCocoaMain++) where++import Data.Int+import Data.Word++import Foreign+import Foreign.C.Types+import Foreign.C.String++import Foreign.Java.JNI.Types++-- | Create a JValues Array which can be used for argument+-- passing to a multi parameter method. You need to free the+-- Ptr object manually using 'free'.+--+-- This method is implemented using @calloc@ internally.+-- See the native implementation of @newJValues@.+mkJValues :: Ptr JVM -> [JArg] -> IO (Ptr JValues)+mkJValues vm args = do+ jvalues <- newJValues $ fromIntegral $ length args+ fillJValuesArray vm (0 :: CInt) args jvalues++fillJValuesArray :: Ptr JVM -> CInt -> [JArg] -> Ptr JValues -> IO (Ptr JValues)+fillJValuesArray _ _ [] jvalues = return jvalues+fillJValuesArray vm ix (x:xs) jvalues = setValue >> fillJValuesArray vm (ix+1) xs jvalues+ where+ setValue =+ case x of+ (BooleanA v) -> setJValueBoolean jvalues ix v+ (CharA v) -> setJValueChar jvalues ix v+ (ByteA v) -> setJValueByte jvalues ix v+ (ShortA v) -> setJValueShort jvalues ix v+ (IntA v) -> setJValueInt jvalues ix v+ (LongA v) -> setJValueLong jvalues ix v+ (FloatA v) -> setJValueFloat jvalues ix $ realToFrac v+ (DoubleA v) -> setJValueDouble jvalues ix $ realToFrac v+ (ObjectA (Just v)) -> withForeignPtr (jobjectPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ObjectA Nothing) -> setJValueObject jvalues ix nullPtr+ (ArrayA (Just v)) -> withForeignPtr (jarrayPtr v) $+ \ptr -> setJValueObject jvalues ix ptr+ (ArrayA Nothing) -> setJValueObject jvalues ix nullPtr+ (StringA v) -> do+ cstring <- newCString v+ setJValueString vm jvalues ix cstring+ free cstring++foreign import ccall %SAFETY% "ffijni.h createVM"+ createVM :: IO (Ptr JVM)++foreign import ccall %SAFETY% "ffijni.h createVM2"+ createVM' :: Word32 -- ^ The number of arguments (like argc)+ -> Ptr CString -- ^ A @char**@ to the arguments (like argv)+ -> IO (Ptr JVM) -- ^ Returns a Ptr to the newly running JVM++foreign import ccall %SAFETY% "ffijni.h destroyVM"+ destroyVM :: Ptr JVM -> IO ()++foreign import ccall %SAFETY% "ffijni.h persistVM"+ persistVM :: Ptr JVM -> IO ()++foreign import ccall %SAFETY% "ffijni.h findClass"+ findClass :: Ptr JVM -> CString -> IO (Ptr JClassRef)++foreign import ccall %SAFETY% "ffijni.h newObject"+ newObject :: Ptr JVM -> Ptr JClassRef -> Ptr JConstructorID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h getConstructorID"+ getConstructorID :: Ptr JVM -> Ptr JClassRef -> CString -> IO (Ptr JConstructorID)++foreign import ccall %SAFETY% "ffijni.h getStaticMethodID"+ getStaticMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticMethodID)++foreign import ccall %SAFETY% "ffijni.h getMethodID"+ getMethodID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JMethodID)++foreign import ccall %SAFETY% "ffijni.h getStaticFieldID"+ getStaticFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JStaticFieldID)++foreign import ccall %SAFETY% "ffijni.h getFieldID"+ getFieldID :: Ptr JVM -> Ptr JClassRef -> CString -> CString -> IO (Ptr JFieldID)++foreign import ccall %SAFETY% "ffijni.h callStaticVoidMethod"+ callStaticVoidMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO ()++foreign import ccall %SAFETY% "ffijni.h callStaticIntMethod"+ callStaticIntMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int32++foreign import ccall %SAFETY% "ffijni.h callStaticLongMethod"+ callStaticLongMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int64++foreign import ccall %SAFETY% "ffijni.h callStaticShortMethod"+ callStaticShortMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int16++foreign import ccall %SAFETY% "ffijni.h callStaticByteMethod"+ callStaticByteMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Int8++foreign import ccall %SAFETY% "ffijni.h callStaticFloatMethod"+ callStaticFloatMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CFloat++foreign import ccall %SAFETY% "ffijni.h callStaticDoubleMethod"+ callStaticDoubleMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CDouble++foreign import ccall %SAFETY% "ffijni.h callStaticBooleanMethod"+ callStaticBooleanMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Bool++foreign import ccall %SAFETY% "ffijni.h callStaticCharMethod"+ callStaticCharMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO Word16++foreign import ccall %SAFETY% "ffijni.h callStaticObjectMethod"+ callStaticObjectMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h callStaticStringMethod"+ callStaticStringMethod :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticMethodID -> Ptr JValues -> IO CString++foreign import ccall %SAFETY% "ffijni.h callVoidMethod"+ callVoidMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO ()++foreign import ccall %SAFETY% "ffijni.h callLongMethod"+ callLongMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int64++foreign import ccall %SAFETY% "ffijni.h callIntMethod"+ callIntMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int32++foreign import ccall %SAFETY% "ffijni.h callShortMethod"+ callShortMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int16++foreign import ccall %SAFETY% "ffijni.h callByteMethod"+ callByteMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Int8++foreign import ccall %SAFETY% "ffijni.h callFloatMethod"+ callFloatMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CFloat++foreign import ccall %SAFETY% "ffijni.h callDoubleMethod"+ callDoubleMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CDouble++foreign import ccall %SAFETY% "ffijni.h callBooleanMethod"+ callBooleanMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Bool++foreign import ccall %SAFETY% "ffijni.h callCharMethod"+ callCharMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO Word16++foreign import ccall %SAFETY% "ffijni.h callObjectMethod"+ callObjectMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h callStringMethod"+ callStringMethod :: Ptr JVM -> Ptr JObjectRef -> Ptr JMethodID -> Ptr JValues -> IO CString++foreign import ccall %SAFETY% "ffijni.h getStaticLongField"+ getStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int64++foreign import ccall %SAFETY% "ffijni.h getStaticIntField"+ getStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int32++foreign import ccall %SAFETY% "ffijni.h getStaticShortField"+ getStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int16++foreign import ccall %SAFETY% "ffijni.h getStaticByteField"+ getStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Int8++foreign import ccall %SAFETY% "ffijni.h getStaticFloatField"+ getStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CFloat++foreign import ccall %SAFETY% "ffijni.h getStaticDoubleField"+ getStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CDouble++foreign import ccall %SAFETY% "ffijni.h getStaticBooleanField"+ getStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Bool++foreign import ccall %SAFETY% "ffijni.h getStaticCharField"+ getStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO Word16++foreign import ccall %SAFETY% "ffijni.h getStaticObjectField"+ getStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h getStaticStringField"+ getStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> IO CString++foreign import ccall %SAFETY% "ffijni.h getLongField"+ getLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int64++foreign import ccall %SAFETY% "ffijni.h getIntField"+ getIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int32++foreign import ccall %SAFETY% "ffijni.h getShortField"+ getShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int16++foreign import ccall %SAFETY% "ffijni.h getByteField"+ getByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Int8++foreign import ccall %SAFETY% "ffijni.h getFloatField"+ getFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CFloat++foreign import ccall %SAFETY% "ffijni.h getDoubleField"+ getDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CDouble++foreign import ccall %SAFETY% "ffijni.h getBooleanField"+ getBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Bool++foreign import ccall %SAFETY% "ffijni.h getCharField"+ getCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO Word16++foreign import ccall %SAFETY% "ffijni.h getObjectField"+ getObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h getStringField"+ getStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> IO CString++foreign import ccall %SAFETY% "ffijni.h setStaticLongField"+ setStaticLongField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int64 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticIntField"+ setStaticIntField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int32 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticShortField"+ setStaticShortField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticByteField"+ setStaticByteField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Int8 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticFloatField"+ setStaticFloatField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CFloat -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticDoubleField"+ setStaticDoubleField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CDouble -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticBooleanField"+ setStaticBooleanField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Bool -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticCharField"+ setStaticCharField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Word16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticObjectField"+ setStaticObjectField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStaticStringField"+ setStaticStringField :: Ptr JVM -> Ptr JClassRef -> Ptr JStaticFieldID -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h setLongField"+ setLongField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int64 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setIntField"+ setIntField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int32 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setShortField"+ setShortField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setByteField"+ setByteField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Int8 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setFloatField"+ setFloatField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CFloat -> IO ()++foreign import ccall %SAFETY% "ffijni.h setDoubleField"+ setDoubleField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CDouble -> IO ()++foreign import ccall %SAFETY% "ffijni.h setBooleanField"+ setBooleanField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Bool -> IO ()++foreign import ccall %SAFETY% "ffijni.h setCharField"+ setCharField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Word16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setObjectField"+ setObjectField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> Ptr JObjectRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h setStringField"+ setStringField :: Ptr JVM -> Ptr JObjectRef -> Ptr JFieldID -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h newJValues"+ newJValues :: CInt -> IO (Ptr JValues)++foreign import ccall %SAFETY% "ffijni.h setJValueLong"+ setJValueLong :: Ptr JValues -> CInt -> Int64 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueInt"+ setJValueInt :: Ptr JValues -> CInt -> Int32 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueShort"+ setJValueShort :: Ptr JValues -> CInt -> Int16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueByte"+ setJValueByte :: Ptr JValues -> CInt -> Int8 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueFloat"+ setJValueFloat :: Ptr JValues -> CInt -> CFloat -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueDouble"+ setJValueDouble :: Ptr JValues -> CInt -> CDouble -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueBoolean"+ setJValueBoolean :: Ptr JValues -> CInt -> Bool -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueChar"+ setJValueChar :: Ptr JValues -> CInt -> Word16 -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueObject"+ setJValueObject :: Ptr JValues -> CInt -> Ptr JObjectRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h setJValueString"+ setJValueString :: Ptr JVM -> Ptr JValues -> CInt -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h newBooleanArray"+ newBooleanArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newCharArray"+ newCharArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newLongArray"+ newLongArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newIntArray"+ newIntArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newShortArray"+ newShortArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newByteArray"+ newByteArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newFloatArray"+ newFloatArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newDoubleArray"+ newDoubleArray :: Ptr JVM -> Int32 -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newObjectArray"+ newObjectArray :: Ptr JVM -> Int32 -> Ptr JClass -> Ptr JObjectRef++foreign import ccall %SAFETY% "ffijni.h newJString"+ newJString :: Ptr JVM -> CString -> IO (Ptr JObjectRef)++foreign import ccall %SAFETY% "ffijni.h charsFromJString"+ charsFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JChars)++foreign import ccall %SAFETY% "ffijni.h bytesFromJString"+ bytesFromJString :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JBytes)++foreign import ccall %SAFETY% "ffijni.h releaseJChars"+ releaseJChars :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h releaseJBytes"+ releaseJBytes :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h jStringToCString"+ jStringToCString :: Ptr JVM -> Ptr JObjectRef -> CString -> IO ()++foreign import ccall %SAFETY% "ffijni.h getArrayLength"+ getArrayLength :: Ptr JVM -> Ptr JObjectRef -> IO Int32++foreign import ccall %SAFETY% "ffijni.h getObjectClass"+ getObjectClass :: Ptr JVM -> Ptr JObjectRef -> IO (Ptr JClassRef)++foreign import ccall %SAFETY% "ffijni.h isInstanceOf"+ isInstanceOf :: Ptr JVM -> Ptr JObjectRef -> Ptr JClassRef -> IO Bool++-- | Returns the path to libjvm that is used by this library.+-- Note that this will return the @nullPtr@ if the library has not+-- yet been initialized. The library is lazily initialized the first+-- time that 'runJava'' is used. 'runJava' is implemented in terms of+-- 'runJava', as is 'initJava'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall %SAFETY% "ffijni.h getLibjvmPath"+ getLibjvmPath :: IO CString++-- | Returns the path to libjvm with which this library has been+-- compiled. This is guaranteed to never return 'nullPtr'.+--+-- You are not allowed to invoke 'free' on the returned cstring.+foreign import ccall %SAFETY% "ffijni.h getCompiledLibjvmPath"+ getCompiledLibjvmPath :: IO CString++-- | Sets the path to libjvm. Note that this will only have an+-- effect if the library has not yet been initialized, that is+-- before any of the following functions is used: 'runJava',+-- 'runJava'', and 'initJava'.+--+-- Do not invoke 'free' on the cstring passed to this function,+-- as this function will not set a copy but the object given.+-- It is only ever used once during the lifecycle of your+-- application.+foreign import ccall %SAFETY% "ffijni.h setLibjvmPath"+ setLibjvmPath :: CString -> IO ()++-- | Checks whether an exception has occured in the virtual+-- machine or not.+foreign import ccall %SAFETY% "ffijni.h exceptionCheck"+ exceptionCheck :: Ptr JVM -> IO Bool++foreign import ccall %SAFETY% "ffijni.h exceptionClear"+ exceptionClear :: Ptr JVM -> IO ()++foreign import ccall %SAFETY% "ffijni.h exceptionDescribe"+ exceptionDescribe :: Ptr JVM -> IO ()++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will return a local reference only, so beware that the+-- obtained Ptr will not be valid for too long.+foreign import ccall %SAFETY% "ffijni.h exceptionOccurred"+ exceptionOccurred :: Ptr JVM -> IO (Ptr JThrowableRef)++-- | Checks whether an exception occured and return that exception.+-- If no exception occured, the returned pointer will be the 'nullPtr'.+-- This method will also call exceptionClear which means that it can+-- not be called twice. This method will return a global reference+-- - as opposed to 'exceptionOccurred', which will return a local+-- reference only.+foreign import ccall %SAFETY% "ffijni.h exceptionOccurredClear"+ exceptionOccurredClear :: Ptr JVM -> IO (Ptr JThrowableRef)++foreign import ccall %SAFETY% "ffijni.h releaseJObjectRef"+ releaseJObjectRef :: Ptr JVM -> Ptr JObjectRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h releaseJClassRef"+ releaseJClassRef :: Ptr JVM -> Ptr JClassRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h releaseJThrowableRef"+ releaseJThrowableRef :: Ptr JVM -> Ptr JThrowableRef -> IO ()++foreign import ccall %SAFETY% "ffijni.h &release"+ release_ :: FunPtr (Ptr a -> IO ())++class ReleaseGlobalReference a where+ release :: FunPtr (Ptr a -> IO ())+ -- ^ @release@ is a special function which can be used to create a+ -- 'ForeignPtr'. A ForeignPtr does not carry a reference to a virtual+ -- machine (no @Ptr JVM@), thus this function will lookup the current+ -- virtual machine or do nothing if it can not find one. It is+ -- realised as a 'FunPtr' as this is what 'newForeignPtr' expects.+ release = release_++instance ReleaseGlobalReference JObjectRef+instance ReleaseGlobalReference JClassRef+instance ReleaseGlobalReference JThrowableRef++foreign import ccall %SAFETY% "ffijni.h registerCallbacks"+ registerCallbacks :: Ptr JVM -> Ptr JClassRef -> IO Bool++foreign import ccall %SAFETY% "ffijni.h getDebugStatus"+ getDebugStatus :: IO Bool++foreign import ccall %SAFETY% "ffijni.h setDebugStatus"+ setDebugStatus :: Bool -> IO ()++foreign import ccall %SAFETY% "ffijni.h runCocoaMain"+ runCocoaMain :: IO ()+
+ src/Foreign/Java/JavaMonad.hs view
@@ -0,0 +1,296 @@+{-# LANGUAGE Haskell2010+ , GeneralizedNewtypeDeriving+ , DeriveDataTypeable+ , CPP+ #-}+{-# OPTIONS+ -Wall+ -fno-warn-missing-signatures+ -fno-warn-name-shadowing+ #-}++-- | INTERNAL module:+-- The Java Monad Transformer. Most of its API is re-exported by "Foreign.Java"+module Foreign.Java.JavaMonad where+++import Control.Monad.State hiding (void)+import qualified Control.Monad.State as State++import Data.Int+import Data.Word++import qualified Foreign.Java.JNI.Safe as JNI+import qualified Foreign.Java.JNI.Types as Core++import Foreign.Java.JNI.Types (+ JObject (..),+ JThrowable (..)+ )++import Foreign hiding (void)+import Foreign.C.String++import Foreign.Java.Util++import Control.Concurrent+import Control.Exception+import Data.Typeable+++io :: IO a -> Java a+-- ^ Short for 'liftIO' and restricted to the 'Java' monad.+io = liftIO+++-- | An exception in either the Java Virtual Machine or during+-- instantiating the Virtual Machine.+data JavaException =+ -- | An exception that occurred during the initialization+ -- of the virtual machine. Thrown by 'runJava', 'runJava'',+ -- or 'initJava'.+ JvmException String [String]++ -- | An exception that occurred inside the virtual machine.+ -- Thrown by those functions ending with a capital @E@.+ | JavaException String JThrowable+ deriving Typeable++instance Show JavaException where+ show (JvmException jvmlibPath args) =+ "JvmException: jvmlibPath = " ++ jvmlibPath+ ++ ", arguments = " ++ show args+ show (JavaException strMessage _throwable) =+ "JavaException: " ++ strMessage++instance Exception JavaException+++-- | A reference to an instance of a Java Virtual Machine.+newtype JVM = JVM (Ptr Core.JVM)+ deriving Show+++-- | The State of a virtual machine, running in the Java+-- Monad (which is a State Monad wrapped around the IO+-- Monad with JVMState as additional State).+--+-- All the accessor functions are INTERNAL.+data JVMState = JVMState {++ -- | INTERNAL The actual pointer to the virtual machine.+ jvmPtr :: Ptr Core.JVM,++ -- | INTERNAL Whether this virtual machine instance should+ -- be talked to using safe or unsafe calls.+ --+ -- See also 'setSafe' and 'getSafe'.+ jvmSafe :: Bool,++ -- | INTERNAL The cached methodID of Object.toString+ jvmToString :: Maybe (JObject -> Java (Maybe String)),++ -- | INTERNAL The cached methodID of Object.hashCode+ jvmHashCode :: Maybe (JObject -> Java Int32),++ jvmGetC :: Maybe (Maybe JObject -> Int32 -> Java Word16),+ jvmGetB :: Maybe (Maybe JObject -> Int32 -> Java Int8),+ jvmGetS :: Maybe (Maybe JObject -> Int32 -> Java Int16),+ jvmGetI :: Maybe (Maybe JObject -> Int32 -> Java Int32),+ jvmGetJ :: Maybe (Maybe JObject -> Int32 -> Java Int64),+ jvmGetF :: Maybe (Maybe JObject -> Int32 -> Java Float),+ jvmGetD :: Maybe (Maybe JObject -> Int32 -> Java Double),+ jvmGetZ :: Maybe (Maybe JObject -> Int32 -> Java Bool),+ jvmGetL :: Maybe (Maybe JObject -> Int32 -> Java (Maybe JObject)),++ jvmSetC :: Maybe (Maybe JObject -> Int32 -> Word16 -> Java ()),+ jvmSetB :: Maybe (Maybe JObject -> Int32 -> Int8 -> Java ()),+ jvmSetS :: Maybe (Maybe JObject -> Int32 -> Int16 -> Java ()),+ jvmSetI :: Maybe (Maybe JObject -> Int32 -> Int32 -> Java ()),+ jvmSetJ :: Maybe (Maybe JObject -> Int32 -> Int64 -> Java ()),+ jvmSetF :: Maybe (Maybe JObject -> Int32 -> Float -> Java ()),+ jvmSetD :: Maybe (Maybe JObject -> Int32 -> Double -> Java ()),+ jvmSetZ :: Maybe (Maybe JObject -> Int32 -> Bool -> Java ()),+ jvmSetL :: Maybe (Maybe JObject -> Int32 -> (Maybe JObject) -> Java ())+ }++-- | Creates a JVMState and initializes it with sane default values.+-- A Pointer to the virtual machine is required in any case.+newJVMState vm = JVMState {++ jvmPtr = vm,+ jvmSafe = True,+ jvmToString = Nothing,+ jvmHashCode = Nothing,++ jvmGetC = Nothing, jvmSetC = Nothing,+ jvmGetB = Nothing, jvmSetB = Nothing,+ jvmGetS = Nothing, jvmSetS = Nothing,+ jvmGetI = Nothing, jvmSetI = Nothing,+ jvmGetJ = Nothing, jvmSetJ = Nothing,+ jvmGetF = Nothing, jvmSetF = Nothing,+ jvmGetD = Nothing, jvmSetD = Nothing,+ jvmGetZ = Nothing, jvmSetZ = Nothing,+ jvmGetL = Nothing, jvmSetL = Nothing+ }+++-- | Every computation in the Java Virtual Machine happens inside the+-- Java monad. The Java monad is mightier than the IO monad, i.e.+-- IO operations can be performed in both the IO monad as well as in+-- the Java monad, but Java operations can be performed in the Java+-- monad only and not in the IO monad.+--+-- Use one of 'runJava' or 'runJava'' to perform operations in the+-- Java monad.+newtype Java a = Java { _runJava :: StateT JVMState IO a }+ deriving (Monad, MonadState JVMState, Functor, MonadIO)++-- | INTERNAL Retrieve the 'jvmPtr' from this Java Monads+-- State.+getVM :: Java (Ptr Core.JVM)+getVM = State.get $> jvmPtr++-- | INTERNAL Retrieve 'jvmSafe' from this Java Monads Sate.+getSafe :: Java Bool+getSafe = State.get $> jvmSafe++-- | By default java methods are invoked via the FFI using+-- safe calls. Safe calls are slower than unsafe calls. This+-- function controls whether safe or unsafe calls are being+-- used to communicate with the JVM.+--+-- If your application does not invoke the JVM concurrently+-- it is mostly safe to use unsafe calls.+--+-- > runJava (setUnsafe True >> doSomething)+--+-- will perform 'doSomething' using unsafe calls.+setUnsafe mode = do+ state <- State.get+ State.put (state { jvmSafe = not mode })++++newtype JavaThreadId a = JavaThreadId (MVar (Either SomeException a))++forkJava :: Java a -> Java (JavaThreadId a)+-- ^ A utility function for forking an OS thread which runs in the+-- Java Monad. It will return a 'JavaThreadId' which you can wait on+-- using 'waitJava'.+forkJava t = io $ do+ lock <- newEmptyMVar+ _ <- forkOS $ do+ result <- try $ runJava t+ putMVar lock result+ return $ JavaThreadId lock+++waitJava :: JavaThreadId a -> Java (Either SomeException a)+-- ^ Wait for a Java Thread to exit. If the thread exits abnormally+-- (that is, if an exception occurred), this function will return+-- @Left SomeException@. Otherwise it will return the result of the+-- computation as @Right a@.+waitJava (JavaThreadId mvar) = io $ takeMVar mvar+++runJava :: Java a -> IO a+-- ^ Run a computation with support by a Java Virtual Machine.+runJava = runJava' []+++runJava' :: [String] -> Java a -> IO a+-- ^ Run a computation with support by a Java Virtual Machine,+-- initialized with the given parameters.+--+-- This function may be used only once. If you intend to call+-- it multiple times, you need to initialize the Java subsystem+-- once before. If you fail to do so, this function will tear+-- down the virtual machine once it is done.+--+-- By using 'initJava' the virtual machine will be alive during+-- the whole lifetime of your process and 'runJava'' will never+-- tear down the machine.+--+-- /NOTE: According to the Java Native Interface specification it may be possible to create multiple virtual machines within a single process. However, no implementation of the JNI seems to be capable of doing so./+--+-- This function can be used to set for example the classpath+-- of the virtual machine:+--+-- > runJava' ["-Djava.class.path=java-library-dir"] $ do+-- > doSomething+--+-- /NOTE: java.class.path does support relative paths./+runJava' opts f = do++ str <- mapM newCString (augmentOpts opts)+ ptr <- newArray str+ vm <- JNI.createVM' (fromIntegral $ length str) ptr++ mapM_ free str >> free ptr++ if vm == nullPtr then do+ libjvmPath <- JNI.getLibjvmPath >>= peekCString+ throw $ JvmException libjvmPath opts+ else return ()+ + (result, _) <- finally (runStateT (_runJava f) (newJVMState vm))+ (JNI.destroyVM vm)++ return result++#ifdef FFIJNI_DEBUG+augmentOpts = ("-Xcheck:jni" :)+#else+augmentOpts = id+#endif++runJavaGui :: Java a -> IO ()+-- ^ Short hand for @runJavaGui' []@.+runJavaGui = runJavaGui' []++runJavaGui' :: [String] -> Java a -> IO ()+-- ^ Mac OS X needs some special treatment for initializing+-- graphical applications, namely a Cocoa Runloop needs to be present+-- on the main thread. Since the main thread is the application+-- that the JVM was invoked from this has two consequences:+-- (1) A runloop needs to be created on the main thread+-- manually and (2) the main thread is not usable for your application.+--+-- On Mac OS X this function will fork an os thread using 'forkJava'+-- and start the Cocoa main event loop. This means that this function+-- must be called on the main thread and that it will never terminate+-- (since the cocoa event queue will be running there forever).+--+-- Note that this implies that you link your application with+-- the threaded runtime (`-threaded` in GHC).+--+-- Typically your application should look like this:+--+-- > main = runJavaGui $ do+-- > stuffYourApplicationDoes+--+-- On all other platforms this is exactly the same as 'runJava''+-- (minus the fact that it returns @()@).+#if defined(FFIJNI_MACOSX) && defined(FFIJNI_OSX_GUI)+runJavaGui' opts java = runJava' opts $ do+ _ <- forkJava java+ io JNI.runCocoaMain+#else+runJavaGui' opts javaGui = runJava' opts javaGui >> return ()+#endif++initJava :: [String] -> IO ()+-- ^ Initializes the Java Virtual Machine so that it can+-- be used by subsequent invocations of 'runJava'. Note that+-- once you start the virtual machine it will be runing throughout+-- the whole lifetime of the main thread of your application.+initJava opts = runJava' opts persistVM++persistVM :: Java ()+persistVM = do+ vm <- getVM+ liftIO $ JNI.persistVM vm+ return ()++
+ src/Foreign/Java/Types.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE Haskell2010+ , MagicHash+ , FlexibleInstances+ , FlexibleContexts+ , MultiParamTypeClasses+ , FunctionalDependencies+ #-}+{-# OPTIONS+ -Wall+ -fno-warn-missing-signatures+ -fno-warn-name-shadowing+ #-}++-- | This module contains mostly boiler plate code that is needed+-- for method discovery.+module Foreign.Java.Types (++ -- These are human readable short hands for+ -- Z, X, C, ... below+ boolean, char, byte, short, int, long,+ float, double, string, object, array, void,++ -- These types are used to describe methods with the+ -- same vocabulary as the JNI does.+ --+ -- Notable additions: A, X, and Q are not defined in+ -- the JNI. A and X are used for convenience and+ -- resemble Arrays and Strings (S is already taken by+ -- Short, therefor X). Q is special and stands for+ -- objects in much the same way as L does, but Q will+ -- carry it's own low level signature (for example+ -- [Ljava.lang.String; ).+ Z (Z), C (C), B (B), S (S), I (I), J (J),+ D (D), F (F), L (L), V (V), A (A), X (X),++ -- P is used to apply the above descriptors.+ -- (-->) does the same thing, but is an infix operator.+ P (P),++ (-->), MethodDescriptor (..),++ -- The famous Q. See above.+ object', Q (Q),++ constructorSignature,+ methodSignature,++ Constructor,+ Method,++ Param (..),++ JArg (jarg)++ ) where++import Data.Int+import Data.Word++import Foreign.Java.JNI.Types hiding (JArg)+import qualified Foreign.Java.JNI.Types as Core+import Foreign.Java.Util+++boolean = Z+char = C+byte = B+short = S+int = I+long = J+float = F+double = D+object = L+array = A+string = X+void = V++object' = Q++data P a x = P a x deriving Show+++class Param a where+ fieldSignature :: a -> String++-- These are the translations of descriptors to+-- JNI signatures.++instance Param Z where fieldSignature _ = "Z"+instance Param C where fieldSignature _ = "C"+instance Param B where fieldSignature _ = "B"+instance Param S where fieldSignature _ = "S"+instance Param I where fieldSignature _ = "I"+instance Param J where fieldSignature _ = "J"+instance Param F where fieldSignature _ = "F"+instance Param D where fieldSignature _ = "D"+instance Param L where fieldSignature (L x) = 'L' : tr '.' '/' x ++ ";"+instance Param X where fieldSignature _ = "Ljava/lang/String;"+instance Param x => Param (A x) where fieldSignature (A x) = '[' : fieldSignature x++instance Param Q where fieldSignature (Q s) = s+++class JArg a b | a -> b where+ jarg :: a -> b -> Core.JArg++-- These are the known argument types.++instance JArg Z Bool where jarg _ = BooleanA+instance JArg C Word16 where jarg _ = CharA+instance JArg B Int8 where jarg _ = ByteA+instance JArg S Int16 where jarg _ = ShortA+instance JArg I Int32 where jarg _ = IntA+instance JArg J Int64 where jarg _ = LongA+instance JArg F Float where jarg _ = FloatA+instance JArg D Double where jarg _ = DoubleA+instance JArg L (Maybe JObject) where jarg _ = ObjectA+instance JArg (A e) (Maybe (JArray e)) where jarg _ = ArrayA+instance JArg X String where jarg _ = StringA++instance JArg Q (Maybe JObject) where jarg _ = ObjectA+++-- (-->), (::=) are infix operators for convenience.++infixr 9 -->+infixl 8 ::=++(-->) :: a -> x -> P a x+a --> x = P a x++-- A MethodDescriptor is what is given to+-- 'getMethod', 'getConstructor', and friends.++data MethodDescriptor p = String ::= p+ deriving Show+++---------------+-- Constructors+--+-- The signatures for looking up constructors are forged here.++constructorSignature :: Constructor p => p+constructorSignature = _constructorSignature "("++class Constructor p where+ _constructorSignature :: String -> p++instance Constructor String where+ _constructorSignature _ = "()V"++instance (Constructor (t -> r), Param a) => Constructor (P a t -> r) where+ _constructorSignature sig (P a t) = _constructorSignature (sig ++ fieldSignature a) t++instance Constructor (Z -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (C -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (B -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (S -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (I -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (J -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (F -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (D -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (L -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Param a => Constructor (A a -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+instance Constructor (X -> String) where+ _constructorSignature sig X = sig ++ "Ljava/lang/String;" ++ ")V"++instance Constructor (Q -> String) where+ _constructorSignature sig a = sig ++ fieldSignature a ++ ")V"+++----------+-- Methods+--+-- The signatures for looking up methods (both static and virtual,+-- that distinction has no meaning on this level) are forged here.++methodSignature :: Method p => p+methodSignature = _methodSignature "("++class Method p where+ _methodSignature :: String -> p++instance (Param a, Method r, Method (P b x -> r)) => Method (P a (P b x) -> r) where+ _methodSignature sig (P a x) = _methodSignature (sig ++ fieldSignature a) x++instance Param a => Method (P a Z -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")Z")+instance Param a => Method (P a C -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")C")+instance Param a => Method (P a B -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")B")+instance Param a => Method (P a S -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")S")+instance Param a => Method (P a I -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")I")+instance Param a => Method (P a J -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")J")+instance Param a => Method (P a F -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")F")+instance Param a => Method (P a D -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")D")+instance Param a => Method (P a L -> String) where+ _methodSignature sig (P a t) = _methodSignature (sig ++ fieldSignature a ++ ")" ++ fieldSignature t)+instance Param a => Method (P a V -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")V")+instance Param a => Method (P a X -> String) where+ _methodSignature sig (P a _) = _methodSignature (sig ++ fieldSignature a ++ ")Ljava/lang/String;")+instance (Param a, Param e) => Method (P a (A e) -> String) where+ _methodSignature sig (P a t) = _methodSignature (sig ++ fieldSignature a ++ ")" ++ fieldSignature t)++instance Param a => Method (P a Q -> String) where+ _methodSignature sig (P a t) = _methodSignature (sig ++ fieldSignature a ++ ")" ++ fieldSignature t)+++instance Method (Z -> String) where+ _methodSignature sig _ = sig ++ ")Z"+instance Method (C -> String) where+ _methodSignature sig _ = sig ++ ")C"+instance Method (B -> String) where+ _methodSignature sig _ = sig ++ ")B"+instance Method (S -> String) where+ _methodSignature sig _ = sig ++ ")S"+instance Method (I -> String) where+ _methodSignature sig _ = sig ++ ")I"+instance Method (J -> String) where+ _methodSignature sig _ = sig ++ ")J"+instance Method (F -> String) where+ _methodSignature sig _ = sig ++ ")F"+instance Method (D -> String) where+ _methodSignature sig _ = sig ++ ")D"+instance Method (L -> String) where+ _methodSignature sig s = sig ++ ")" ++ fieldSignature s+instance Method (V -> String) where+ _methodSignature sig _ = sig ++ ")V"+instance Method (X -> String) where+ _methodSignature sig _ = sig ++ ")Ljava/lang/String;"+instance (Param e, Method (e -> String)) => Method (A e -> String) where+ _methodSignature sig s = sig ++ ")" ++ fieldSignature s++instance Method (Q -> String) where+ _methodSignature sig s = sig ++ ")" ++ fieldSignature s+++instance Method String where+ _methodSignature sig = sig++
+ src/Foreign/Java/Util.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++module Foreign.Java.Util (+ tr, ($>), (<$), breakLast, trace, debug+ ) where+++import qualified Debug.Trace as Debug+++tr :: Eq a => a -> a -> [a] -> [a]+tr a b (x:xs)+ | a == x = b : tr a b xs+ | otherwise = x : tr a b xs+tr _ _ [] = []+++($>) :: Functor f => f a -> (a -> b) -> f b+($>) = flip fmap+++(<$) :: Functor f => (a -> b) -> f a -> f b+(<$) = fmap+++breakLast :: [a] -> ([a], a)+breakLast [a] = ([], a)+breakLast (a:as) =+ let (init', last') = breakLast as+ in (a:init', last')+breakLast _ = error "Foreign.Java.Util.breakLast: empty list"+++trace :: Show a => a -> a+trace a = Debug.trace (show a) a++debug :: Show b => b -> a -> a+debug b a = Debug.trace (show b) a++
+ src/Foreign/Java/Utils.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++-- |+-- Module : Foreign.Java.Utils+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : provisional+-- Portability : portable (Haskell2010)+--+-- Utilities for dealing with Class, Package, and Module names in+-- the Java and Haskell languages.+module Foreign.Java.Utils where++import Data.Strings++javaKeywords, haskellKeywords :: [String]++javaKeywords = ["abstract",+ "assert",+ "boolean",+ "break",+ "byte",+ "case",+ "catch",+ "char",+ "class",+ "const",+ "continue",+ "default",+ "do",+ "double",+ "else",+ "enum",+ "extends",+ "final",+ "finally",+ "float",+ "for",+ "goto",+ "if",+ "implements",+ "import",+ "instanceof",+ "int",+ "interface",+ "long",+ "native",+ "new",+ "package",+ "private",+ "protected",+ "public",+ "return",+ "short",+ "static",+ "staticfp",+ "super",+ "switch",+ "synchronized",+ "this",+ "throw",+ "throws",+ "transient",+ "try",+ "void",+ "volatile",+ "while",++ -- strictly speaking these three are /reserved words/...+ "null", "true", "false"]++haskellKeywords = ["as",+ "case",+ "of",+ "class",+ "data",+ "default",+ "deriving",+ "do",+ "foreign",+ "hiding",+ "if",+ "then",+ "else",+ "import",+ "infixl",+ "infixr",+ "instance",+ "let",+ "in",+ "module",+ "newtype",+ "qualified",+ "type",+ "where",++ -- either extension words or other reserved words+ "forall", -- several extensions+ "mdo", -- ... -fglasgow-exts ... (deprecated?)+ "rec", -- XDoRec+ "proc", -- arrow notation+ "family"] -- type families, to be sure++makeName :: Maybe String -- The name of the package+ -> String -- The name of the class+ -> String -- The simple name of the class, including the package.+-- ^ Build the name of a class based on maybe a package and a class name.+makeName pkg clazz = case pkg of+ (Just package) -> package ++ '.' : clazz+ _ -> clazz++makePackageModuleName :: String -- The name of the package+ -> String -- The name of the corresponding Haskell module+-- ^ Translates a package name into a module name.+makePackageModuleName name+ | null name = name+ | otherwise = strJoin "." $ map (strCapitalize)+ $ strSplitAll "." name++makeClassModuleName :: String -- The name of the class+ -> String -- The name of the corresponding Haskell module+-- ^ Translates a class name into a module name.+makeClassModuleName name = case maybe "" makePackageModuleName (takePackageName name) of+ "" -> classModuleName+ package -> package ++ '.' : classModuleName+ where classModuleName = strCapitalize+ $ dropWhile (== '_') $ filter (/= '$')+ $ takeClassName name++splitClassName :: String -> (String, String)+-- ^ Splits a class name into package name and class name.+--+-- If the name does not contain a package component, the first+-- string is empty.+--+-- See also 'joinClassName'.+splitClassName name = (maybe "" id $ takePackageName name, takeClassName name)++joinClassName :: (String, String) -> String+-- ^ Pendant to 'splitClassName'.+joinClassName (package, clazz) = case package of+ "" -> clazz+ _ -> package ++ '.' : clazz++takePackageName :: String -> Maybe String+-- ^ Retrieve the package name form a simple name of a class.+--+-- >>> takePackageName "java.lang.A$B"+-- Just "java.lang"+--+-- >>> takePackageName "Test"+-- Nothing+takePackageName fullName = if null name then Nothing else Just (init name)+ where name = (reverse . snd . break (== '.') . reverse) fullName++takeClassName :: String -> String+-- ^ Retrieve the class name form a simple name of a class.+-- This also contains the name of the enclosing class(es).+--+-- >>> takeClassName "java.lang.A$B"+-- "A$B"+--+-- >>> takeClassName "Thread$State"+-- "Thread$State"+takeClassName = reverse . fst . break (== '.') . reverse++takeBaseClassName :: String -> String+-- ^ Retrieve the class name form a simple name of a class.+-- This contains only the name of the class itself.+--+-- >>> takeBaseClassName "java.lang.A$B"+-- "B"+takeBaseClassName = reverse . fst . break (== '$') . reverse . takeClassName++takeEnclosingClasses :: String -> [String]+-- ^ Retrieve the names of the enclosing classes from a simple+-- class name.+--+-- >>> takeEnclosingClasses "java.lang.Map$EntrySet"+-- ["java.lang.Map"]+--+-- >>> takeEnclosingClasses "package.A$B$C"+-- ["package.A", "package.A$B"]+takeEnclosingClasses name = map (makeName (takePackageName name)) simpleNames+ where simpleNames = scanl1 (\x y-> x ++ "$" ++ y) $ init $ names $ takeClassName name+ names n = let (a, b) = break (== '$') n+ in a : if null b then [] else names (tail b)+
+ src/Foreign/Java/Value.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS+ -Wall+ -fno-warn-name-shadowing+ #-}++-- |+-- Module : Foreign.Java.Value+-- Copyright : (c) Julian Fleischer 2013+-- License : MIT (See LICENSE file in cabal package)+--+-- Maintainer : julian.fleischer@fu-berlin.de+-- Stability : provisional+-- Portability : portable (Haskell2010)+--+-- The ternary value type, which can /treither/ hold a value,+-- nothing, or a special value describing an error condition.+module Foreign.Java.Value where++-- | A ternary value type to hold one of two possible value types+-- or none at all.+data Value e a+ = Value a -- ^ An actual value+ | NoValue -- ^ No value+ | Fail e -- ^ A value describing the error++-- | fold on a 'Value', like 'either' for 'Either' or 'maybe' for 'Maybe'.+value :: b -- ^ default value if neither a value nor a fail value is given+ -> (e -> b) -- ^ function to handle a fail value+ -> (a -> b) -- ^ function to handle an actual value+ -> Value e a -- ^ the value+ -> b -- ^ the final return value+value noValue fail success value = case value of+ (Value a) -> success a+ (Fail e) -> fail e+ _ -> noValue+
+ src/ffijni.c view
@@ -0,0 +1,1230 @@+#include <stdio.h>+#include <stdlib.h>+#include <stdint.h>+#include <string.h>++#include "ffijni.h"+#include "jni.h"++#if defined(FFIJNI_LINUX) || defined(FFIJNI_MACOSX)+#include <dlfcn.h>+#else+#if defined(FFIJNI_WINDOWS)+#include <windows.h>+#endif+#endif++#define FFIJNI_VERSION JNI_VERSION_1_6++#ifdef FFIJNI_DEBUG /* def FFIJNI_DEBUG */++static jboolean+_ffijni_debug = JNI_FALSE;++jboolean+getDebugStatus()+{+ return _ffijni_debug;+}++void+setDebugStatus(jboolean status)+{+ _ffijni_debug = status;+}+#define DEBUG(STR) \+ if (_ffijni_debug) { \+ printf("ffijni: %s\n", STR); \+ }+#define DEBUG1(STR, ARG1) \+ if (_ffijni_debug) { \+ printf("ffijni: " STR "\n", ARG1); \+ fflush(stdout); \+ }+#define DEBUG2(STR, ARG1, ARG2) \+ if (_ffijni_debug) { \+ printf("ffijni: " STR "\n", ARG1, ARG2); \+ fflush(stdout); \+ }+#define DEBUG3(STR, ARG1, ARG2, ARG3) \+ if (_ffijni_debug) { \+ printf("ffijni: " STR "\n", ARG1, ARG2, ARG3); \+ fflush(stdout); \+ }+#define DEBUG4(STR, ARG1, ARG2, ARG3, ARG4) \+ if (_ffijni_debug) { \+ printf("ffijni: " STR "\n", ARG1, ARG2, ARG3, ARG4); \+ fflush(stdout); \+ }+#else /* def FFIJNI_DEBUG */+jboolean+getDebugStatus() { return JNI_FALSE; }++void+setDebugStatus(jboolean _state)+{+ fprintf(stderr,+ "ffijni: setDebugStatus(%s) was called, but this is not a debug build.\n"+ "ffijni: Use the DEBUG flag to enable a debug build.\n",+ _state ? "true" : "false");+}+#define DEBUG(STR)+#define DEBUG1(STR, ARG1)+#define DEBUG2(STR, ARG1, ARG2)+#define DEBUG3(STR, ARG1, ARG2, ARG3)+#define DEBUG4(STR, ARG1, ARG2, ARG3, ARG4)+#endif /* def FFIJNI_DEBUG */++#define XSTR(s) STR(s)+#define STR(s) #s++#define GLOBAL_REF(VMI, LOCAL, GLOBAL) \+ jobject GLOBAL; \+ if (LOCAL == NULL) { \+ GLOBAL = NULL; \+ } else { \+ GLOBAL = (*VMI->env)->NewGlobalRef(VMI->env, LOCAL); \+ (*VMI->env)->DeleteLocalRef(VMI->env, LOCAL); \+ } \+ DEBUG2("-> new global ref from local: %p -> %p", LOCAL, GLOBAL)++#ifdef FFIJNI_OSX_FRAMEWORK /* def FFIJNI_OSX_FRAMEWORK */++#define GET_CREATED_JAVA_VMS(a, b, c) JNI_GetCreatedJavaVMs(a, b, c)+#define CREATE_JAVA_VM(a, b, c) JNI_CreateJavaVM(a, b, c)++void+setLibjvmPath(char* path) {}++char*+getLibjvmPath() { return "Linked with JavaVM Framework at compile time."; }++char*+getCompiledLibjvmPath() { return "Linked with JavaVM Framework at compile time."; }++#else /* def FFIJNI_OSX_FRAMEWORK */++#ifndef FFIJNI_LIBJVM+#error "Please specify -DFFIJNI_LIBJVM=<path-to-libjvm>."+#endif++#define GET_CREATED_JAVA_VMS(a, b, c) _GetCreatedJavaVMs(a, b, c)+#define CREATE_JAVA_VM(a, b, c) _CreateJavaVM(a, b, c)++static+jint (*_GetCreatedJavaVMs) (JavaVM** vmBuf, jsize bufLen, jsize* nVMs) = NULL;++static+jint (*_CreateJavaVM) (JavaVM** pvm, void** penv, void* vmargs) = NULL;++static+char* _libjvm_path = NULL;++void+setLibjvmPath(char* path)+{+ _libjvm_path = path;+}++char*+getLibjvmPath()+{+ return _libjvm_path;+}++char*+getCompiledLibjvmPath()+{+ return XSTR(FFIJNI_LIBJVM);+}++jint+_load_JNI()+{+ if (!_GetCreatedJavaVMs) {+ if (!_libjvm_path) {+ /* The location of libjvm can be overriden by the+ * environment variable FFIJNI_LIBJVM. */+ _libjvm_path = getenv("FFIJNI_LIBJVM");+ }+ if (!_libjvm_path) {+ /* If no such environment variable exists, use the built in+ * location (needs to be given at compile time) */+ _libjvm_path = XSTR(FFIJNI_LIBJVM);+ }+ DEBUG1("Loading libjvm from %s.", _libjvm_path)+ #if defined(FFIJNI_LINUX) || defined(FFIJNI_MACOSX)+ /* On Linux and MacOSX use dlopen(...) to manually+ * load the dynamic library. */+ void* libVM = dlopen(_libjvm_path, RTLD_LAZY);+ if (!libVM) {+ return -41;+ }+ _GetCreatedJavaVMs = (jint (*)(JavaVM**,jsize,jsize*)) dlsym(libVM, "JNI_GetCreatedJavaVMs");+ _CreateJavaVM = (jint (*)(JavaVM**,void**,void*)) dlsym(libVM, "JNI_CreateJavaVM");+ #else+ #if defined(FFIJNI_WINDOWS)+ /* On Windows use LoadLibrary(...) to manually+ * load the dynamic library. */+ HINSTANCE hVM = LoadLibrary(_libjvm_path);+ if (!hVM) {+ return -41;+ }+ _GetCreatedJavaVMs = (jint (*)(JavaVM**,jsize,jsize*)) GetProcAddress(hVM, "JNI_GetCreatedJavaVMs");+ _CreateJavaVM = (jint (*)(JavaVM**,void**,void*)) GetProcAddress(hVM, "JNI_CreateJavaVM");+ #else+ #error "Unsupported platform."+ #endif+ #endif+ }+ return 0;+}+#endif /* def FFIJNI_OSX_FRAMEWORK */+++void+runCocoaMain()+{+ #if defined(FFIJNI_MACOSX) && defined(FFIJNI_OSX_GUI)+ DEBUG("Retrieving NSApp...")+ void* clazz = objc_getClass("NSApplication");+ void* app = objc_msgSend(clazz, sel_registerName("sharedApplication"));++ DEBUG1("-> %p", app)++ DEBUG("Starting cocoa main runloop")+ objc_msgSend(app, sel_registerName("run"));+ #endif+}+++jobject JNICALL+_callCallback(JNIEnv* env, jobject self, jlong func, jobject method, jobjectArray args)+{+ WrappedFun funPtr = (WrappedFun) (intptr_t) func;+ DEBUG3("Callback called (func: %d -> %p, method: %p)\m", func, funPtr, method)+ vm_t vmi;+ vmi.env = env;+ (*env)->GetJavaVM(env, &vmi.vm);+ return funPtr(&vmi, self, method, args);+}+++void JNICALL+_releaseCallback(JNIEnv* env, jobject self, jlong func)+{+ WrappedFun funPtr = (WrappedFun) (intptr_t) func;+ DEBUG2("Callback released (func: %d -> %p)", func, funPtr)+ freeFunPtr(funPtr);+}+++void+_loadHFunctionClass(JNIEnv* env)+{+ /* boilerplate:+ * - find java.lang.ClassLoader+ * - get #getSystemClassLoader+ * - get #defineClass+ * - retrieve the systemClassLoader+ */+ jclass clazz = (*env)->FindClass(env, "java/lang/ClassLoader");+ DEBUG1("Loaded java.lang.ClassLoader: %p", clazz)++ jmethodID getSystemClassLoader =+ (*env)->GetStaticMethodID(env, clazz, "getSystemClassLoader", "()Ljava/lang/ClassLoader;");+ DEBUG1("Got #getSystemClassLoader: %p", getSystemClassLoader)++ jmethodID defineClass =+ (*env)->GetMethodID(env, clazz, "defineClass", "(Ljava/lang/String;[BII)Ljava/lang/Class;");+ DEBUG1("Got #defineClass: %p", defineClass)++ jobject systemClassLoader = (*env)->CallStaticObjectMethod(env, clazz, getSystemClassLoader);+ DEBUG1("Retrieved systemClassLoader: %p", systemClassLoader)++ /* define the class:+ * - create the string className ("HFunction")+ * - create the jbyteArray bytes from hFunctionClass (see hfunction.h)+ * - call #defineClass on systemClassLoader+ */+ jstring className = (*env)->NewStringUTF(env, "HFunction");+ DEBUG1("Allocated className: %p", className)++ jbyteArray classBytes = (*env)->NewByteArray(env, FFIJNI_HFUNCTION_LENGTH);+ (*env)->SetByteArrayRegion(env, classBytes, 0, FFIJNI_HFUNCTION_LENGTH, hFunctionClass);+ DEBUG1("Allocated classBytes: %p", classBytes)++ jclass hFunction =+ (*env)->CallObjectMethod(env, systemClassLoader, defineClass,+ className, classBytes, 0, FFIJNI_HFUNCTION_LENGTH);+ DEBUG1("Defined class HFunction: %p", hFunction)+ + /* clean up */+ (*env)->DeleteLocalRef(env, systemClassLoader);+ (*env)->DeleteLocalRef(env, className);+ (*env)->DeleteLocalRef(env, classBytes);+ (*env)->DeleteLocalRef(env, hFunction);+}++jboolean+registerCallbacks(vm_t* vmi, jclass hFunction) {+ JNIEnv* env = vmi->env;++ JNINativeMethod method;+ jint result;++ /* register native call function */+ DEBUG1("Registering call(...): %p", _callCallback)++ method.name = "call";+ method.signature = "(JLjava/lang/reflect/Method;[Ljava/lang/Object;)Ljava/lang/Object;";+ method.fnPtr = _callCallback;++ result = (*env)->RegisterNatives(env, hFunction, &method, 1);+ if (result < 0) {+ (*env)->ExceptionDescribe(env);+ return JNI_FALSE;+ }+ + /* register native release function */+ DEBUG1("Registering release(...): %p", _releaseCallback)++ method.name = "release";+ method.signature = "(J)V";+ method.fnPtr = _releaseCallback;++ result = (*env)->RegisterNatives(env, hFunction, &method, 1);+ if (result < 0) {+ (*env)->ExceptionDescribe(env);+ return JNI_FALSE;+ }++ return JNI_TRUE;+}+++jint+_get_vm(JavaVM** jvm, unsigned int argc, char** argv)+{+ #ifndef FFIJNI_OSX_FRAMEWORK+ /* First things first: load the dynamic library+ * (this is not necessary if the library was linked with the+ * JavaVM framework on OSX, see OSX_FRAMEWORK flag / cabal file). */+ if (_load_JNI() < 0) {+ DEBUG("Could not load libjvm")+ return -41;+ }+ #endif++ jsize numCreatedVMs = 0;+ GET_CREATED_JAVA_VMS(jvm, 1, &numCreatedVMs);+ if (numCreatedVMs > 0) {+ DEBUG("JVM already created")+ return 1;+ }++ JNIEnv* env;+ JavaVMInitArgs vm_args;+ vm_args.version = FFIJNI_VERSION;+ vm_args.ignoreUnrecognized = JNI_FALSE;++ /* Create a new Virtual Machine: */+ JavaVMOption* options = calloc(argc, sizeof(JavaVMOption));+ if (argc == 0) {+ vm_args.nOptions = 0;+ } else {+ for (int i = 0; i < argc; i++) {+ options[i].optionString = argv[i];+ }+ vm_args.nOptions = argc;+ vm_args.options = options;+ }++ jint status;+ if ((status = CREATE_JAVA_VM(jvm, (void**) &env, &vm_args)) < 0) {+ /* Creation of Virtual Machine failed. */+ free(options);+ return status;+ }+ /* Creation of Virtual Machine was successfull. */+ free(options);++ _loadHFunctionClass(env);++ return 0;+}++vm_t*+createVM ()+{+ return createVM2(0, NULL);+}++vm_t*+createVM2 (unsigned int argc, char** argv)+{+ JavaVM* jvm;+ jint status = _get_vm(&jvm, argc, argv);++ if (status < 0) {+ return NULL;+ }+ JNIEnv* env;++ vm_t* vmi = malloc(sizeof(vm_t));+ vmi->attached = false;++ (*jvm)->GetEnv(jvm, (void**) &env, FFIJNI_VERSION);+ if (env == NULL) {+ DEBUG("Attach current thread")+ if ((*jvm)->AttachCurrentThread(jvm, (void**) &env, NULL) < 0) {+ free(vmi);+ return NULL;+ } else {+ vmi->attached = true;+ }+ }+ vmi->env = env;+ vmi->vm = jvm;++ return vmi;+}++void+destroyVM (vm_t* vmi)+{+ if (vmi->attached) {+ DEBUG("Detach current thread")+ (*vmi->vm)->DetachCurrentThread(vmi->vm);+ } else {+ DEBUG("Destroy Java VM")+ (*vmi->vm)->DestroyJavaVM(vmi->vm);+ }+ free(vmi);+}++void+persistVM (vm_t* vmi)+{+ DEBUG("persistVM()")++ vmi->attached = true;+}++jclass+findClass (vm_t* vmi, const char* className)+{+ DEBUG1("findClass(%s)", className)++ jclass clazzLocal = (*vmi->env)->FindClass(vmi->env, className);+ GLOBAL_REF(vmi, clazzLocal, clazz)+ return clazz;+}++jobject+newObject (vm_t* vmi, jclass clazz, jmethodID constructor, jvalue* args)+{+ DEBUG2("newObject(%p, %p)", clazz, constructor)+ jobject objLocal = (*vmi->env)->NewObjectA(vmi->env, clazz, constructor, args);+ GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++jmethodID+getConstructorID (vm_t* vmi, jclass clazz, const char* sig)+{+ DEBUG1("getConstructorID(%s)", sig)+ jmethodID methodID = (*vmi->env)->GetMethodID(vmi->env, clazz, "<init>", sig);+ DEBUG1("-> %p", methodID)+ return methodID;+}++jmethodID+getStaticMethodID(vm_t* vmi, jclass clazz, const char* methodName, const char* sig)+{+ DEBUG2("getStaticMethodID(%s, %s)", methodName, sig)+ jmethodID methodID = (*vmi->env)->GetStaticMethodID(vmi->env, clazz, methodName, sig);+ DEBUG1("-> %p", methodID)+ return methodID;+}++jmethodID+getMethodID(vm_t* vmi, jclass clazz, const char* methodName, const char* sig)+{+ DEBUG2("getMethodID(%s, %s)", methodName, sig)+ jmethodID methodID = (*vmi->env)->GetMethodID(vmi->env, clazz, methodName, sig);+ DEBUG1("-> %p", methodID)+ return methodID;+}++jfieldID+getStaticFieldID(vm_t* vmi, jclass clazz, const char* fieldName, const char* sig)+{+ DEBUG2("getStaticFieldID(%s, %s)", fieldName, sig)++ return (*vmi->env)->GetStaticFieldID(vmi->env, clazz, fieldName, sig);+}++jfieldID+getFieldID(vm_t* vmi, jclass clazz, const char* fieldName, const char* sig)+{+ DEBUG2("getFieldID(%s, %s)", fieldName, sig)++ return (*vmi->env)->GetFieldID(vmi->env, clazz, fieldName, sig);+}++void+callStaticVoidMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticVoidMethod(%p, %p)", clazz, method)++ (*vmi->env)->CallStaticVoidMethodA(vmi->env, clazz, method, args);+}++jint+callStaticIntMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticIntMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticIntMethodA(vmi->env, clazz, method, args);+}++jlong+callStaticLongMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticLongMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticLongMethodA(vmi->env, clazz, method, args);+}++jshort+callStaticShortMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticShortMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticShortMethodA(vmi->env, clazz, method, args);+}++jbyte+callStaticByteMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticVoidMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticByteMethodA(vmi->env, clazz, method, args);+}++jfloat+callStaticFloatMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticFloatMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticFloatMethodA(vmi->env, clazz, method, args);+}++jdouble+callStaticDoubleMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticVoidMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticDoubleMethodA(vmi->env, clazz, method, args);+}++jboolean+callStaticBooleanMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticBooleanMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticBooleanMethodA(vmi->env, clazz, method, args);+}++jchar+callStaticCharMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticCharMethod(%p, %p)", clazz, method)++ return (*vmi->env)->CallStaticCharMethodA(vmi->env, clazz, method, args);+}++jobject+callStaticObjectMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticObjectMethod(%p, %p)", clazz, method)++ jobject objLocal = (*vmi->env)->CallStaticObjectMethodA(vmi->env, clazz, method, args);+ GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++const char*+callStaticStringMethod (vm_t* vmi, jclass clazz, jmethodID method, jvalue* args)+{+ DEBUG2("callStaticStringMethod(%p, %p)", clazz, method)++ jobject string = (*vmi->env)->CallStaticObjectMethodA(vmi->env, clazz, method, args);+ if (string) {+ const char* cstring = jStringToCString(vmi, string);+ (*vmi->env)->DeleteLocalRef(vmi->env, string);+ return cstring;+ } else {+ return NULL;+ }+}++void+callVoidMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callVoidMethod(%p, %p)", object, method)++ (*vmi->env)->CallVoidMethodA(vmi->env, object, method, args);+}++jlong+callLongMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callLongMethod(%p, %p)", object, method)++ return (*vmi->env)->CallLongMethodA(vmi->env, object, method, args);+}++jint+callIntMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callIntMethod(%p, %p)", object, method)+ + return (*vmi->env)->CallIntMethodA(vmi->env, object, method, args);+}++jshort+callShortMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callShortMethod(%p, %p)", object, method)++ return (*vmi->env)->CallShortMethodA(vmi->env, object, method, args);+}++jbyte+callByteMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callByteMethod(%p, %p)", object, method)++ return (*vmi->env)->CallByteMethodA(vmi->env, object, method, args);+}++jfloat+callFloatMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callFloatMethod(%p, %p)", object, method)++ return (*vmi->env)->CallFloatMethodA(vmi->env, object, method, args);+}++jdouble+callDoubleMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callDoubleMethod(%p, %p)", object, method)++ return (*vmi->env)->CallDoubleMethodA(vmi->env, object, method, args);+}++jboolean+callBooleanMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callBooleanMethod(%p, %p)", object, method)++ return (*vmi->env)->CallBooleanMethodA(vmi->env, object, method, args);+}++jchar+callCharMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callCharMethod(%p, %p)", object, method)++ return (*vmi->env)->CallCharMethodA(vmi->env, object, method, args);+}++jobject+callObjectMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callObjectMethod(%p, %p)", object, method)++ jobject objLocal = (*vmi->env)->CallObjectMethodA(vmi->env, object, method, args);+ GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++const char*+callStringMethod (vm_t* vmi, jobject object, jmethodID method, jvalue* args)+{+ DEBUG2("callStringMethod(%p, %p)", object, method)++ jobject string = (*vmi->env)->CallObjectMethodA(vmi->env, object, method, args);+ if (string) {+ const char* cstring = jStringToCString(vmi, string);+ (*vmi->env)->DeleteLocalRef(vmi->env, string);+ return cstring;+ } else {+ return NULL;+ }+}++jlong+getStaticLongField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticLongField(vmi->env, clazz, field);+}++jint+getStaticIntField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticIntField(vmi->env, clazz, field);+}++jshort+getStaticShortField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticShortField(vmi->env, clazz, field);+}++jbyte+getStaticByteField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticByteField(vmi->env, clazz, field);+}++jfloat+getStaticFloatField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticFloatField(vmi->env, clazz, field);+}++jdouble+getStaticDoubleField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticDoubleField(vmi->env, clazz, field);+}++jboolean+getStaticBooleanField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticBooleanField(vmi->env, clazz, field);+}++jchar+getStaticCharField (vm_t* vmi, jclass clazz, jfieldID field)+{+ return (*vmi->env)->GetStaticCharField(vmi->env, clazz, field);+}++jobject+getStaticObjectField (vm_t* vmi, jclass clazz, jfieldID field)+{+ jobject objLocal = (*vmi->env)->GetStaticObjectField(vmi->env, clazz, field);+ GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++const char*+getStaticStringField (vm_t* vmi, jclass clazz, jfieldID field)+{+ jobject string = (*vmi->env)->GetStaticObjectField(vmi->env, clazz, field);+ return jStringToCString(vmi, string);+}++jlong+getLongField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetLongField(vmi->env, object, field);+}++jint+getIntField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetIntField(vmi->env, object, field);+}++jshort+getShortField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetShortField(vmi->env, object, field);+}++jbyte+getByteField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetByteField(vmi->env, object, field);+}++jfloat+getFloatField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetFloatField(vmi->env, object, field);+}++jdouble+getDoubleField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetDoubleField(vmi->env, object, field);+}++jboolean+getBooleanField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetBooleanField(vmi->env, object, field);+}++jchar+getCharField (vm_t* vmi, jobject object, jfieldID field)+{+ return (*vmi->env)->GetCharField(vmi->env, object, field);+}++jobject+getObjectField (vm_t* vmi, jobject object, jfieldID field)+{+ jobject objLocal = (*vmi->env)->GetObjectField(vmi->env, object, field);+ + GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++const char*+getStringField (vm_t* vmi, jobject object, jfieldID field)+{+ jobject string = (*vmi->env)->GetObjectField(vmi->env, object, field);+ const char* cstring = jStringToCString(vmi, string);+ (*vmi->env)->DeleteLocalRef(vmi->env, string);+ return cstring;+}++void+setStaticLongField (vm_t* vmi, jclass clazz, jfieldID field, jlong value)+{+ (*vmi->env)->SetStaticLongField(vmi->env, clazz, field, value);+}++void+setStaticIntField (vm_t* vmi, jclass clazz, jfieldID field, jint value)+{+ (*vmi->env)->SetStaticIntField(vmi->env, clazz, field, value);+}++void+setStaticShortField (vm_t* vmi, jclass clazz, jfieldID field, jshort value)+{+ (*vmi->env)->SetStaticShortField(vmi->env, clazz, field, value);+}++void+setStaticByteField (vm_t* vmi, jclass clazz, jfieldID field, jbyte value)+{+ (*vmi->env)->SetStaticByteField(vmi->env, clazz, field, value);+}++void+setStaticFloatField (vm_t* vmi, jclass clazz, jfieldID field, jfloat value)+{+ (*vmi->env)->SetStaticFloatField(vmi->env, clazz, field, value);+}++void+setStaticDoubleField (vm_t* vmi, jclass clazz, jfieldID field, jdouble value)+{+ (*vmi->env)->SetStaticDoubleField(vmi->env, clazz, field, value);+}++void+setStaticBooleanField (vm_t* vmi, jclass clazz, jfieldID field, jboolean value)+{+ (*vmi->env)->SetStaticBooleanField(vmi->env, clazz, field, value);+}++void+setStaticCharField (vm_t* vmi, jclass clazz, jfieldID field, jchar value)+{+ (*vmi->env)->SetStaticCharField(vmi->env, clazz, field, value);+}++void+setStaticObjectField (vm_t* vmi, jclass clazz, jfieldID field, jobject value)+{+ (*vmi->env)->SetStaticObjectField(vmi->env, clazz, field, value);+}++void+setStaticStringField (vm_t* vmi, jclass clazz, jfieldID field, const char* value)+{+ jstring string = (*vmi->env)->NewStringUTF(vmi->env, value);+ (*vmi->env)->SetStaticObjectField(vmi->env, clazz, field, string);+}++void+setLongField (vm_t* vmi, jobject object, jfieldID field, jlong value)+{+ (*vmi->env)->SetLongField(vmi->env, object, field, value);+}++void+setIntField (vm_t* vmi, jobject object, jfieldID field, jint value)+{+ (*vmi->env)->SetIntField(vmi->env, object, field, value);+}++void+setShortField (vm_t* vmi, jobject object, jfieldID field, jshort value)+{+ (*vmi->env)->SetShortField(vmi->env, object, field, value);+}++void+setByteField (vm_t* vmi, jobject object, jfieldID field, jbyte value)+{+ (*vmi->env)->SetByteField(vmi->env, object, field, value);+}++void+setFloatField (vm_t* vmi, jobject object, jfieldID field, jfloat value)+{+ (*vmi->env)->SetFloatField(vmi->env, object, field, value);+}++void+setDoubleField (vm_t* vmi, jobject object, jfieldID field, jdouble value)+{+ (*vmi->env)->SetDoubleField(vmi->env, object, field, value);+}++void+setBooleanField (vm_t* vmi, jobject object, jfieldID field, jboolean value)+{+ (*vmi->env)->SetBooleanField(vmi->env, object, field, value);+}++void+setCharField (vm_t* vmi, jobject object, jfieldID field, jchar value)+{+ (*vmi->env)->SetCharField(vmi->env, object, field, value);+}++void+setObjectField (vm_t* vmi, jobject object, jfieldID field, jobject value)+{+ (*vmi->env)->SetObjectField(vmi->env, object, field, value);+}++void+setStringField (vm_t* vmi, jobject object, jfieldID field, const char* value)+{+ jstring string = (*vmi->env)->NewStringUTF(vmi->env, value);+ (*vmi->env)->SetObjectField(vmi->env, object, field, string);+}++jvalue*+newJValues (int size)+{+ jvalue* arrayPointer = calloc (size, sizeof(jvalue));+ return arrayPointer;+}++void+setJValueBoolean (jvalue* array, int ix, jboolean val)+{+ (array + ix)->z = val;+}++void+setJValueInt (jvalue* array, int ix, jint val)+{+ (array + ix)->i = val;+}++void+setJValueLong (jvalue* array, int ix, jlong val)+{+ (array + ix)->j = val;+}++void+setJValueShort (jvalue* array, int ix, jshort val)+{+ (array + ix)->s = val;+}++void+setJValueByte (jvalue* array, int ix, jbyte val)+{+ (array + ix)->b = val;+}++void+setJValueFloat (jvalue* array, int ix, jfloat val)+{+ (array + ix)->f = val;+}++void+setJValueDouble (jvalue* array, int ix, jdouble val)+{+ (array + ix)->d = val;+}++void+setJValueChar (jvalue* array, int ix, jchar val)+{+ (array + ix)->c = val;+}++void+setJValueString (vm_t* vmi, jvalue* array, int ix, const char* string)+{+ jstring jstr = (*vmi->env)->NewStringUTF(vmi->env, string);+ (array + ix)->l = jstr;+}++void+setJValueObject (jvalue* array, int ix, jobject object)+{+ (array + ix)->l = object;+}++jarray+newBooleanArray (vm_t* vmi, jsize size)+{+ DEBUG1("newBooleanArray(%d)", size)++ return (*vmi->env)->NewBooleanArray(vmi->env, size);+}++jarray+newLongArray (vm_t* vmi, jsize size)+{+ DEBUG1("newLongArray(%d)", size)++ return (*vmi->env)->NewLongArray(vmi->env, size);+}++jarray+newIntArray (vm_t* vmi, jsize size)+{+ DEBUG1("newIntArray(%d)", size)++ return (*vmi->env)->NewIntArray(vmi->env, size);+}++jarray+newShortArray (vm_t* vmi, jsize size)+{+ DEBUG1("newShortArray(%d)", size)++ return (*vmi->env)->NewShortArray(vmi->env, size);+}++jarray+newByteArray (vm_t* vmi, jsize size)+{+ DEBUG1("newByteArray(%d)", size)++ return (*vmi->env)->NewByteArray(vmi->env, size);+}++jarray+newFloatArray (vm_t* vmi, jsize size)+{+ DEBUG1("newFloatArray(%d)", size)++ return (*vmi->env)->NewFloatArray(vmi->env, size);+}++jarray+newDoubleArray (vm_t* vmi, jsize size)+{+ DEBUG1("newDoubleArray(%d)", size)++ return (*vmi->env)->NewDoubleArray(vmi->env, size);+}++jarray+newCharArray (vm_t* vmi, jsize size)+{+ DEBUG1("newCharArray(%d)", size)++ return (*vmi->env)->NewCharArray(vmi->env, size);+}++jarray+newObjectArray (vm_t* vmi, jsize size, jclass elementType)+{+ DEBUG2("newObjectArray(%d, %p)", size, elementType)++ return (*vmi->env)->NewObjectArray(vmi->env, size, elementType, NULL);+}++jobject+newJString (vm_t* vmi, const char* string)+{+ DEBUG1("newJString(\"%s\")", string)++ return (*vmi->env)->NewStringUTF(vmi->env, string);+}++jint+getArrayLength (vm_t* vmi, jobject array)+{+ jint length = (*vmi->env)->GetArrayLength(vmi->env, array);+ DEBUG2("getArrayLength(%p) -> %i", array, length)+ return length;+}++jclass+getObjectClass (vm_t* vmi, jobject object)+{+ DEBUG1("getObjectClass(%p)", object)++ jobject objLocal = (*vmi->env)->GetObjectClass(vmi->env, object);+ GLOBAL_REF(vmi, objLocal, obj)+ return obj;+}++jboolean+isInstanceOf (vm_t* vmi, jobject object, jclass clazz)+{+ DEBUG2("isInstanceOf(%p, %p)", object, clazz)++ return (*vmi->env)->IsInstanceOf(vmi->env, object, clazz);+}++const jchar*+charsFromJString (vm_t* vmi, jobject string)+{+ DEBUG1("charsFromString(%p)", string)+ const jchar* chars = (*vmi->env)->GetStringChars(vmi->env, string, NULL);+ DEBUG1("-> %p", chars)+ return chars;+}++const char*+bytesFromJString (vm_t* vmi, jobject string)+{+ DEBUG1("bytesFromString(%p)", string)+ const char* bytes = (*vmi->env)->GetStringUTFChars(vmi->env, string, NULL);+ DEBUG1("-> %p", bytes)+ return bytes;+}++void+releaseJChars (vm_t* vmi, jobject string, const jchar* chars)+{+ DEBUG2("releaseJChars(%p, %p)", string, chars)+ (*vmi->env)->ReleaseStringChars(vmi->env, string, chars);+}++void+releaseJBytes (vm_t* vmi, jobject string, const char* bytes)+{+ DEBUG2("releaseJBytes(%p, %p)", string, bytes)+ (*vmi->env)->ReleaseStringUTFChars(vmi->env, string, bytes);+}++const char*+jStringToCString (vm_t* vmi, jobject string)+{+ if (string == NULL) {+ return NULL;+ }+ jsize length = (*vmi->env)->GetStringUTFLength(vmi->env, string);+ const char* bytes = (*vmi->env)->GetStringUTFChars(vmi->env, string, NULL);+ char* cstring = malloc(length + 1);+ memcpy(cstring, bytes, length);+ cstring[length] = '\0';+ (*vmi->env)->ReleaseStringUTFChars(vmi->env, string, bytes);+ return cstring;+}++jboolean+exceptionCheck (vm_t* vmi)+{+ return (*vmi->env)->ExceptionCheck(vmi->env);+}++void+exceptionClear (vm_t* vmi)+{+ (*vmi->env)->ExceptionClear(vmi->env);+}++void+exceptionDescribe (vm_t* vmi)+{+ (*vmi->env)->ExceptionDescribe(vmi->env);+}++jthrowable+exceptionOccurred (vm_t* vmi)+{+ jthrowable exc = (*vmi->env)->ExceptionOccurred(vmi->env);+ DEBUG1("exceptionOccurred() -> %p", exc)+ return exc;+}++jthrowable+exceptionOccurredClear (vm_t* vmi)+{+ jthrowable excLocal = (*vmi->env)->ExceptionOccurred(vmi->env);+ DEBUG1("exceptionOccurredClear() -> %p", excLocal)+ if (excLocal) {+ (*vmi->env)->ExceptionClear(vmi->env);+ GLOBAL_REF(vmi, excLocal, exc)+ return exc;+ } else {+ return NULL;+ }+}++void+releaseJObjectRef (vm_t* vmi, jobject obj)+{+ (*vmi->env)->DeleteGlobalRef(vmi->env, obj);+}++void+releaseJClassRef (vm_t* vmi, jclass obj)+{+ (*vmi->env)->DeleteGlobalRef(vmi->env, obj);+}++void+releaseJThrowableRef (vm_t* vmi, jthrowable obj)+{+ (*vmi->env)->DeleteGlobalRef(vmi->env, obj);+}++void+release (jobject obj)+{+ JavaVM* jvm;+ jsize numCreatedVMs = 0;++ GET_CREATED_JAVA_VMS(&jvm, 1, &numCreatedVMs);+ if (numCreatedVMs == 1) {+ JNIEnv* env;+ if ((*jvm)->GetEnv(jvm, (void**) &env, FFIJNI_VERSION) == JNI_OK) {+ DEBUG1("release(%p)\n", (void*) obj)+ (*env)->DeleteGlobalRef(env, obj);+ }+ } else if (numCreatedVMs > 1) {+ fprintf(stderr, "THE IMPOSSIBLE HAPPENED - This should not have happend.\n"+ "Somehow more than one JVM was created.\n"+ "Please report this as a bug.\n");+ fflush(stderr);+ } else {+ DEBUG1("release(%p) - already shut down", (void*) obj)+ /* This is not an error, since the virtual machine+ * has already been teared down and no objects are+ * alive anymore - therefor nothing has to be freed+ * anymore (nor can it be).+ */+ }+}++++
+ src/ffijni.h view
@@ -0,0 +1,378 @@+#ifndef FFIJNI_H_+#define FFIJNI_H_++#include "jni.h"+#include <stdint.h>+#include <stdbool.h>++#if defined(FFIJNI_MACOSX) && defined(FFIJNI_OSX_GUI)+#include <objc/objc-runtime.h>+#endif+++struct vm {+ JNIEnv* env;+ JavaVM* vm;+ bool attached;+};+typedef struct vm vm_t;++typedef jobject (*WrappedFun) (vm_t*, jobject, jobject, jobjectArray);++/* This is taken from HsFFI.h */+typedef void (*HsFunPtr)(void);++extern void freeFunPtr(WrappedFun);++void+setLibjvmPath (char*);++char*+getLibjvmPath ();++char*+getCompiledLibjvmPath();++jboolean+registerCallbacks (vm_t*, jclass);++vm_t*+createVM ();++vm_t*+createVM2 (unsigned int argc, char** argv);++void+destroyVM (vm_t*);++void+persistVM (vm_t*);++jclass+findClass (vm_t*, const char*);++jobject+newObject (vm_t*, jclass, jmethodID, jvalue*);++jmethodID+getConstructorID (vm_t*, jclass, const char*);++jmethodID+getStaticMethodID (vm_t*, jclass, const char*, const char*);++jmethodID+getMethodID (vm_t*, jclass, const char*, const char*);++jfieldID+getStaticFieldID (vm_t*, jclass, const char*, const char*);++jfieldID+getFieldID (vm_t*, jclass, const char*, const char*);++void+callStaticVoidMethod (vm_t*, jclass, jmethodID, jvalue*);++jint+callStaticIntMethod (vm_t*, jclass, jmethodID, jvalue*);++jlong+callStaticLongMethod (vm_t*, jclass, jmethodID, jvalue*);++jshort+callStaticShortMethod (vm_t*, jclass, jmethodID, jvalue*);++jbyte+callStaticByteMethod (vm_t*, jclass, jmethodID, jvalue*);++jfloat+callStaticFloatMethod (vm_t*, jclass, jmethodID, jvalue*);++jdouble+callStaticDoubleMethod (vm_t*, jclass, jmethodID, jvalue*);++jboolean+callStaticBooleanMethod (vm_t*, jclass, jmethodID, jvalue*);++jchar+callStaticCharMethod (vm_t*, jclass, jmethodID, jvalue*);++jobject+callStaticObjectMethod (vm_t*, jclass, jmethodID, jvalue*);++const char*+callStaticStringMethod (vm_t*, jclass, jmethodID, jvalue*);++void+callVoidMethod (vm_t*, jobject, jmethodID, jvalue*);++jlong+callLongMethod (vm_t*, jobject, jmethodID, jvalue*);++jint+callIntMethod (vm_t*, jobject, jmethodID, jvalue*);++jshort+callShortMethod (vm_t*, jobject, jmethodID, jvalue*);++jbyte+callByteMethod (vm_t*, jobject, jmethodID, jvalue*);++jfloat+callFloatMethod (vm_t*, jobject, jmethodID, jvalue*);++jdouble+callDoubleMethod (vm_t*, jobject, jmethodID, jvalue*);++jboolean+callBooleanMethod (vm_t*, jobject, jmethodID, jvalue*);++jchar+callCharMethod (vm_t*, jobject, jmethodID, jvalue*);++jobject+callObjectMethod (vm_t*, jobject, jmethodID, jvalue*);++const char*+callStringMethod(vm_t*, jobject, jmethodID, jvalue*);++jlong+getStaticLongField (vm_t*, jclass, jfieldID);++jint+getStaticIntField (vm_t*, jclass, jfieldID);++jshort+getStaticShortField (vm_t*, jclass, jfieldID);++jbyte+getStaticByteField (vm_t*, jclass, jfieldID);++jfloat+getStaticFloatField (vm_t*, jclass, jfieldID);++jdouble+getStaticDoubleField (vm_t*, jclass, jfieldID);++jboolean+getStaticBooleanField (vm_t*, jclass, jfieldID);++jchar+getStaticCharField (vm_t*, jclass, jfieldID);++jobject+getStaticObjectField (vm_t*, jclass, jfieldID);++const char*+getStaticStringField (vm_t*, jclass, jfieldID);++jlong+getLongField (vm_t*, jobject, jfieldID);++jint+getIntField (vm_t*, jobject, jfieldID);++jshort+getShortField (vm_t*, jobject, jfieldID);++jbyte+getByteField (vm_t*, jobject, jfieldID);++jfloat+getFloatField (vm_t*, jobject, jfieldID);++jdouble+getDoubleField (vm_t*, jobject, jfieldID);++jboolean+getBooleanField (vm_t*, jobject, jfieldID);++jchar+getCharField (vm_t*, jobject, jfieldID);++jobject+getObjectField (vm_t*, jobject, jfieldID);++const char*+getStringField (vm_t*, jobject, jfieldID);++void+setStaticLongField (vm_t*, jclass, jfieldID, jlong);++void+setStaticIntField (vm_t*, jclass, jfieldID, jint);++void+setStaticShortField (vm_t*, jclass, jfieldID, jshort);++void+setStaticByteField (vm_t*, jclass, jfieldID, jbyte);++void+setStaticFloatField (vm_t*, jclass, jfieldID, jfloat);++void+setStaticDoubleField (vm_t*, jclass, jfieldID, jdouble);++void+setStaticBooleanField (vm_t*, jclass, jfieldID, jboolean);++void+setStaticCharField (vm_t*, jclass, jfieldID, jchar);++void+setStaticObjectField (vm_t*, jclass, jfieldID, jobject);++void+setStaticStringField (vm_t*, jclass, jfieldID, const char*);++void+setLongField (vm_t*, jobject, jfieldID, jlong);++void+setIntField (vm_t*, jobject, jfieldID, jint);++void+setShortField (vm_t*, jobject, jfieldID, jshort);++void+setByteField (vm_t*, jobject, jfieldID, jbyte);++void+setFloatField (vm_t*, jobject, jfieldID, jfloat);++void+setDoubleField (vm_t*, jobject, jfieldID, jdouble);++void+setBooleanField (vm_t*, jobject, jfieldID, jboolean);++void+setCharField (vm_t*, jobject, jfieldID, jchar);++void+setObjectField (vm_t*, jobject, jfieldID, jobject);++void+setStringField (vm_t*, jclass, jfieldID, const char*);++jvalue*+newJValues (int);++void+setJValueBoolean (jvalue*, int, jboolean);++void+setJValueLong (jvalue*, int, jlong);++void+setJValueInt (jvalue*, int, jint);++void+setJValueShort (jvalue*, int, jshort);++void+setJValueByte (jvalue*, int, jbyte);++void+setJValueFloat (jvalue*, int, jfloat);++void+setJValueDouble (jvalue*, int, jdouble);++void+setJValueChar (jvalue*, int, jchar);++void+setJValueString (vm_t*, jvalue*, int, const char*);++void+setJValueObject (jvalue*, int, jobject);++jarray+newBooleanArray (vm_t*, jsize);++jarray+newLongArray (vm_t*, jsize);++jarray+newIntArray (vm_t*, jsize);++jarray+newShortArray (vm_t*, jsize);++jarray+newByteArray (vm_t*, jsize);++jarray+newFloatArray (vm_t*, jsize);++jarray+newDoubleArray (vm_t*, jsize);++jarray+newCharArray (vm_t*, jsize);++jarray+newObjectArray (vm_t*, jsize, jclass);++jobject+newJString (vm_t*, const char*);++const jchar*+charsFromJString (vm_t*, jobject);++jint+getArrayLength(vm_t*, jobject);++jclass+getObjectClass(vm_t*, jobject);++jboolean+isInstanceOf(vm_t*, jobject, jclass);++const char*+bytesFromJString (vm_t*, jobject);++void+releaseJChars (vm_t*, jobject, const jchar*);++void+releaseJBytes (vm_t*, jobject, const char*);++const char*+jStringToCString (vm_t*, jobject);++jboolean+exceptionCheck (vm_t*);++void+exceptionClear (vm_t*);++void+exceptionDescribe (vm_t*);++jthrowable+exceptionOccurred (vm_t*);++jthrowable+exceptionOccurredClear (vm_t*);++void+releaseJObjectRef (vm_t*, jobject);++void+releaseJClassRef (vm_t*, jclass);++void+releaseJThrowableRef (vm_t*, jthrowable);++void+release (jobject);++void+runCocoaMain ();++#include "hfunction.h"++#endif /* FFIJNI_H_ */+
+ src/hfunction.h view
@@ -0,0 +1,72 @@++#define FFIJNI_HFUNCTION_LENGTH 1057++static jbyte hFunctionClass[FFIJNI_HFUNCTION_LENGTH] = {+ -54, -2, -70, -66, 0, 0, 0, 50, 0, 48, 10, 0, 10, 0, 31, 9, + 0, 5, 0, 32, 10, 0, 5, 0, 33, 10, 0, 5, 0, 34, 7, 0, + 35, 10, 0, 5, 0, 36, 10, 0, 8, 0, 37, 7, 0, 38, 10, 0, + 39, 0, 40, 7, 0, 41, 7, 0, 42, 1, 0, 9, 104, 70, 117, 110, + 99, 116, 105, 111, 110, 1, 0, 1, 74, 1, 0, 7, 114, 101, 108, 101, + 97, 115, 101, 1, 0, 4, 40, 74, 41, 86, 1, 0, 4, 99, 97, 108, + 108, 1, 0, 66, 40, 74, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, + 47, 114, 101, 102, 108, 101, 99, 116, 47, 77, 101, 116, 104, 111, 100, 59, + 91, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 79, 98, 106, 101, + 99, 116, 59, 41, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 79, + 98, 106, 101, 99, 116, 59, 1, 0, 6, 60, 105, 110, 105, 116, 62, 1, + 0, 4, 67, 111, 100, 101, 1, 0, 15, 76, 105, 110, 101, 78, 117, 109, + 98, 101, 114, 84, 97, 98, 108, 101, 1, 0, 6, 105, 110, 118, 111, 107, + 101, 1, 0, 83, 40, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, + 79, 98, 106, 101, 99, 116, 59, 76, 106, 97, 118, 97, 47, 108, 97, 110, + 103, 47, 114, 101, 102, 108, 101, 99, 116, 47, 77, 101, 116, 104, 111, 100, + 59, 91, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 79, 98, 106, + 101, 99, 116, 59, 41, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, + 79, 98, 106, 101, 99, 116, 59, 1, 0, 8, 102, 105, 110, 97, 108, 105, + 122, 101, 1, 0, 3, 40, 41, 86, 1, 0, 12, 109, 97, 107, 101, 70, + 117, 110, 99, 116, 105, 111, 110, 1, 0, 38, 40, 76, 106, 97, 118, 97, + 47, 108, 97, 110, 103, 47, 67, 108, 97, 115, 115, 59, 74, 41, 76, 106, + 97, 118, 97, 47, 108, 97, 110, 103, 47, 79, 98, 106, 101, 99, 116, 59, + 1, 0, 9, 83, 105, 103, 110, 97, 116, 117, 114, 101, 1, 0, 50, 60, + 84, 58, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 79, 98, 106, + 101, 99, 116, 59, 62, 40, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, + 47, 67, 108, 97, 115, 115, 60, 84, 84, 59, 62, 59, 74, 41, 84, 84, + 59, 1, 0, 10, 83, 111, 117, 114, 99, 101, 70, 105, 108, 101, 1, 0, + 14, 72, 70, 117, 110, 99, 116, 105, 111, 110, 46, 106, 97, 118, 97, 12, + 0, 18, 0, 24, 12, 0, 12, 0, 13, 12, 0, 16, 0, 17, 12, 0, + 14, 0, 15, 1, 0, 9, 72, 70, 117, 110, 99, 116, 105, 111, 110, 12, + 0, 18, 0, 15, 12, 0, 43, 0, 44, 1, 0, 15, 106, 97, 118, 97, + 47, 108, 97, 110, 103, 47, 67, 108, 97, 115, 115, 7, 0, 45, 12, 0, + 46, 0, 47, 1, 0, 16, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, + 79, 98, 106, 101, 99, 116, 1, 0, 35, 106, 97, 118, 97, 47, 108, 97, + 110, 103, 47, 114, 101, 102, 108, 101, 99, 116, 47, 73, 110, 118, 111, 99, + 97, 116, 105, 111, 110, 72, 97, 110, 100, 108, 101, 114, 1, 0, 14, 103, + 101, 116, 67, 108, 97, 115, 115, 76, 111, 97, 100, 101, 114, 1, 0, 25, + 40, 41, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 67, 108, 97, + 115, 115, 76, 111, 97, 100, 101, 114, 59, 1, 0, 23, 106, 97, 118, 97, + 47, 108, 97, 110, 103, 47, 114, 101, 102, 108, 101, 99, 116, 47, 80, 114, + 111, 120, 121, 1, 0, 16, 110, 101, 119, 80, 114, 111, 120, 121, 73, 110, + 115, 116, 97, 110, 99, 101, 1, 0, 98, 40, 76, 106, 97, 118, 97, 47, + 108, 97, 110, 103, 47, 67, 108, 97, 115, 115, 76, 111, 97, 100, 101, 114, + 59, 91, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 67, 108, 97, + 115, 115, 59, 76, 106, 97, 118, 97, 47, 108, 97, 110, 103, 47, 114, 101, + 102, 108, 101, 99, 116, 47, 73, 110, 118, 111, 99, 97, 116, 105, 111, 110, + 72, 97, 110, 100, 108, 101, 114, 59, 41, 76, 106, 97, 118, 97, 47, 108, + 97, 110, 103, 47, 79, 98, 106, 101, 99, 116, 59, 0, 33, 0, 5, 0, + 10, 0, 1, 0, 11, 0, 1, 0, 18, 0, 12, 0, 13, 0, 0, 0, + 6, 1, 8, 0, 14, 0, 15, 0, 0, 1, 8, 0, 16, 0, 17, 0, + 0, 0, 1, 0, 18, 0, 15, 0, 1, 0, 19, 0, 0, 0, 42, 0, + 3, 0, 3, 0, 0, 0, 10, 42, -73, 0, 1, 42, 31, -75, 0, 2, + -79, 0, 0, 0, 1, 0, 20, 0, 0, 0, 14, 0, 3, 0, 0, 0, + 21, 0, 4, 0, 22, 0, 9, 0, 23, 0, 1, 0, 21, 0, 22, 0, + 1, 0, 19, 0, 0, 0, 34, 0, 4, 0, 4, 0, 0, 0, 10, 42, + -76, 0, 2, 44, 45, -72, 0, 3, -80, 0, 0, 0, 1, 0, 20, 0, + 0, 0, 6, 0, 1, 0, 0, 0, 26, 0, 4, 0, 23, 0, 24, 0, + 1, 0, 19, 0, 0, 0, 36, 0, 2, 0, 1, 0, 0, 0, 8, 42, + -76, 0, 2, -72, 0, 4, -79, 0, 0, 0, 1, 0, 20, 0, 0, 0, + 10, 0, 2, 0, 0, 0, 30, 0, 7, 0, 31, 0, 9, 0, 25, 0, + 26, 0, 2, 0, 19, 0, 0, 0, 54, 0, 5, 0, 4, 0, 0, 0, + 26, -69, 0, 5, 89, 31, -73, 0, 6, 78, 42, -74, 0, 7, 4, -67, + 0, 8, 89, 3, 42, 83, 45, -72, 0, 9, -80, 0, 0, 0, 1, 0, + 20, 0, 0, 0, 10, 0, 2, 0, 0, 0, 41, 0, 9, 0, 42, 0, + 27, 0, 0, 0, 2, 0, 28, 0, 1, 0, 29, 0, 0, 0, 2, 0, + 30+};