jni (empty) → 0.1
raw patch · 8 files changed
+1454/−0 lines, 8 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, inline-c, singletons, thread-local-storage
Files
- LICENSE +30/−0
- README.md +11/−0
- Setup.hs +2/−0
- jni.cabal +39/−0
- src/Foreign/JNI.c +449/−0
- src/Foreign/JNI.hs +505/−0
- src/Foreign/JNI/String.hs +69/−0
- src/Foreign/JNI/Types.hs +349/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -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/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jni.cabal view
@@ -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
+ src/Foreign/JNI.c view
@@ -0,0 +1,449 @@++#include <jni.h>++#include <errno.h>++#include <stdlib.h>++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); ;+}+
+ src/Foreign/JNI.hs view
@@ -0,0 +1,505 @@+-- | Low-level bindings to the Java Native Interface (JNI).+--+-- Read the+-- <https://docs.oracle.com/javase/8/docs/technotes/guides/jni/spec/jniTOC.html JNI spec>+-- 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 "<jni.h>"+C.include "<errno.h>"+C.include "<stdlib.h>"++data JavaException = JavaException JThrowable+ deriving (Show, Typeable)++instance Exception JavaException++-- | Thrown when @Get<PrimitiveType>ArrayElements@ 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 "<init>" 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)); } |]
+ src/Foreign/JNI/String.hs view
@@ -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+-- <http://docs.oracle.com/javase/8/docs/technotes/guides/jni/spec/types.html#modified_utf_8_strings>+-- 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
+ src/Foreign/JNI/Types.hs view
@@ -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 |])+ ]