diff --git a/GetProperty.java b/GetProperty.java new file mode 100644 --- /dev/null +++ b/GetProperty.java @@ -0,0 +1,7 @@ +public class GetProperty { + public static void main(String... args) { + for (String arg : args) { + System.out.println(System.getProperty(arg)); + } + } +} diff --git a/HACKING.txt b/HACKING.txt new file mode 100644 --- /dev/null +++ b/HACKING.txt @@ -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. + + + + + diff --git a/HFunction.java b/HFunction.java new file mode 100644 --- /dev/null +++ b/HFunction.java @@ -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 makeFunction(Class iface, long func) { + InvocationHandler handler = new HFunction(func); + return (T) Proxy.newProxyInstance( + iface.getClassLoader(), + new Class[] { iface }, + handler); + } +} + + + diff --git a/ISSUES.txt b/ISSUES.txt new file mode 100644 --- /dev/null +++ b/ISSUES.txt @@ -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@. + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +java-bridge +=========== diff --git a/ReadClass.java b/ReadClass.java new file mode 100644 --- /dev/null +++ b/ReadClass.java @@ -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};"); + } +} + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -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 + diff --git a/dist/build/Foreign/Java.hs b/dist/build/Foreign/Java.hs new file mode 100644 --- /dev/null +++ b/dist/build/Foreign/Java.hs @@ -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. +-} + diff --git a/dist/build/Foreign/Java/Bindings.hs b/dist/build/Foreign/Java/Bindings.hs new file mode 100644 --- /dev/null +++ b/dist/build/Foreign/Java/Bindings.hs @@ -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 + + + diff --git a/dist/build/Foreign/Java/JNI/Safe.hs b/dist/build/Foreign/Java/JNI/Safe.hs new file mode 100644 --- /dev/null +++ b/dist/build/Foreign/Java/JNI/Safe.hs @@ -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 , +-- and ). +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 () + diff --git a/dist/build/Foreign/Java/JNI/Unsafe.hs b/dist/build/Foreign/Java/JNI/Unsafe.hs new file mode 100644 --- /dev/null +++ b/dist/build/Foreign/Java/JNI/Unsafe.hs @@ -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 , +-- and ). +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 () + diff --git a/include/jni.h b/include/jni.h new file mode 100644 --- /dev/null +++ b/include/jni.h @@ -0,0 +1,714 @@ +#ifndef _JNI_H_ +#define _JNI_H_ + +#include +#include +#include + +#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_*/ + + diff --git a/java-bridge.cabal b/java-bridge.cabal new file mode 100644 --- /dev/null +++ b/java-bridge.cabal @@ -0,0 +1,196 @@ +name: java-bridge +version: 0.9 + +license: MIT +license-file: LICENSE + +author: Julian Fleischer +maintainer: Julian Fleischer + +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 + diff --git a/src/Foreign/Java.cpphs b/src/Foreign/Java.cpphs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java.cpphs @@ -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. +-} + diff --git a/src/Foreign/Java/Bindings.cpphs b/src/Foreign/Java/Bindings.cpphs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/Bindings.cpphs @@ -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 + + + diff --git a/src/Foreign/Java/JNI.hs b/src/Foreign/Java/JNI.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JNI.hs @@ -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 + + diff --git a/src/Foreign/Java/JNI/Safe.tpl b/src/Foreign/Java/JNI/Safe.tpl new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JNI/Safe.tpl @@ -0,0 +1,1 @@ +("core.hs", [("NAME", "Safe"), ("SAFETY", "safe"), ("OPPOSITE", "Unsafe")]) diff --git a/src/Foreign/Java/JNI/Types.hs b/src/Foreign/Java/JNI/Types.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JNI/Types.hs @@ -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 + + diff --git a/src/Foreign/Java/JNI/Unsafe.tpl b/src/Foreign/Java/JNI/Unsafe.tpl new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JNI/Unsafe.tpl @@ -0,0 +1,1 @@ +("core.hs", [("NAME", "Unsafe"), ("SAFETY", "unsafe"), ("OPPOSITE", "Safe")]) diff --git a/src/Foreign/Java/JNI/core.hs b/src/Foreign/Java/JNI/core.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JNI/core.hs @@ -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 , +-- and ). +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 () + diff --git a/src/Foreign/Java/JavaMonad.hs b/src/Foreign/Java/JavaMonad.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/JavaMonad.hs @@ -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 () + + diff --git a/src/Foreign/Java/Types.hs b/src/Foreign/Java/Types.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/Types.hs @@ -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 + + diff --git a/src/Foreign/Java/Util.hs b/src/Foreign/Java/Util.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/Util.hs @@ -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 + + diff --git a/src/Foreign/Java/Utils.hs b/src/Foreign/Java/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/Utils.hs @@ -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) + diff --git a/src/Foreign/Java/Value.hs b/src/Foreign/Java/Value.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Java/Value.hs @@ -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 + diff --git a/src/ffijni.c b/src/ffijni.c new file mode 100644 --- /dev/null +++ b/src/ffijni.c @@ -0,0 +1,1230 @@ +#include +#include +#include +#include + +#include "ffijni.h" +#include "jni.h" + +#if defined(FFIJNI_LINUX) || defined(FFIJNI_MACOSX) +#include +#else +#if defined(FFIJNI_WINDOWS) +#include +#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=." +#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, "", 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). + */ + } +} + + + + diff --git a/src/ffijni.h b/src/ffijni.h new file mode 100644 --- /dev/null +++ b/src/ffijni.h @@ -0,0 +1,378 @@ +#ifndef FFIJNI_H_ +#define FFIJNI_H_ + +#include "jni.h" +#include +#include + +#if defined(FFIJNI_MACOSX) && defined(FFIJNI_OSX_GUI) +#include +#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_ */ + diff --git a/src/hfunction.h b/src/hfunction.h new file mode 100644 --- /dev/null +++ b/src/hfunction.h @@ -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 +};