diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright EURL Tweag (c) 2015-2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# jni: Complete JNI raw bindings + +This package includes Haskell bindings to the +[Java Native Interface (JNI)][jni]. This package offers mostly +unopinionated low-level bindings, which closely maps to the C API. For +higher-level more opinionated bindings see the [jvm][haskell-jvm] and +[inline-java][inline-java] packages. + +[jni]: https://docs.oracle.com/javase/8/docs/technotes/guides/jni/spec/jniTOC.html +[haskell-jvm]: https://github.com/tweag/inline-java/tree/master/jvm +[inline-java]: https://github.com/tweag/inline-java/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/jni.cabal b/jni.cabal new file mode 100644 --- /dev/null +++ b/jni.cabal @@ -0,0 +1,39 @@ +name: jni +version: 0.1 +synopsis: Complete JNI raw bindings. +description: Please see README.md. +homepage: https://github.com/tweag/inline-java/tree/master/jni#readme +license: BSD3 +license-file: LICENSE +author: Tweag I/O +maintainer: m@tweag.io +copyright: 2015-2016 EURL Tweag. +category: FFI, JVM, Java +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md +extra-tmp-files: + src/Foreign/JNI.c + +source-repository head + type: git + location: https://github.com/tweag/inline-java + subdir: jni + +library + hs-source-dirs: src + c-sources: src/Foreign/JNI.c + cc-options: -std=c11 + extra-libraries: jvm + exposed-modules: + Foreign.JNI + Foreign.JNI.Types + Foreign.JNI.String + build-depends: + base >= 4.7 && < 5, + bytestring >=0.10, + containers >=0.5, + inline-c >=0.5, + singletons >= 2.0, + thread-local-storage >=0.1 + default-language: Haskell2010 diff --git a/src/Foreign/JNI.c b/src/Foreign/JNI.c new file mode 100644 --- /dev/null +++ b/src/Foreign/JNI.c @@ -0,0 +1,449 @@ + +#include + +#include + +#include + +jthrowable inline_c_Foreign_JNI_0_547acbc2ed14c804f8e5133e90bd68e8a83f9c40(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1) { +return ( (*env_inline_c_0)->ExceptionOccurred(env_inline_c_1) ); +} + + +void inline_c_Foreign_JNI_1_78814a28f200ba50ae6a800d1c57dc6512afa523(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1) { + (*env_inline_c_0)->ExceptionDescribe(env_inline_c_1) ; +} + + +void inline_c_Foreign_JNI_2_fa3d0bf0766f27928a66a4776f60d76979f8c97d(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1) { + (*env_inline_c_0)->ExceptionClear(env_inline_c_1) ; +} + + +JNIEnv * inline_c_Foreign_JNI_3_99b0dd0131b646dafcbe5e45017817ad4c5859cb() { + + jsize num_jvms; + JavaVM *jvm; + + + JNI_GetCreatedJavaVMs(&jvm, 1, &num_jvms); + JNIEnv *env; + + if(!num_jvms) { + fprintf(stderr, "No JVM has been initialized yet.\n"); + exit(EFAULT); + } + + + + + (*jvm)->AttachCurrentThreadAsDaemon(jvm, (void**)&env, NULL); + return env; +} + + +JavaVM * inline_c_Foreign_JNI_4_c815bc1d60971caaef72b2be0a16ae8be8624208(int n_inline_c_0, int n_inline_c_1, char ** coptions_inline_c_2, int n_inline_c_3) { + + JavaVM *jvm; + JNIEnv *env; + JavaVMInitArgs vm_args; + JavaVMOption *options = malloc(sizeof(JavaVMOption) * n_inline_c_0); + for(int i = 0; i < n_inline_c_1; i++) + options[0].optionString = coptions_inline_c_2[i]; + vm_args.version = JNI_VERSION_1_6; + vm_args.nOptions = n_inline_c_3; + vm_args.options = options; + vm_args.ignoreUnrecognized = 0; + JNI_CreateJavaVM(&jvm, (void**)&env, &vm_args); + free(options); + return jvm; +} + + +void inline_c_Foreign_JNI_5_b584a6aa1eb7dfd9c78995e2ecba0ce2c820e741(JavaVM * jvm_inline_c_0, JavaVM * jvm_inline_c_1) { + (*jvm_inline_c_0)->DestroyJavaVM(jvm_inline_c_1); +} + + +jclass inline_c_Foreign_JNI_6_8c440e181516a3630ffa1c69f19cdd49c5ea5146(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, char * namep_inline_c_2, jobject loader_inline_c_3, char * buf_inline_c_4, long buf_inline_c_5) { +return ( + (*env_inline_c_0)->DefineClass(env_inline_c_1, + namep_inline_c_2, + loader_inline_c_3, + buf_inline_c_4, + buf_inline_c_5) ); +} + + +jclass inline_c_Foreign_JNI_7_98f2efdfb85a70a64012d4a321b2e1b53ec6d783(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, char * namep_inline_c_2) { +return ( (*env_inline_c_0)->FindClass(env_inline_c_1, namep_inline_c_2) ); +} + + +jobject inline_c_Foreign_JNI_8_db79f2d25dd672f2593a68b078850f23bf59b54d(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID constr_inline_c_3, jvalue * cargs_inline_c_4) { +return ( + (*env_inline_c_0)->NewObjectA(env_inline_c_1, + cls_inline_c_2, + constr_inline_c_3, + cargs_inline_c_4) ); +} + + +jfieldID inline_c_Foreign_JNI_9_24f9a5b843f700dd367457745083b0f737727165(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, char * fieldnamep_inline_c_3, char * sigp_inline_c_4) { +return ( + (*env_inline_c_0)->GetFieldID(env_inline_c_1, + cls_inline_c_2, + fieldnamep_inline_c_3, + sigp_inline_c_4) ); +} + + +jobject inline_c_Foreign_JNI_10_fd81942890ffe8025c7c8e605b29bfa2d631bf64(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jfieldID field_inline_c_3) { +return ( + (*env_inline_c_0)->GetObjectField(env_inline_c_1, + obj_inline_c_2, + field_inline_c_3) ); +} + + +jmethodID inline_c_Foreign_JNI_11_e722a7a0d6891db8a6cda0ec21cc6312aaeec3c0(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, char * methodnamep_inline_c_3, char * sigp_inline_c_4) { +return ( + (*env_inline_c_0)->GetMethodID(env_inline_c_1, + cls_inline_c_2, + methodnamep_inline_c_3, + sigp_inline_c_4) ); +} + + +jmethodID inline_c_Foreign_JNI_12_196e9055f6891bfa3cf856c108612c9572ecc877(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, char * methodnamep_inline_c_3, char * sigp_inline_c_4) { +return ( + (*env_inline_c_0)->GetStaticMethodID(env_inline_c_1, + cls_inline_c_2, + methodnamep_inline_c_3, + sigp_inline_c_4) ); +} + + +void inline_c_Foreign_JNI_13_1fc0f64f3f314012d49ffbd906fd558d03aef37d(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { + (*env_inline_c_0)->CallVoidMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ; +} + + +jobject inline_c_Foreign_JNI_14_203a086f6ff15893a2417732fde0904a88dd4307(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallObjectMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jboolean inline_c_Foreign_JNI_15_b729da20539bd62f9d8b8e8579dbf42bbafc76c4(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallBooleanMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jbyte inline_c_Foreign_JNI_16_4e4bdbfc154de6ffe6eb562e1edfcbb529c275e8(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallByteMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jchar inline_c_Foreign_JNI_17_5e000da030371e4db09c808934e3e5f504eda6c9(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallCharMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jshort inline_c_Foreign_JNI_18_516aded3c2f638c87a12e56d246bdcea1c7e1a47(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallShortMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jint inline_c_Foreign_JNI_19_58b123994733ee132cc23af0e5a7da34ef37f584(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallIntMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jlong inline_c_Foreign_JNI_20_46357804ee4af723721f601341c61ac4eecad475(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallLongMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jfloat inline_c_Foreign_JNI_21_75b26f9688a40ee63e314f73ee5f9563c48e02c0(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallFloatMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jdouble inline_c_Foreign_JNI_22_f33654d183f21d1a2c8ffc121684d4e60e273fa2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallDoubleMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +void inline_c_Foreign_JNI_23_5e76a5cd24826d8a13100c53ae77823083465978(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { + (*env_inline_c_0)->CallStaticVoidMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ; +} + + +jobject inline_c_Foreign_JNI_24_6b65c20aae594d93c02434b3de002e443794ad14(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticObjectMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jboolean inline_c_Foreign_JNI_25_58bcbcce6c8bf92799bd1db44c288a7b0a260a36(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticBooleanMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jbyte inline_c_Foreign_JNI_26_1f0c41a419f29557514552df4d07022a006f2ca3(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticByteMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jchar inline_c_Foreign_JNI_27_51a3cb1cefc6391ba5958a887d84196690a418f2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticCharMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jshort inline_c_Foreign_JNI_28_5822dfce2b301e3b90f80885a4a5838bdc57cd44(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticShortMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jint inline_c_Foreign_JNI_29_4fdc28424fe7ef156763f715ef79463ed387abb2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticIntMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jlong inline_c_Foreign_JNI_30_93382b358dc7f0275c6a620eaa67fdfd75167d54(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticLongMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jfloat inline_c_Foreign_JNI_31_89ea2435847f3d94e8b71bcceba739a077829ca9(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticFloatMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jdouble inline_c_Foreign_JNI_32_0b9bb41f21f19495338507ff5779f50a17ac0245(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallStaticDoubleMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jobjectArray inline_c_Foreign_JNI_33_0b57533e83360b5a6660bf703521b3b6c2fbec66(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2, jclass cls_inline_c_3) { +return ( + (*env_inline_c_0)->NewObjectArray(env_inline_c_1, + sz_inline_c_2, + cls_inline_c_3, + NULL) ); +} + + +jbooleanArray inline_c_Foreign_JNI_34_b1841567b8f0e99405458b9e8a3b7f3a3e20812f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewBooleanArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jbyteArray inline_c_Foreign_JNI_35_1a9345ff427557126ba3aa5f0fb460f3df632ff8(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewByteArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jcharArray inline_c_Foreign_JNI_36_b00869a9422815fdc3aa43f15e3b782dc6f19e03(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewCharArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jshortArray inline_c_Foreign_JNI_37_06a1e38de0ed2d7764757388457ed0797c72d8aa(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewShortArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jintArray inline_c_Foreign_JNI_38_af7c087746afd64be9d977ebf078c2df4b3d918e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewIntArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jlongArray inline_c_Foreign_JNI_39_270c75c62cc97fdc3741af544fa35a61abf37fba(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewLongArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jfloatArray inline_c_Foreign_JNI_40_312dee8af1c4b2058cb1b2703277cf297ba34224(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewFloatArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jdoubleArray inline_c_Foreign_JNI_41_103070e78986a21762e18c9aebfa9162a3565d9b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +return ( (*env_inline_c_0)->NewDoubleArray(env_inline_c_1, sz_inline_c_2) ); +} + + +jstring inline_c_Foreign_JNI_42_d5ed5b314231e7dc3292c2329a2cb4191e262633(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jchar * ptr_inline_c_2, jsize len_inline_c_3) { +return ( + (*env_inline_c_0)->NewString(env_inline_c_1, + ptr_inline_c_2, + len_inline_c_3) ); +} + + +jsize inline_c_Foreign_JNI_43_9be0134c89fa74c4d07a2601d81d89982ce8bdf6(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2) { +return ( + (*env_inline_c_0)->GetArrayLength(env_inline_c_1, + array_inline_c_2) ); +} + + +jsize inline_c_Foreign_JNI_44_2e55ce4ded52c43b7b69c0c49c4425aef4f8a80b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { +return ( + (*env_inline_c_0)->GetStringLength(env_inline_c_1, + jstr_inline_c_2) ); +} + + +jboolean * inline_c_Foreign_JNI_45_3452f86c23995e2bdb3311f77b789016b4891c28(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jbyte * inline_c_Foreign_JNI_46_9add218acf6a238caef1a0f8b4571cc5899ea0b3(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jchar * inline_c_Foreign_JNI_47_c638e51693b825e64d0379c8101ad9dd3d982cfe(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jshort * inline_c_Foreign_JNI_48_7ae0d7df7381ab0493b342a2b5ecef83543bacf4(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jint * inline_c_Foreign_JNI_49_7f867cf87497f6014014c05b4ba430b8679af808(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jlong * inline_c_Foreign_JNI_50_8dc382d755e548849b2f1319b25ead4efb3022d5(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jfloat * inline_c_Foreign_JNI_51_ed2d3f0a0ffc45cf2aade1b15e8bb54c57efafe4(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +jdouble * inline_c_Foreign_JNI_52_8397aa1311000201220e8c65b056dc1011b84b03(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); +} + + +const jchar * inline_c_Foreign_JNI_53_ac075a3bdcb535575fe36c6f7b5eb3d66ace44a7(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { +return ( + (*env_inline_c_0)->GetStringChars(env_inline_c_1, + jstr_inline_c_2, + NULL) ); +} + + +void inline_c_Foreign_JNI_54_8718c0a7d8c303688780594268997465ed29e125(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbooleanArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jboolean * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_55_1e6650c511f837ea6b18ef538b08f6ac2efec990(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbyteArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jbyte * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_56_f5f11dc3b4a4f818c20e98d145b7e702fdd2a36f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jcharArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jchar * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_57_13a8c656865a4d57362e32022c0ab2d6bbd75c25(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jshortArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jshort * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_58_f19513a74700e6f92f951ef54ff61b112be8cfb2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jintArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jint * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_59_9299b35c10f5adfc67ff0810b5a9dd48fae257cf(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jlongArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jlong * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_60_f1a270bb87de9f6a253141b58a8c53872db6bcff(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jfloatArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jfloat * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_61_7f6d994b3ef9868bdf85787db5a83f6147cdf6a4(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jdoubleArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jdouble * buf_inline_c_5) { + (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; +} + + +void inline_c_Foreign_JNI_62_5d5355f911ff38accf7df59e4f3407823efa0055(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jboolean * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseBooleanArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_63_93701f28f0a45b8531f977f3ad28d48b747bb58c(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jbyte * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseByteArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_64_d799968701da7f57e4eb07390e1efda373184222(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jchar * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseCharArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_65_03e0c5a40ab324b1c42f0b70ceaeb6b1605a0ded(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jshort * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseShortArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_66_4c2726a53e147cd6eb61733e27bfc599bc883f74(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jint * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseIntArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_67_9e1790871e959852cb5032b3f2833c370b81bb0f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jlong * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseLongArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_68_44c06b418c79983d60f09ffc49851077b1feb632(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jfloat * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseFloatArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_69_94830601ce91790b75e74abe9c9819be2e748762(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jdouble * xs_inline_c_3) { + (*env_inline_c_0)->ReleaseDoubleArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; +} + + +void inline_c_Foreign_JNI_70_7a962d5f8e6114066dca42386535e4a079022eae(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2, jchar * chars_inline_c_3) { + + (*env_inline_c_0)->ReleaseStringChars(env_inline_c_1, + jstr_inline_c_2, + chars_inline_c_3) ; +} + + +jobject inline_c_Foreign_JNI_71_bb66272284cce01d85b6ec31967e1a66eae7e0c5(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2, jsize i_inline_c_3) { +return ( + (*env_inline_c_0)->GetObjectArrayElement(env_inline_c_1, + array_inline_c_2, + i_inline_c_3) ); +} + + +void inline_c_Foreign_JNI_72_c069b4edd080791f4858d4a7a48b8c42c99c8e4a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobjectArray array_inline_c_2, jsize i_inline_c_3, jobject x_inline_c_4) { + + (*env_inline_c_0)->SetObjectArrayElement(env_inline_c_1, + array_inline_c_2, + i_inline_c_3, + x_inline_c_4); ; +} + diff --git a/src/Foreign/JNI.hs b/src/Foreign/JNI.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/JNI.hs @@ -0,0 +1,505 @@ +-- | Low-level bindings to the Java Native Interface (JNI). +-- +-- Read the +-- +-- for authoritative documentation as to what each of the functions in +-- this module does. The names of the bindings in this module were chosen to +-- match the names of the functions in the JNI spec. +-- +-- All bindings in this module access the JNI via a thread-local variable of +-- type @JNIEnv *@. If the current OS thread has not yet been "attached" to the +-- JVM, it is attached implicitly upon the first call to one of these bindings +-- in the current thread. +-- +-- The 'String' type in this module is the type of JNI strings. See "Foreign.JNI.String". +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} + +module Foreign.JNI + ( -- * JNI functions + -- ** VM creation + withJVM + -- ** Class loading + , defineClass + -- ** Query functions + , findClass + , getFieldID + , getObjectField + , getMethodID + , getStaticMethodID + -- ** Method invocation + , callObjectMethod + , callBooleanMethod + , callIntMethod + , callLongMethod + , callCharMethod + , callShortMethod + , callByteMethod + , callDoubleMethod + , callFloatMethod + , callVoidMethod + , callStaticObjectMethod + , callStaticVoidMethod + , callStaticBooleanMethod + , callStaticIntMethod + , callStaticLongMethod + , callStaticCharMethod + , callStaticShortMethod + , callStaticByteMethod + , callStaticDoubleMethod + , callStaticFloatMethod + -- ** Object construction + , newObject + , newString + , newObjectArray + , newBooleanArray + , newByteArray + , newCharArray + , newShortArray + , newIntArray + , newLongArray + , newFloatArray + , newDoubleArray + -- ** Array manipulation + , getArrayLength + , getStringLength + , getBooleanArrayElements + , getByteArrayElements + , getCharArrayElements + , getShortArrayElements + , getIntArrayElements + , getLongArrayElements + , getFloatArrayElements + , getDoubleArrayElements + , getStringChars + , setBooleanArrayRegion + , setByteArrayRegion + , setCharArrayRegion + , setShortArrayRegion + , setIntArrayRegion + , setLongArrayRegion + , setFloatArrayRegion + , setDoubleArrayRegion + , releaseBooleanArrayElements + , releaseByteArrayElements + , releaseCharArrayElements + , releaseShortArrayElements + , releaseIntArrayElements + , releaseLongArrayElements + , releaseFloatArrayElements + , releaseDoubleArrayElements + , releaseStringChars + , getObjectArrayElement + , setObjectArrayElement + ) where + +import Control.Exception (Exception, bracket, finally, throwIO) +import Control.Monad (unless) +import Data.Coerce +import Data.Int +import Data.IORef (IORef, newIORef, readIORef) +import Data.Word +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Monoid ((<>)) +import Data.Typeable (Typeable) +import Data.TLS.PThread +import Foreign.C (CChar) +import Foreign.JNI.Types +import qualified Foreign.JNI.String as JNI +import Foreign.Marshal.Array +import Foreign.Ptr (Ptr, nullPtr) +import qualified Language.C.Inline as C +import qualified Language.C.Inline.Unsafe as CU +import System.IO.Unsafe (unsafePerformIO) +import Prelude hiding (String) + +C.context (C.baseCtx <> C.bsCtx <> jniCtx) + +C.include "" +C.include "" +C.include "" + +data JavaException = JavaException JThrowable + deriving (Show, Typeable) + +instance Exception JavaException + +-- | Thrown when @GetArrayElements@ returns a null pointer, +-- because it wanted to copy the array contents but couldn't. In this case the +-- JVM doesn't throw OutOfMemory according to the JNI spec. +data ArrayCopyFailed = ArrayCopyFailed + deriving (Show, Typeable) + +instance Exception ArrayCopyFailed + +-- | Map Java exceptions to Haskell exceptions. +throwIfException :: Ptr JNIEnv -> IO a -> IO a +throwIfException env m = m `finally` do + J excptr <- [CU.exp| jthrowable { (*$(JNIEnv *env))->ExceptionOccurred($(JNIEnv *env)) } |] + unless (excptr == nullPtr) $ do + [CU.exp| void { (*$(JNIEnv *env))->ExceptionDescribe($(JNIEnv *env)) } |] + [CU.exp| void { (*$(JNIEnv *env))->ExceptionClear($(JNIEnv *env)) } |] + throwIO $ JavaException (J excptr) + +-- | Check whether a pointer is null. +throwIfNull :: IO (Ptr a) -> IO (Ptr a) +throwIfNull m = do + ptr <- m + if ptr == nullPtr + then throwIO ArrayCopyFailed + else return ptr + +-- | A global mutable cell holding the TLS variable, whose content is set once +-- for each thread. +envTlsRef :: IORef (TLS (Ptr JNIEnv)) +{-# NOINLINE envTlsRef #-} +envTlsRef = unsafePerformIO $ do + -- It doesn't matter if this computation ends up running twice, say because + -- of lazy blackholing. + !tls <- mkTLS $ [C.block| JNIEnv* { + jsize num_jvms; + JavaVM *jvm; + /* Assume there's at most one JVM. The current JNI spec (2016) says only + * one JVM per process is supported anyways. */ + JNI_GetCreatedJavaVMs(&jvm, 1, &num_jvms); + JNIEnv *env; + + if(!num_jvms) { + fprintf(stderr, "No JVM has been initialized yet.\n"); + exit(EFAULT); + } + + /* Attach as daemon to match GHC's usual semantics for threads, which are + * daemonic. + */ + (*jvm)->AttachCurrentThreadAsDaemon(jvm, (void**)&env, NULL); + return env; } |] + newIORef tls + +-- | Run an action against the appropriate 'JNIEnv'. +-- +-- Each OS thread has its own 'JNIEnv', which this function gives access to. +-- +-- TODO check whether this call is only safe from a (bound) thread. +withJNIEnv :: (Ptr JNIEnv -> IO a) -> IO a +withJNIEnv f = f =<< getTLS =<< readIORef envTlsRef + +useAsCStrings :: [ByteString] -> ([Ptr CChar] -> IO a) -> IO a +useAsCStrings strs m = + foldr (\str k cstrs -> BS.useAsCString str $ \cstr -> k (cstr:cstrs)) m strs [] + +-- | Create a new JVM, with the given arguments. /Can only be called once/. Best +-- practice: use it to wrap your @main@ function. +withJVM :: [ByteString] -> IO a -> IO a +withJVM options action = + bracket ini fini (const action) + where + ini = do + useAsCStrings options $ \cstrs -> do + withArray cstrs $ \(coptions :: Ptr (Ptr CChar)) -> do + let n = fromIntegral (length cstrs) :: C.CInt + [C.block| JavaVM * { + JavaVM *jvm; + JNIEnv *env; + JavaVMInitArgs vm_args; + JavaVMOption *options = malloc(sizeof(JavaVMOption) * $(int n)); + for(int i = 0; i < $(int n); i++) + options[0].optionString = $(char **coptions)[i]; + vm_args.version = JNI_VERSION_1_6; + vm_args.nOptions = $(int n); + vm_args.options = options; + vm_args.ignoreUnrecognized = 0; + JNI_CreateJavaVM(&jvm, (void**)&env, &vm_args); + free(options); + return jvm; } |] + fini jvm = [C.block| void { (*$(JavaVM *jvm))->DestroyJavaVM($(JavaVM *jvm)); } |] + +defineClass + :: Coercible o (J ('Class "java.lang.ClassLoader")) + => JNI.String -- ^ Class name + -> o -- ^ Loader + -> ByteString -- ^ Bytecode buffer + -> IO JClass +defineClass name (coerce -> upcast -> loader) buf = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString name $ \namep -> + [CU.exp| jclass { + (*$(JNIEnv *env))->DefineClass($(JNIEnv *env), + $(char *namep), + $(jobject loader), + $bs-ptr:buf, + $bs-len:buf) } |] + +findClass + :: JNI.String -- ^ Class name + -> IO JClass +findClass name = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString name $ \namep -> + [CU.exp| jclass { (*$(JNIEnv *env))->FindClass($(JNIEnv *env), $(char *namep)) } |] + +newObject :: JClass -> JNI.String -> [JValue] -> IO JObject +newObject cls sig args = withJNIEnv $ \env -> + throwIfException env $ + withArray args $ \cargs -> do + constr <- getMethodID cls "" sig + [CU.exp| jobject { + (*$(JNIEnv *env))->NewObjectA($(JNIEnv *env), + $(jclass cls), + $(jmethodID constr), + $(jvalue *cargs)) } |] + +getFieldID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JFieldID +getFieldID cls fieldname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString fieldname $ \fieldnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jfieldID { + (*$(JNIEnv *env))->GetFieldID($(JNIEnv *env), + $(jclass cls), + $(char *fieldnamep), + $(char *sigp)) } |] + +getObjectField + :: Coercible o (J a) + => o -- ^ Any object of any class + -> JFieldID + -> IO JObject +getObjectField (coerce -> upcast -> obj) field = withJNIEnv $ \env -> + throwIfException env $ + [CU.exp| jobject { + (*$(JNIEnv *env))->GetObjectField($(JNIEnv *env), + $(jobject obj), + $(jfieldID field)) } |] + +getMethodID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JMethodID +getMethodID cls methodname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString methodname $ \methodnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jmethodID { + (*$(JNIEnv *env))->GetMethodID($(JNIEnv *env), + $(jclass cls), + $(char *methodnamep), + $(char *sigp)) } |] + +getStaticMethodID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JMethodID +getStaticMethodID cls methodname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString methodname $ \methodnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jmethodID { + (*$(JNIEnv *env))->GetStaticMethodID($(JNIEnv *env), + $(jclass cls), + $(char *methodnamep), + $(char *sigp)) } |] + +-- Modern CPP does have ## for concatenating strings, but we use the hacky /**/ +-- comment syntax for string concatenation. This is because GHC passes +-- the -traditional flag to the preprocessor by default, which turns off several +-- modern CPP features. + +#define CALL_METHOD(name, hs_rettype, c_rettype) \ +call/**/name/**/Method :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO hs_rettype; \ +call/**/name/**/Method (coerce -> upcast -> obj) method args = withJNIEnv $ \env -> \ + throwIfException env $ \ + withArray args $ \cargs -> \ + [C.exp| c_rettype { \ + (*$(JNIEnv *env))->Call/**/name/**/MethodA($(JNIEnv *env), \ + $(jobject obj), \ + $(jmethodID method), \ + $(jvalue *cargs)) } |] + +CALL_METHOD(Void, (), void) +CALL_METHOD(Object, JObject, jobject) +callBooleanMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO Bool +callBooleanMethod x y z = + let CALL_METHOD(Boolean, Word8, jboolean) + in toEnum . fromIntegral <$> callBooleanMethod x y z +CALL_METHOD(Byte, CChar, jbyte) +CALL_METHOD(Char, Word16, jchar) +CALL_METHOD(Short, Int16, jshort) +CALL_METHOD(Int, Int32, jint) +CALL_METHOD(Long, Int64, jlong) +CALL_METHOD(Float, Float, jfloat) +CALL_METHOD(Double, Double, jdouble) + +#define CALL_STATIC_METHOD(name, hs_rettype, c_rettype) \ +callStatic/**/name/**/Method :: JClass -> JMethodID -> [JValue] -> IO hs_rettype; \ +callStatic/**/name/**/Method cls method args = withJNIEnv $ \env -> \ + throwIfException env $ \ + withArray args $ \cargs -> \ + [C.exp| c_rettype { \ + (*$(JNIEnv *env))->CallStatic/**/name/**/MethodA($(JNIEnv *env), \ + $(jclass cls), \ + $(jmethodID method), \ + $(jvalue *cargs)) } |] + +CALL_STATIC_METHOD(Void, (), void) +CALL_STATIC_METHOD(Object, JObject, jobject) +callStaticBooleanMethod :: JClass -> JMethodID -> [JValue] -> IO Bool +callStaticBooleanMethod x y z = + let CALL_STATIC_METHOD(Boolean, Word8, jboolean) + in toEnum . fromIntegral <$> callStaticBooleanMethod x y z +CALL_STATIC_METHOD(Byte, CChar, jbyte) +CALL_STATIC_METHOD(Char, Word16, jchar) +CALL_STATIC_METHOD(Short, Int16, jshort) +CALL_STATIC_METHOD(Int, Int32, jint) +CALL_STATIC_METHOD(Long, Int64, jlong) +CALL_STATIC_METHOD(Float, Float, jfloat) +CALL_STATIC_METHOD(Double, Double, jdouble) + +newObjectArray :: Int32 -> JClass -> IO JObjectArray +newObjectArray sz cls = withJNIEnv $ \env -> + throwIfException env $ + [CU.exp| jobjectArray { + (*$(JNIEnv *env))->NewObjectArray($(JNIEnv *env), + $(jsize sz), + $(jclass cls), + NULL) } |] + +#define NEW_ARRAY(name, c_rettype) \ +new/**/name/**/Array :: Int32 -> IO J/**/name/**/Array; \ +new/**/name/**/Array sz = withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.exp| c_rettype/**/Array { \ + (*$(JNIEnv *env))->New/**/name/**/Array($(JNIEnv *env), \ + $(jsize sz)) } |] + +NEW_ARRAY(Boolean, jboolean) +NEW_ARRAY(Byte, jbyte) +NEW_ARRAY(Char, jchar) +NEW_ARRAY(Short, jshort) +NEW_ARRAY(Int, jint) +NEW_ARRAY(Long, jlong) +NEW_ARRAY(Float, jfloat) +NEW_ARRAY(Double, jdouble) + +newString :: Ptr Word16 -> Int32 -> IO JString +newString ptr len = withJNIEnv $ \env -> + throwIfException env $ + [CU.exp| jstring { + (*$(JNIEnv *env))->NewString($(JNIEnv *env), + $(jchar *ptr), + $(jsize len)) } |] + +getArrayLength :: Coercible o (JArray a) => o -> IO Int32 +getArrayLength (coerce -> upcast -> array) = withJNIEnv $ \env -> + [C.exp| jsize { + (*$(JNIEnv *env))->GetArrayLength($(JNIEnv *env), + $(jarray array)) } |] + +getStringLength :: JString -> IO Int32 +getStringLength jstr = withJNIEnv $ \env -> + [CU.exp| jsize { + (*$(JNIEnv *env))->GetStringLength($(JNIEnv *env), + $(jstring jstr)) } |] + +#define GET_ARRAY_ELEMENTS(name, hs_rettype, c_rettype) \ +get/**/name/**/ArrayElements :: J/**/name/**/Array -> IO (Ptr hs_rettype); \ +get/**/name/**/ArrayElements (upcast -> array) = withJNIEnv $ \env -> \ + throwIfNull $ \ + [CU.exp| c_rettype* { \ + (*$(JNIEnv *env))->GetIntArrayElements($(JNIEnv *env), \ + $(jobject array), \ + NULL) } |] + +GET_ARRAY_ELEMENTS(Boolean, Word8, jboolean) +GET_ARRAY_ELEMENTS(Byte, CChar, jbyte) +GET_ARRAY_ELEMENTS(Char, Word16, jchar) +GET_ARRAY_ELEMENTS(Short, Int16, jshort) +GET_ARRAY_ELEMENTS(Int, Int32, jint) +GET_ARRAY_ELEMENTS(Long, Int64, jlong) +GET_ARRAY_ELEMENTS(Float, Float, jfloat) +GET_ARRAY_ELEMENTS(Double, Double, jdouble) + +getStringChars :: JString -> IO (Ptr Word16) +getStringChars jstr = withJNIEnv $ \env -> + throwIfNull $ + [CU.exp| const jchar* { + (*$(JNIEnv *env))->GetStringChars($(JNIEnv *env), + $(jstring jstr), + NULL) } |] + +#define SET_ARRAY_REGION(name, hs_argtype, c_argtype) \ +set/**/name/**/ArrayRegion :: J/**/name/**/Array -> Int32 -> Int32 -> Ptr hs_argtype -> IO (); \ +set/**/name/**/ArrayRegion array start len buf = withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.exp| void { \ + (*$(JNIEnv *env))->SetIntArrayRegion($(JNIEnv *env), \ + $(c_argtype/**/Array array), \ + $(jsize start), \ + $(jsize len), \ + $(c_argtype *buf)) } |] + +SET_ARRAY_REGION(Boolean, Word8, jboolean) +SET_ARRAY_REGION(Byte, CChar, jbyte) +SET_ARRAY_REGION(Char, Word16, jchar) +SET_ARRAY_REGION(Short, Int16, jshort) +SET_ARRAY_REGION(Int, Int32, jint) +SET_ARRAY_REGION(Long, Int64, jlong) +SET_ARRAY_REGION(Float, Float, jfloat) +SET_ARRAY_REGION(Double, Double, jdouble) + +#define RELEASE_ARRAY_ELEMENTS(name, hs_argtype, c_argtype) \ +release/**/name/**/ArrayElements :: J/**/name/**/Array -> Ptr hs_argtype -> IO (); \ +release/**/name/**/ArrayElements (upcast -> array) xs = withJNIEnv $ \env -> \ + [CU.exp| void { \ + (*$(JNIEnv *env))->Release/**/name/**/ArrayElements($(JNIEnv *env), \ + $(jobject array), \ + $(c_argtype *xs), \ + JNI_ABORT) } |] + +RELEASE_ARRAY_ELEMENTS(Boolean, Word8, jboolean) +RELEASE_ARRAY_ELEMENTS(Byte, CChar, jbyte) +RELEASE_ARRAY_ELEMENTS(Char, Word16, jchar) +RELEASE_ARRAY_ELEMENTS(Short, Int16, jshort) +RELEASE_ARRAY_ELEMENTS(Int, Int32, jint) +RELEASE_ARRAY_ELEMENTS(Long, Int64, jlong) +RELEASE_ARRAY_ELEMENTS(Float, Float, jfloat) +RELEASE_ARRAY_ELEMENTS(Double, Double, jdouble) + +releaseStringChars :: JString -> Ptr Word16 -> IO () +releaseStringChars jstr chars = withJNIEnv $ \env -> + [CU.exp| void { + (*$(JNIEnv *env))->ReleaseStringChars($(JNIEnv *env), + $(jstring jstr), + $(jchar *chars)) } |] + +getObjectArrayElement :: Coercible o (JArray a) => o -> Int32 -> IO (J a) +getObjectArrayElement (coerce -> upcast -> array) i = withJNIEnv $ \env -> unsafeCast <$> + [C.exp| jobject { + (*$(JNIEnv *env))->GetObjectArrayElement($(JNIEnv *env), + $(jarray array), + $(jsize i)) } |] + +setObjectArrayElement :: Coercible o (J a) => JObjectArray -> Int32 -> o -> IO () +setObjectArrayElement array i (coerce -> upcast -> x) = withJNIEnv $ \env -> + [C.exp| void { + (*$(JNIEnv *env))->SetObjectArrayElement($(JNIEnv *env), + $(jobjectArray array), + $(jsize i), + $(jobject x)); } |] diff --git a/src/Foreign/JNI/String.hs b/src/Foreign/JNI/String.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/JNI/String.hs @@ -0,0 +1,69 @@ +-- | JNI strings. Like C strings and unlike 'Data.ByteString.ByteString', these +-- are null-terminated. Unlike C strings, each character is (multi-byte) encoded +-- as UTF-8. Unlike UTF-8, embedded NULL characters are encoded as two bytes and +-- the four-byte UTF-8 format for characters is not recognized. A custom +-- encoding is used instead. See +-- +-- for more details. +-- +-- /NOTE:/ the current implementation does not support embedded NULL's and +-- four-byte characters. + +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE MagicHash #-} + +module Foreign.JNI.String + ( String + , toChars + , fromChars + , fromByteString + , unsafeFromByteString + , toByteString + , withString + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS +import Data.ByteString (ByteString) +import Data.String (IsString(..)) +import Foreign.C.String (CString) +import qualified GHC.Foreign as GHC +import qualified GHC.IO.Encoding as GHC +import System.IO.Unsafe (unsafeDupablePerformIO) +import qualified Prelude +import Prelude hiding (String) + +newtype String = String ByteString + deriving (Eq) + +instance Show String where + show str = show (toChars str) + +instance IsString String where + fromString str = fromChars str + +fromChars :: Prelude.String -> String +{-# INLINE [0] fromChars #-} +fromChars str = unsafeDupablePerformIO $ do + String <$> (BS.unsafePackCString =<< GHC.newCString GHC.utf8 str) + +toChars :: String -> Prelude.String +toChars (String bs) = unsafeDupablePerformIO $ BS.unsafeUseAsCString bs $ GHC.peekCString GHC.utf8 + +withString :: String -> (CString -> IO a) -> IO a +withString (String bs) f = BS.unsafeUseAsCString bs f + +toByteString :: String -> ByteString +toByteString (String bs) = bs + +-- | O(1) if the input is null-terminated. Otherwise the input is copied into +-- a null-terminated buffer first. +fromByteString :: ByteString -> String +fromByteString bs + | BS.last bs == 0 = String bs + | otherwise = String (bs `BS.snoc` 0) + +-- | Same as 'fromByteString', but doesn't check whether the input is +-- null-terminated or not. +unsafeFromByteString :: ByteString -> String +unsafeFromByteString = String diff --git a/src/Foreign/JNI/Types.hs b/src/Foreign/JNI/Types.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/JNI/Types.hs @@ -0,0 +1,349 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +module Foreign.JNI.Types + ( JType(..) + , IsPrimitiveType + , IsReferenceType + , Sing(..) + , type (<>) + -- * JNI types + , J(..) + , jnull + , upcast + , unsafeCast + , generic + , unsafeUngeneric + , jtypeOf + , referenceTypeName + , signature + , methodSignature + , JVM(..) + , JNIEnv(..) + , JMethodID(..) + , JFieldID(..) + , JValue(..) + -- * JNI defined object types + , JObject + , JClass + , JString + , JArray + , JObjectArray + , JBooleanArray + , JByteArray + , JCharArray + , JShortArray + , JIntArray + , JLongArray + , JFloatArray + , JDoubleArray + , JThrowable + -- * inline-c contexts + , jniCtx + ) where + +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Builder.Prim as Prim +import Data.ByteString.Builder (Builder) +import Data.Char (chr, ord) +import Data.Int +import Data.Map (fromList) +import Data.Monoid ((<>)) +import Data.Singletons + ( Sing + , SingI(..) + , SomeSing(..) +#if !MIN_VERSION_singletons(2,2,0) + , KProxy(..) +#endif + ) +import Data.Singletons.TypeLits (KnownSymbol, symbolVal) +import Data.String (fromString) +import Data.Word +import Foreign.C (CChar) +import qualified Foreign.JNI.String as JNI +import Foreign.Ptr +import Foreign.Storable (Storable(..)) +import GHC.TypeLits (Symbol) +import Language.C.Types (TypeSpecifier(TypeName)) +import Language.C.Inline.Context (Context(..)) + +-- | A JVM instance. +newtype JVM = JVM_ (Ptr JVM) + deriving (Eq, Show, Storable) + +-- | The thread-local JNI context. Do not share this object between threads. +newtype JNIEnv = JNIEnv_ (Ptr JNIEnv) + deriving (Eq, Show, Storable) + +-- | A thread-local reference to a field of an object. +newtype JFieldID = JFieldID_ (Ptr JFieldID) + deriving (Eq, Show, Storable) + +-- | A thread-local reference to a method of an object. +newtype JMethodID = JMethodID_ (Ptr JMethodID) + deriving (Eq, Show, Storable) + +-- | Not part of the JNI. The kind of 'J' type indices. Useful to reflect the +-- object's class at the type-level. +data JType + = Class Symbol -- ^ Class name + | Iface Symbol -- ^ Interface name + | Prim Symbol -- ^ Primitive type + | Array JType -- ^ Array type + | Generic JType [JType] -- ^ Parameterized (generic) type + | Void -- ^ Void special type + +-- | The class of Java types that are "unboxed". +class IsPrimitiveType (ty :: JType) +instance IsPrimitiveType ('Prim sym) + +class IsReferenceType (ty :: JType) +instance IsReferenceType ('Class sym) +instance IsReferenceType ('Iface sym) +instance IsReferenceType ('Array ty) +instance IsReferenceType ty => IsReferenceType ('Generic ty tys) + +data instance Sing (a :: JType) where + SClass :: JNI.String -> Sing ('Class sym) + SIface :: JNI.String -> Sing ('Iface sym) + SPrim :: JNI.String -> Sing ('Prim sym) + SArray :: Sing ty -> Sing ('Array ty) + SGeneric :: Sing ty -> Sing tys -> Sing ('Generic ty tys) + SVoid :: Sing 'Void + +-- XXX SingI constraint temporary hack because GHC 7.10 has trouble inferring +-- this constraint in 'signature'. +instance (KnownSymbol sym, SingI sym) => SingI ('Class (sym :: Symbol)) where + sing = SClass $ fromString $ symbolVal (undefined :: proxy sym) +instance (KnownSymbol sym, SingI sym) => SingI ('Iface (sym :: Symbol)) where + sing = SIface $ fromString $ symbolVal (undefined :: proxy sym) +instance (KnownSymbol sym, SingI sym) => SingI ('Prim (sym :: Symbol)) where + sing = SPrim $ fromString $ symbolVal (undefined :: proxy sym) +instance SingI ty => SingI ('Array ty) where + sing = SArray sing +instance (SingI ty, SingI tys) => SingI ('Generic ty tys) where + sing = SGeneric sing sing +instance SingI 'Void where + sing = SVoid + +-- | Shorthand for parametized Java types. +type a <> g = 'Generic a g + +-- | Type indexed Java Objects. +newtype J (a :: JType) = J (Ptr (J a)) + deriving (Eq, Show, Storable) + +type role J representational + +-- | The null reference. +jnull :: J a +jnull = J nullPtr + +-- | Any object can be cast to @Object@. +upcast :: J a -> JObject +upcast = unsafeCast + +-- | Unsafe type cast. Should only be used to downcast. +unsafeCast :: J a -> J b +unsafeCast (J x) = J (castPtr x) + +-- | Parameterize the type of an object, making its type a /generic type/. +generic :: J a -> J (a <> g) +generic = unsafeCast + +-- | Get the base type of a generic type. +unsafeUngeneric :: J (a <> g) -> J a +unsafeUngeneric = unsafeCast + +-- | A union type for uniformly passing arguments to methods. +data JValue + = JBoolean Word8 + | JByte CChar + | JChar Word16 + | JShort Int16 + | JInt Int32 + | JLong Int64 + | JFloat Float + | JDouble Double + | forall a. SingI a => JObject {-# UNPACK #-} !(J a) + +instance Show JValue where + show (JBoolean x) = "JBoolean " ++ show x + show (JByte x) = "JByte " ++ show x + show (JChar x) = "JChar " ++ show x + show (JShort x) = "JShort " ++ show x + show (JInt x) = "JInt " ++ show x + show (JLong x) = "JLong " ++ show x + show (JFloat x) = "JFloat " ++ show x + show (JDouble x) = "JDouble " ++ show x + show (JObject x) = "JObject " ++ show x + +instance Eq JValue where + (JBoolean x) == (JBoolean y) = x == y + (JByte x) == (JByte y) = x == y + (JChar x) == (JChar y) = x == y + (JShort x) == (JShort y) = x == y + (JInt x) == (JInt y) = x == y + (JLong x) == (JLong y) = x == y + (JFloat x) == (JFloat y) = x == y + (JDouble x) == (JDouble y) = x == y + (JObject (J x)) == (JObject (J y)) = castPtr x == castPtr y + _ == _ = False + +instance Storable JValue where + sizeOf _ = 8 + alignment _ = 8 + + poke p (JBoolean x) = poke (castPtr p) x + poke p (JByte x) = poke (castPtr p) x + poke p (JChar x) = poke (castPtr p) x + poke p (JShort x) = poke (castPtr p) x + poke p (JInt x) = poke (castPtr p) x + poke p (JLong x) = poke (castPtr p) x + poke p (JFloat x) = poke (castPtr p) x + poke p (JDouble x) = poke (castPtr p) x + poke p (JObject x) = poke (castPtr p :: Ptr (J a)) x + + peek _ = error "Storable JValue: undefined peek" + +-- | Get the Java type of a value. +#if MIN_VERSION_singletons(2,2,0) +jtypeOf :: JValue -> SomeSing JType +#else +jtypeOf :: JValue -> SomeSing ('KProxy :: KProxy JType) +#endif +jtypeOf (JBoolean _) = SomeSing (sing :: Sing ('Prim "boolean")) +jtypeOf (JByte _) = SomeSing (sing :: Sing ('Prim "byte")) +jtypeOf (JChar _) = SomeSing (sing :: Sing ('Prim "char")) +jtypeOf (JShort _) = SomeSing (sing :: Sing ('Prim "short")) +jtypeOf (JInt _) = SomeSing (sing :: Sing ('Prim "int")) +jtypeOf (JLong _) = SomeSing (sing :: Sing ('Prim "long")) +jtypeOf (JFloat _) = SomeSing (sing :: Sing ('Prim "float")) +jtypeOf (JDouble _) = SomeSing (sing :: Sing ('Prim "double")) +jtypeOf (JObject (_ :: J ty)) = SomeSing (sing :: Sing ty) + +-- | Create a null-terminated string. +build :: Builder -> JNI.String +build = + JNI.unsafeFromByteString . + BSL.toStrict . + Builder.toLazyByteString . + (<> Builder.char7 '\NUL') + +-- | The name of a type, suitable for passing to 'Foreign.JNI.findClass'. +referenceTypeName :: IsReferenceType ty => Sing (ty :: JType) -> JNI.String +referenceTypeName (SClass sym) = build $ classSymbolBuilder sym +referenceTypeName (SIface sym) = build $ classSymbolBuilder sym +referenceTypeName ty@(SArray _) = build $ signatureBuilder ty +referenceTypeName (SGeneric ty@(SClass _) _) = referenceTypeName ty +referenceTypeName (SGeneric ty@(SIface _) _) = referenceTypeName ty +referenceTypeName _ = error "referenceTypeName: Impossible." + +classSymbolBuilder :: JNI.String -> Builder +classSymbolBuilder sym = + Prim.primMapByteStringFixed (subst Prim.>$< Prim.word8) (JNI.toByteString sym) + where + subst (chr . fromIntegral -> '.') = fromIntegral (ord '/') + subst x = x + +signatureBuilder :: Sing (ty :: JType) -> Builder +signatureBuilder (SClass sym) = Builder.char7 'L' <> classSymbolBuilder sym <> Builder.char7 ';' +signatureBuilder (SIface sym) = Builder.char7 'L' <> classSymbolBuilder sym <> Builder.char7 ';' +signatureBuilder (SPrim "boolean") = Builder.char7 'Z' +signatureBuilder (SPrim "byte") = Builder.char7 'B' +signatureBuilder (SPrim "char") = Builder.char7 'C' +signatureBuilder (SPrim "short") = Builder.char7 'S' +signatureBuilder (SPrim "int") = Builder.char7 'I' +signatureBuilder (SPrim "long") = Builder.char7 'J' +signatureBuilder (SPrim "float") = Builder.char7 'F' +signatureBuilder (SPrim "double") = Builder.char7 'D' +signatureBuilder (SPrim sym) = error $ "Unknown primitive: " ++ show sym +signatureBuilder (SArray ty) = Builder.char7 '[' <> signatureBuilder ty +signatureBuilder (SGeneric ty _) = signatureBuilder ty +signatureBuilder SVoid = Builder.char7 'V' + +-- | Construct a JNI type signature from a Java type. +signature :: Sing (ty :: JType) -> JNI.String +signature = build . signatureBuilder + +-- | Construct a method's JNI type signature, given the type of the arguments +-- and the return type. +methodSignature +#if MIN_VERSION_singletons(2,2,0) + :: [SomeSing JType] +#else + :: [SomeSing ('KProxy :: KProxy JType)] +#endif + -> Sing (ty :: JType) + -> JNI.String +methodSignature args ret = + build $ + Builder.char7 '(' <> + mconcat (map (\(SomeSing s) -> signatureBuilder s) args) <> + Builder.char7 ')' <> + signatureBuilder ret + +type JObject = J ('Class "java.lang.Object") +type JClass = J ('Class "java.lang.Class") +type JString = J ('Class "java.lang.String") +type JThrowable = J ('Class "java.lang.Throwable") +type JArray a = J ('Array a) +type JObjectArray = JArray ('Class "java.lang.Object") +type JBooleanArray = JArray ('Prim "boolean") +type JByteArray = JArray ('Prim "byte") +type JCharArray = JArray ('Prim "char") +type JShortArray = JArray ('Prim "short") +type JIntArray = JArray ('Prim "int") +type JLongArray = JArray ('Prim "long") +type JFloatArray = JArray ('Prim "float") +type JDoubleArray = JArray ('Prim "double") + +jniCtx :: Context +jniCtx = mempty { ctxTypesTable = fromList tytab } + where + tytab = + [ -- Primitive types + (TypeName "jboolean", [t| Word8 |]) + , (TypeName "jbyte", [t| CChar |]) + , (TypeName "jchar", [t| Word16 |]) + , (TypeName "jshort", [t| Int16 |]) + , (TypeName "jint", [t| Int32 |]) + , (TypeName "jlong", [t| Int64 |]) + , (TypeName "jfloat", [t| Float |]) + , (TypeName "jdouble", [t| Double |]) + -- Reference types + , (TypeName "jobject", [t| JObject |]) + , (TypeName "jclass", [t| JClass |]) + , (TypeName "jstring", [t| JString |]) + , (TypeName "jarray", [t| JObject |]) + , (TypeName "jobjectArray", [t| JObjectArray |]) + , (TypeName "jbooleanArray", [t| JBooleanArray |]) + , (TypeName "jbyteArray", [t| JByteArray |]) + , (TypeName "jcharArray", [t| JCharArray |]) + , (TypeName "jshortArray", [t| JShortArray |]) + , (TypeName "jintArray", [t| JIntArray |]) + , (TypeName "jlongArray", [t| JLongArray |]) + , (TypeName "jfloatArray", [t| JFloatArray |]) + , (TypeName "jdoubleArray", [t| JDoubleArray |]) + , (TypeName "jthrowable", [t| JThrowable |]) + -- Internal types + , (TypeName "JavaVM", [t| JVM |]) + , (TypeName "JNIEnv", [t| JNIEnv |]) + , (TypeName "jfieldID", [t| JFieldID |]) + , (TypeName "jmethodID", [t| JMethodID |]) + , (TypeName "jsize", [t| Int32 |]) + , (TypeName "jvalue", [t| JValue |]) + ]