-- | 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 needs to be attached. See 'JNI.runInAttachedThread'.
--
-- The 'String' type in this module is the type of JNI strings. See
-- "Foreign.JNI.String".
--
-- The functions in this module are considered unsafe in opposition
-- to those in "Foreign.JNI.Safe", which ensure that local references are not
-- leaked.
--

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- XXX This file uses cpphs for preprocessing instead of the system's native
-- CPP, because the OS X has subtly different whitespace behaviour in the
-- presence of concatenation.

module Foreign.JNI.Unsafe
  ( -- * JNI functions
    -- ** VM management
    withJVM
  , newJVM
  , destroyJVM
    -- ** Class loading
  , defineClass
  , JNINativeMethod(..)
  , registerNatives
    -- ** String wrappers
  , ReferenceTypeName
  , MethodSignature
  , Signature
    -- ** Exceptions
  , JVMException(..)
  , throw
  , throwNew
    -- ** Query functions
  , findClass
  , getFieldID
  , getStaticFieldID
  , getMethodID
  , getStaticMethodID
  , getObjectClass
    -- ** Reference manipulation
  , newGlobalRef
  , deleteGlobalRef
  , newGlobalRefNonFinalized
  , deleteGlobalRefNonFinalized
  , newLocalRef
  , deleteLocalRef
  , pushLocalFrame
  , popLocalFrame
    -- ** Field accessor functions
    -- *** Get fields
  , getObjectField
  , getBooleanField
  , getIntField
  , getLongField
  , getCharField
  , getShortField
  , getByteField
  , getDoubleField
  , getFloatField
    -- *** Get static fields
  , getStaticObjectField
  , getStaticBooleanField
  , getStaticIntField
  , getStaticLongField
  , getStaticCharField
  , getStaticShortField
  , getStaticByteField
  , getStaticDoubleField
  , getStaticFloatField
    -- *** Set fields
  , setObjectField
  , setBooleanField
  , setIntField
  , setLongField
  , setCharField
  , setShortField
  , setByteField
  , setDoubleField
  , setFloatField
    -- *** Set static fields
  , setStaticObjectField
  , setStaticBooleanField
  , setStaticIntField
  , setStaticLongField
  , setStaticCharField
  , setStaticShortField
  , setStaticByteField
  , setStaticDoubleField
  , setStaticFloatField
    -- ** 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
  , ArrayCopyFailed(..)
  , NullPointerException(..)
  , getBooleanArrayElements
  , getByteArrayElements
  , getCharArrayElements
  , getShortArrayElements
  , getIntArrayElements
  , getLongArrayElements
  , getFloatArrayElements
  , getDoubleArrayElements
  , getStringChars
  , getBooleanArrayRegion
  , getByteArrayRegion
  , getCharArrayRegion
  , getShortArrayRegion
  , getIntArrayRegion
  , getLongArrayRegion
  , getFloatArrayRegion
  , getDoubleArrayRegion
  , setBooleanArrayRegion
  , setByteArrayRegion
  , setCharArrayRegion
  , setShortArrayRegion
  , setIntArrayRegion
  , setLongArrayRegion
  , setFloatArrayRegion
  , setDoubleArrayRegion
  , releaseBooleanArrayElements
  , releaseByteArrayElements
  , releaseCharArrayElements
  , releaseShortArrayElements
  , releaseIntArrayElements
  , releaseLongArrayElements
  , releaseFloatArrayElements
  , releaseDoubleArrayElements
  , releaseStringChars
  , getObjectArrayElement
  , setObjectArrayElement
    -- * Thread management
  , attachCurrentThreadAsDaemon
  , detachCurrentThread
  , runInAttachedThread
  , ThreadNotAttached(..)
    -- * NIO support
  , DirectBufferFailed(..)
  , newDirectByteBuffer
  , getDirectBufferAddress
  , getDirectBufferCapacity
  ) where

import Control.Concurrent (isCurrentThreadBound, rtsSupportsBoundThreads)
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
import Control.Exception (Exception, bracket, bracket_, catch, finally, throwIO)
import Control.Monad (join, unless, void, when)
import Data.Choice
import Data.Coerce
import Data.Int
import Data.IORef (IORef, newIORef, atomicModifyIORef)
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Foreign.C (CChar)
import Foreign.ForeignPtr
  ( finalizeForeignPtr
  , newForeignPtr_
  , withForeignPtr
  )
import Foreign.JNI.Internal
import Foreign.JNI.NativeMethod
import Foreign.JNI.Types
import qualified Foreign.JNI.String as JNI
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (peek)
import GHC.ForeignPtr (newConcForeignPtr)
import GHC.Stack (HasCallStack, callStack, getCallStack, prettySrcLoc)
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Unsafe as CU
import System.IO (fixIO)
import System.IO.Unsafe (unsafePerformIO)
import Prelude hiding (String)
import qualified Prelude

C.context (C.baseCtx <> C.bsCtx <> jniCtx)

C.include "<jni.h>"
C.include "<stdio.h>"
C.include "<errno.h>"
C.include "<stdlib.h>"

-- A thread-local variable to cache the JNI environment. Accessing this variable
-- is faster than calling @jvm->GetEnv()@.
$(C.verbatim "static __thread JNIEnv* jniEnv; ")

-- | A JNI call may cause a (Java) exception to be raised. This module raises it
-- as a Haskell exception wrapping the Java exception.
newtype JVMException = JVMException JThrowable
  deriving Int -> JVMException -> ShowS
[JVMException] -> ShowS
JVMException -> String
(Int -> JVMException -> ShowS)
-> (JVMException -> String)
-> ([JVMException] -> ShowS)
-> Show JVMException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMException] -> ShowS
$cshowList :: [JVMException] -> ShowS
show :: JVMException -> String
$cshow :: JVMException -> String
showsPrec :: Int -> JVMException -> ShowS
$cshowsPrec :: Int -> JVMException -> ShowS
Show

instance Exception JVMException

-- | 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 ArrayCopyFailed
Typeable ArrayCopyFailed
Typeable ArrayCopyFailed
-> Show ArrayCopyFailed
-> (ArrayCopyFailed -> SomeException)
-> (SomeException -> Maybe ArrayCopyFailed)
-> (ArrayCopyFailed -> String)
-> Exception ArrayCopyFailed
SomeException -> Maybe ArrayCopyFailed
ArrayCopyFailed -> String
ArrayCopyFailed -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ArrayCopyFailed -> String
$cdisplayException :: ArrayCopyFailed -> String
fromException :: SomeException -> Maybe ArrayCopyFailed
$cfromException :: SomeException -> Maybe ArrayCopyFailed
toException :: ArrayCopyFailed -> SomeException
$ctoException :: ArrayCopyFailed -> SomeException
$cp2Exception :: Show ArrayCopyFailed
$cp1Exception :: Typeable ArrayCopyFailed
Exception, Int -> ArrayCopyFailed -> ShowS
[ArrayCopyFailed] -> ShowS
ArrayCopyFailed -> String
(Int -> ArrayCopyFailed -> ShowS)
-> (ArrayCopyFailed -> String)
-> ([ArrayCopyFailed] -> ShowS)
-> Show ArrayCopyFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayCopyFailed] -> ShowS
$cshowList :: [ArrayCopyFailed] -> ShowS
show :: ArrayCopyFailed -> String
$cshow :: ArrayCopyFailed -> String
showsPrec :: Int -> ArrayCopyFailed -> ShowS
$cshowsPrec :: Int -> ArrayCopyFailed -> ShowS
Show)

-- Thrown when @NewDirectByteBuffer@ or @GetDirectBufferAddress@ returns NULL,
-- and when @GetDirectBufferCapacity@ return @-1@.
data DirectBufferFailed = DirectBufferFailed
  deriving (Show DirectBufferFailed
Typeable DirectBufferFailed
Typeable DirectBufferFailed
-> Show DirectBufferFailed
-> (DirectBufferFailed -> SomeException)
-> (SomeException -> Maybe DirectBufferFailed)
-> (DirectBufferFailed -> String)
-> Exception DirectBufferFailed
SomeException -> Maybe DirectBufferFailed
DirectBufferFailed -> String
DirectBufferFailed -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: DirectBufferFailed -> String
$cdisplayException :: DirectBufferFailed -> String
fromException :: SomeException -> Maybe DirectBufferFailed
$cfromException :: SomeException -> Maybe DirectBufferFailed
toException :: DirectBufferFailed -> SomeException
$ctoException :: DirectBufferFailed -> SomeException
$cp2Exception :: Show DirectBufferFailed
$cp1Exception :: Typeable DirectBufferFailed
Exception, Int -> DirectBufferFailed -> ShowS
[DirectBufferFailed] -> ShowS
DirectBufferFailed -> String
(Int -> DirectBufferFailed -> ShowS)
-> (DirectBufferFailed -> String)
-> ([DirectBufferFailed] -> ShowS)
-> Show DirectBufferFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirectBufferFailed] -> ShowS
$cshowList :: [DirectBufferFailed] -> ShowS
show :: DirectBufferFailed -> String
$cshow :: DirectBufferFailed -> String
showsPrec :: Int -> DirectBufferFailed -> ShowS
$cshowsPrec :: Int -> DirectBufferFailed -> ShowS
Show)

-- | A null reference is found where a non-null reference was expected.
data NullPointerException = NullPointerException
  deriving (Show NullPointerException
Typeable NullPointerException
Typeable NullPointerException
-> Show NullPointerException
-> (NullPointerException -> SomeException)
-> (SomeException -> Maybe NullPointerException)
-> (NullPointerException -> String)
-> Exception NullPointerException
SomeException -> Maybe NullPointerException
NullPointerException -> String
NullPointerException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: NullPointerException -> String
$cdisplayException :: NullPointerException -> String
fromException :: SomeException -> Maybe NullPointerException
$cfromException :: SomeException -> Maybe NullPointerException
toException :: NullPointerException -> SomeException
$ctoException :: NullPointerException -> SomeException
$cp2Exception :: Show NullPointerException
$cp1Exception :: Typeable NullPointerException
Exception, Int -> NullPointerException -> ShowS
[NullPointerException] -> ShowS
NullPointerException -> String
(Int -> NullPointerException -> ShowS)
-> (NullPointerException -> String)
-> ([NullPointerException] -> ShowS)
-> Show NullPointerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullPointerException] -> ShowS
$cshowList :: [NullPointerException] -> ShowS
show :: NullPointerException -> String
$cshow :: NullPointerException -> String
showsPrec :: Int -> NullPointerException -> ShowS
$cshowsPrec :: Int -> NullPointerException -> ShowS
Show)

-- | A JNI call is made from a thread not attached to the JVM.
data ThreadNotAttached = ThreadNotAttached
  deriving (Show ThreadNotAttached
Typeable ThreadNotAttached
Typeable ThreadNotAttached
-> Show ThreadNotAttached
-> (ThreadNotAttached -> SomeException)
-> (SomeException -> Maybe ThreadNotAttached)
-> (ThreadNotAttached -> String)
-> Exception ThreadNotAttached
SomeException -> Maybe ThreadNotAttached
ThreadNotAttached -> String
ThreadNotAttached -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ThreadNotAttached -> String
$cdisplayException :: ThreadNotAttached -> String
fromException :: SomeException -> Maybe ThreadNotAttached
$cfromException :: SomeException -> Maybe ThreadNotAttached
toException :: ThreadNotAttached -> SomeException
$ctoException :: ThreadNotAttached -> SomeException
$cp2Exception :: Show ThreadNotAttached
$cp1Exception :: Typeable ThreadNotAttached
Exception, Int -> ThreadNotAttached -> ShowS
[ThreadNotAttached] -> ShowS
ThreadNotAttached -> String
(Int -> ThreadNotAttached -> ShowS)
-> (ThreadNotAttached -> String)
-> ([ThreadNotAttached] -> ShowS)
-> Show ThreadNotAttached
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadNotAttached] -> ShowS
$cshowList :: [ThreadNotAttached] -> ShowS
show :: ThreadNotAttached -> String
$cshow :: ThreadNotAttached -> String
showsPrec :: Int -> ThreadNotAttached -> ShowS
$cshowsPrec :: Int -> ThreadNotAttached -> ShowS
Show)

-- | A JNI call is made from an unbound thread.
data ThreadNotBound = ThreadNotBound
  deriving (Show ThreadNotBound
Typeable ThreadNotBound
Typeable ThreadNotBound
-> Show ThreadNotBound
-> (ThreadNotBound -> SomeException)
-> (SomeException -> Maybe ThreadNotBound)
-> (ThreadNotBound -> String)
-> Exception ThreadNotBound
SomeException -> Maybe ThreadNotBound
ThreadNotBound -> String
ThreadNotBound -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ThreadNotBound -> String
$cdisplayException :: ThreadNotBound -> String
fromException :: SomeException -> Maybe ThreadNotBound
$cfromException :: SomeException -> Maybe ThreadNotBound
toException :: ThreadNotBound -> SomeException
$ctoException :: ThreadNotBound -> SomeException
$cp2Exception :: Show ThreadNotBound
$cp1Exception :: Typeable ThreadNotBound
Exception, Int -> ThreadNotBound -> ShowS
[ThreadNotBound] -> ShowS
ThreadNotBound -> String
(Int -> ThreadNotBound -> ShowS)
-> (ThreadNotBound -> String)
-> ([ThreadNotBound] -> ShowS)
-> Show ThreadNotBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadNotBound] -> ShowS
$cshowList :: [ThreadNotBound] -> ShowS
show :: ThreadNotBound -> String
$cshow :: ThreadNotBound -> String
showsPrec :: Int -> ThreadNotBound -> ShowS
$cshowsPrec :: Int -> ThreadNotBound -> ShowS
Show)

-- | Thrown when an JNI call is made from an unbound thread.
data JNIError = JNIError Prelude.String Int32
  deriving Int -> JNIError -> ShowS
[JNIError] -> ShowS
JNIError -> String
(Int -> JNIError -> ShowS)
-> (JNIError -> String) -> ([JNIError] -> ShowS) -> Show JNIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JNIError] -> ShowS
$cshowList :: [JNIError] -> ShowS
show :: JNIError -> String
$cshow :: JNIError -> String
showsPrec :: Int -> JNIError -> ShowS
$cshowsPrec :: Int -> JNIError -> ShowS
Show

instance Exception JNIError

-- | Map Java exceptions to Haskell exceptions.
throwIfException :: Ptr JNIEnv -> IO a -> IO a
throwIfException :: Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env IO a
m = IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` do
    Ptr JThrowable
excptr <- [CU.exp| jthrowable { (*$(JNIEnv *env))->ExceptionOccurred($(JNIEnv *env)) } |]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr JThrowable
excptr Ptr JThrowable -> Ptr JThrowable -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr JThrowable
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [CU.exp| void { (*$(JNIEnv *env))->ExceptionDescribe($(JNIEnv *env)) } |]
      [CU.exp| void { (*$(JNIEnv *env))->ExceptionClear($(JNIEnv *env)) } |]
      JVMException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (JVMException -> IO ())
-> (JThrowable -> JVMException) -> JThrowable -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JThrowable -> JVMException
JVMException (JThrowable -> IO ()) -> IO JThrowable -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JThrowable -> IO JThrowable
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
newGlobalRef (JThrowable -> IO JThrowable) -> IO JThrowable -> IO JThrowable
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr JThrowable -> IO JThrowable
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr Ptr JThrowable
excptr

-- | Check whether a pointer is null.
throwIfNull :: Exception e => e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull :: e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull e
e IO (Ptr a)
m = do
    Ptr a
ptr <- IO (Ptr a)
m
    if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
    then e -> IO (Ptr a)
forall e a. Exception e => e -> IO a
throwIO e
e
    else Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr

-- | Throws an error if the given reference is null, otherwise performs
-- the given io action.
throwIfJNull :: J ty -> IO a -> IO a
throwIfJNull :: J ty -> IO a -> IO a
throwIfJNull J ty
j IO a
io =
    if J ty
j J ty -> J ty -> Bool
forall a. Eq a => a -> a -> Bool
== J ty
forall (a :: JType). J a
jnull
    then NullPointerException -> IO a
forall e a. Exception e => e -> IO a
throwIO NullPointerException
NullPointerException
    else IO a
io

-- | A read-write lock
--
-- Concurrent readers are allowed, but only one writer is supported.
newtype RWLock =
    RWLock (IORef (Int, RWWantedState))
    -- ^ A count of the held read locks and the wanted state

-- | The wanted state of the RW
data RWWantedState
    = Reading            -- ^ There are no writers
    | Writing (MVar ())
       -- ^ A writer wants to write, grant no more read locks. The MVar is used
       -- to notify the writer when the currently held read locks are released.

-- | Creates a new read-write lock.
newRWLock :: IO RWLock
newRWLock :: IO RWLock
newRWLock = IORef (Int, RWWantedState) -> RWLock
RWLock (IORef (Int, RWWantedState) -> RWLock)
-> IO (IORef (Int, RWWantedState)) -> IO RWLock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, RWWantedState) -> IO (IORef (Int, RWWantedState))
forall a. a -> IO (IORef a)
newIORef (Int
0, RWWantedState
Reading)

-- | Tries to acquire a read lock. If this call returns `Do #read`, no writer
-- will be granted a lock before the read lock is released.
tryAcquireReadLock :: RWLock -> IO (Choice "read")
tryAcquireReadLock :: RWLock -> IO (Choice "read")
tryAcquireReadLock (RWLock IORef (Int, RWWantedState)
ref) = do
    IORef (Int, RWWantedState)
-> ((Int, RWWantedState) -> ((Int, RWWantedState), Choice "read"))
-> IO (Choice "read")
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Int, RWWantedState)
ref (((Int, RWWantedState) -> ((Int, RWWantedState), Choice "read"))
 -> IO (Choice "read"))
-> ((Int, RWWantedState) -> ((Int, RWWantedState), Choice "read"))
-> IO (Choice "read")
forall a b. (a -> b) -> a -> b
$ \case
      (!Int
readers,  RWWantedState
Reading) -> ((Int
readers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, RWWantedState
Reading),    Label "read" -> Choice "read"
forall (a :: Symbol). Label a -> Choice a
Do IsLabel "read" (Label "read")
Label "read"
#read)
      (Int, RWWantedState)
st                   -> (                       (Int, RWWantedState)
st, Label "read" -> Choice "read"
forall (a :: Symbol). Label a -> Choice a
Don't IsLabel "read" (Label "read")
Label "read"
#read)

-- | Releases a read lock.
releaseReadLock :: RWLock -> IO ()
releaseReadLock :: RWLock -> IO ()
releaseReadLock (RWLock IORef (Int, RWWantedState)
ref) = do
    (Int, RWWantedState)
st <- IORef (Int, RWWantedState)
-> ((Int, RWWantedState)
    -> ((Int, RWWantedState), (Int, RWWantedState)))
-> IO (Int, RWWantedState)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Int, RWWantedState)
ref (((Int, RWWantedState)
  -> ((Int, RWWantedState), (Int, RWWantedState)))
 -> IO (Int, RWWantedState))
-> ((Int, RWWantedState)
    -> ((Int, RWWantedState), (Int, RWWantedState)))
-> IO (Int, RWWantedState)
forall a b. (a -> b) -> a -> b
$
            \st :: (Int, RWWantedState)
st@(Int
readers, RWWantedState
aim) -> ((Int
readers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, RWWantedState
aim), (Int, RWWantedState)
st)
    case (Int, RWWantedState)
st of
      -- Notify the writer if I'm the last reader.
      (Int
1, Writing MVar ()
mv) -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
mv ()
      (Int, RWWantedState)
_               -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Waits until the current read locks are released and grants a write lock.
acquireWriteLock :: RWLock -> IO ()
acquireWriteLock :: RWLock -> IO ()
acquireWriteLock (RWLock IORef (Int, RWWantedState)
ref) = do
    MVar ()
mv <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef (Int, RWWantedState)
-> ((Int, RWWantedState) -> ((Int, RWWantedState), IO ()))
-> IO (IO ())
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Int, RWWantedState)
ref (((Int, RWWantedState) -> ((Int, RWWantedState), IO ()))
 -> IO (IO ()))
-> ((Int, RWWantedState) -> ((Int, RWWantedState), IO ()))
-> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \(Int
readers, RWWantedState
_) ->
      ((Int
readers, MVar () -> RWWantedState
Writing MVar ()
mv), Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
readers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mv))

-- | This lock is used to avoid the JVM from dying before any finalizers
-- deleting global references are finished.
--
-- Finalizers try to acquire read locks.
--
-- The JVM acquires a write lock before shutdown. Thence, finalizers fail to
-- acquire read locks and behave as noops.
globalJVMLock :: RWLock
globalJVMLock :: RWLock
globalJVMLock = IO RWLock -> RWLock
forall a. IO a -> a
unsafePerformIO IO RWLock
newRWLock
{-# NOINLINE globalJVMLock #-}

throwIfNotOK_ :: HasCallStack => IO Int32 -> IO ()
throwIfNotOK_ :: IO Int32 -> IO ()
throwIfNotOK_ IO Int32
m = IO Int32
m IO Int32 -> (Int32 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Int32
rc
    | Int32
rc Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== [CU.pure| jint { JNI_OK } |] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Int32
rc Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== [CU.pure| jint { JNI_EDETACHED } |] -> ThreadNotAttached -> IO ()
forall e a. Exception e => e -> IO a
throwIO ThreadNotAttached
ThreadNotAttached
    | Bool
otherwise -> JNIError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (JNIError -> IO ()) -> JNIError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> JNIError
JNIError (SrcLoc -> String
prettySrcLoc SrcLoc
loc) Int32
rc
  where
    (String
_, SrcLoc
loc):[(String, SrcLoc)]
_ = CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack

attachCurrentThreadAsDaemon :: IO ()
attachCurrentThreadAsDaemon :: IO ()
attachCurrentThreadAsDaemon = do
    HasCallStack => IO Int32 -> IO ()
IO Int32 -> IO ()
throwIfNotOK_
      [CU.exp| jint {
        (*$(JavaVM* jvm))->AttachCurrentThreadAsDaemon($(JavaVM* jvm), (void**)&jniEnv, NULL)
      } |]

detachCurrentThread :: IO ()
detachCurrentThread :: IO ()
detachCurrentThread =
    HasCallStack => IO Int32 -> IO ()
IO Int32 -> IO ()
throwIfNotOK_
    [CU.block| jint {
      int rc = (*$(JavaVM* jvm))->DetachCurrentThread($(JavaVM* jvm));
      if (rc == JNI_OK)
        jniEnv = NULL;
      return rc;
    } |]

-- | Attaches the calling thread to the JVM, runs the given IO action and
-- then detaches the thread.
--
-- If the thread is already attached no attaching and detaching is performed.
runInAttachedThread :: IO a -> IO a
runInAttachedThread :: IO a -> IO a
runInAttachedThread IO a
io = do
    Bool
attached <-
      IO Bool -> (ThreadNotAttached -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO (Ptr JNIEnv)
getJNIEnv IO (Ptr JNIEnv) -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\ThreadNotAttached
ThreadNotAttached -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
    if Bool
attached
    then IO a
io
    else IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
          IO ()
attachCurrentThreadAsDaemon
          IO ()
detachCurrentThread
          IO a
io

-- | The current JVM
--
-- Assumes there's at most one JVM. The current JNI spec (2016) says only
-- one JVM per process is supported anyways.
{-# NOINLINE jvm #-}
jvm :: Ptr JVM
jvm :: Ptr JVM
jvm = IO (Ptr JVM) -> Ptr JVM
forall a. IO a -> a
unsafePerformIO (IO (Ptr JVM) -> Ptr JVM) -> IO (Ptr JVM) -> Ptr JVM
forall a b. (a -> b) -> a -> b
$ (Ptr (Ptr JVM) -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr JVM) -> IO (Ptr JVM)) -> IO (Ptr JVM))
-> (Ptr (Ptr JVM) -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr JVM)
pjvm -> (Ptr Int32 -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Ptr JVM)) -> IO (Ptr JVM))
-> (Ptr Int32 -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
pnum_jvms -> do
    HasCallStack => IO Int32 -> IO ()
IO Int32 -> IO ()
throwIfNotOK_
      [CU.exp| jint {
        JNI_GetCreatedJavaVMs($(JavaVM** pjvm), 1, $(jsize* pnum_jvms))
      }|]
    Int32
num_jvms <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
pnum_jvms
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
num_jvms Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JNI_GetCreatedJavaVMs: No JVM has been initialized yet."
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
num_jvms Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JNI_GetCreatedJavaVMs: There are multiple JVMs but only one is supported."
    Ptr (Ptr JVM) -> IO (Ptr JVM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr JVM)
pjvm

-- | Yields the JNIEnv of the calling thread.
--
-- Yields @Nothing@ if the calling thread is not attached to the JVM.
getJNIEnv :: IO (Ptr JNIEnv)
getJNIEnv :: IO (Ptr JNIEnv)
getJNIEnv = [CU.exp| JNIEnv* { jniEnv } |] IO (Ptr JNIEnv)
-> (Ptr JNIEnv -> IO (Ptr JNIEnv)) -> IO (Ptr JNIEnv)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Ptr JNIEnv
env | Ptr JNIEnv
env Ptr JNIEnv -> Ptr JNIEnv -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr JNIEnv
forall a. Ptr a
nullPtr -> do
      HasCallStack => IO Int32 -> IO ()
IO Int32 -> IO ()
throwIfNotOK_
        [CU.exp| jint {
          (*$(JavaVM* jvm))->GetEnv($(JavaVM* jvm), (void**)&jniEnv, JNI_VERSION_1_6)
        }|]
      [CU.exp| JNIEnv* { jniEnv } |]
    Ptr JNIEnv
env -> Ptr JNIEnv -> IO (Ptr JNIEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr JNIEnv
env

-- | Run an action against the appropriate 'JNIEnv'.
--
-- Each OS thread has its own 'JNIEnv', which this function gives access to.
withJNIEnv :: (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv :: (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv Ptr JNIEnv -> IO a
f = IO (Ptr JNIEnv)
getJNIEnv IO (Ptr JNIEnv) -> (Ptr JNIEnv -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr JNIEnv -> IO a
f

useAsCStrings :: [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
useAsCStrings :: [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
useAsCStrings [ByteString]
strs [Ptr CChar] -> IO a
m =
  (ByteString -> ([Ptr CChar] -> IO a) -> [Ptr CChar] -> IO a)
-> ([Ptr CChar] -> IO a) -> [ByteString] -> [Ptr CChar] -> IO a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ByteString
str [Ptr CChar] -> IO a
k [Ptr CChar]
cstrs -> ByteString -> (Ptr CChar -> IO a) -> IO a
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
str ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstr -> [Ptr CChar] -> IO a
k (Ptr CChar
cstrPtr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
:[Ptr CChar]
cstrs)) [Ptr CChar] -> IO a
m [ByteString]
strs []

-- | Create a new JVM, with the given arguments. /Can only be called once/. Best
-- practice: use 'withJVM' instead. Only useful for GHCi.
newJVM :: [ByteString] -> IO JVM
newJVM :: [ByteString] -> IO JVM
newJVM [ByteString]
options = Ptr JVM -> JVM
JVM_ (Ptr JVM -> JVM) -> IO (Ptr JVM) -> IO JVM
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    [ByteString] -> ([Ptr CChar] -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a. [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
useAsCStrings [ByteString]
options (([Ptr CChar] -> IO (Ptr JVM)) -> IO (Ptr JVM))
-> ([Ptr CChar] -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cstrs -> do
      [Ptr CChar] -> (Ptr (Ptr CChar) -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr CChar]
cstrs ((Ptr (Ptr CChar) -> IO (Ptr JVM)) -> IO (Ptr JVM))
-> (Ptr (Ptr CChar) -> IO (Ptr JVM)) -> IO (Ptr JVM)
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr CChar)
coptions :: Ptr (Ptr CChar)) -> do
        let n :: CInt
n = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Ptr CChar] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr CChar]
cstrs) :: C.CInt
        IO ()
checkBoundness
        [C.block| JavaVM * {
          JavaVM *jvm;
          JavaVMInitArgs vm_args;
          JavaVMOption *options = malloc(sizeof(JavaVMOption) * $(int n));
          for(int i = 0; i < $(int n); i++)
                  options[i].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**)&jniEnv, &vm_args);
          free(options);
          return jvm; } |]

  where
    checkBoundness :: IO ()
    checkBoundness :: IO ()
checkBoundness = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rtsSupportsBoundThreads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
bound <- IO Bool
isCurrentThreadBound
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
bound (ThreadNotBound -> IO ()
forall e a. Exception e => e -> IO a
throwIO ThreadNotBound
ThreadNotBound)

-- | Deallocate a 'JVM' created using 'newJVM'.
destroyJVM :: JVM -> IO ()
destroyJVM :: JVM -> IO ()
destroyJVM (JVM_ Ptr JVM
jvm) = do
    RWLock -> IO ()
acquireWriteLock RWLock
globalJVMLock
    [C.block| void {
        (*$(JavaVM *jvm))->DestroyJavaVM($(JavaVM *jvm));
        jniEnv = NULL;
    } |]

-- | Create a new JVM, with the given arguments. Destroy it once the given
-- action completes. /Can only be called once/. Best practice: use it to wrap
-- your @main@ function.
withJVM :: [ByteString] -> IO a -> IO a
withJVM :: [ByteString] -> IO a -> IO a
withJVM [ByteString]
options IO a
action = IO JVM -> (JVM -> IO ()) -> (JVM -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([ByteString] -> IO JVM
newJVM [ByteString]
options) JVM -> IO ()
destroyJVM (IO a -> JVM -> IO a
forall a b. a -> b -> a
const IO a
action)

defineClass
  :: Coercible o (J ('Class "java.lang.ClassLoader"))
  => ReferenceTypeName -- ^ Class name
  -> o -- ^ Loader
  -> ByteString -- ^ Bytecode buffer
  -> IO JClass
defineClass :: ReferenceTypeName -> o -> ByteString -> IO JClass
defineClass (ReferenceTypeName -> String
coerce -> String
name) (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
loader) ByteString
buf = (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JClass) -> IO JClass)
-> (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JClass -> IO JClass
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JClass -> IO JClass) -> IO JClass -> IO JClass
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JClass) -> IO JClass
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
name ((Ptr CChar -> IO JClass) -> IO JClass)
-> (Ptr CChar -> IO JClass) -> IO JClass
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namep ->
    Ptr JClass -> IO JClass
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JClass -> IO JClass) -> IO (Ptr JClass) -> IO JClass
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [CU.exp| jclass {
      (*$(JNIEnv *env))->DefineClass($(JNIEnv *env),
                                     $(char *namep),
                                     $fptr-ptr:(jobject loader),
                                     $bs-ptr:buf,
                                     $bs-len:buf) } |]
registerNatives
  :: JClass
  -> [JNINativeMethod]
  -> IO ()
registerNatives :: JClass -> [JNINativeMethod] -> IO ()
registerNatives JClass
cls [JNINativeMethod]
methods = (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO () -> IO ()
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [JNINativeMethod] -> (Ptr JNINativeMethod -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [JNINativeMethod]
methods ((Ptr JNINativeMethod -> IO ()) -> IO ())
-> (Ptr JNINativeMethod -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNINativeMethod
cmethods -> do
      let numMethods :: CInt
numMethods = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [JNINativeMethod] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JNINativeMethod]
methods
      Int32
_ <- [CU.exp| jint {
             (*$(JNIEnv *env))->RegisterNatives($(JNIEnv *env),
                                                $fptr-ptr:(jclass cls),
                                                $(JNINativeMethod *cmethods),
                                                $(int numMethods)) } |]
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

throw :: Coercible o (J a) => o -> IO ()
throw :: o -> IO ()
throw (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env -> IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [CU.exp| jint {
       (*$(JNIEnv *env))->Throw($(JNIEnv *env),
                                $fptr-ptr:(jobject obj)) } |]

throwNew :: JClass -> JNI.String -> IO ()
throwNew :: JClass -> String -> IO ()
throwNew JClass
cls String
msg = JClass -> IO () -> IO ()
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
msg ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
msgp -> IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [CU.exp| jint {
       (*$(JNIEnv *env))->ThrowNew($(JNIEnv *env),
                                   $fptr-ptr:(jclass cls),
                                   $(char *msgp)) } |]

findClass
  :: ReferenceTypeName -- ^ Class name
  -> IO JClass
findClass :: ReferenceTypeName -> IO JClass
findClass (ReferenceTypeName -> String
coerce -> String
name) = (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JClass) -> IO JClass)
-> (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JClass -> IO JClass
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JClass -> IO JClass) -> IO JClass -> IO JClass
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JClass) -> IO JClass
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
name ((Ptr CChar -> IO JClass) -> IO JClass)
-> (Ptr CChar -> IO JClass) -> IO JClass
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namep ->
    Ptr JClass -> IO JClass
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JClass -> IO JClass) -> IO (Ptr JClass) -> IO JClass
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [CU.exp| jclass { (*$(JNIEnv *env))->FindClass($(JNIEnv *env), $(char *namep)) } |]

newObject :: JClass -> MethodSignature -> [JValue] -> IO JObject
newObject :: JClass -> MethodSignature -> [JValue] -> IO JObject
newObject JClass
cls (MethodSignature -> MethodSignature
coerce -> MethodSignature
sig) [JValue]
args = JClass -> IO JObject -> IO JObject
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JObject -> IO JObject) -> IO JObject -> IO JObject
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO JObject) -> IO JObject
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JObject) -> IO JObject)
-> (Ptr JNIEnv -> IO JObject) -> IO JObject
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JObject -> IO JObject
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JObject -> IO JObject) -> IO JObject -> IO JObject
forall a b. (a -> b) -> a -> b
$
    [JValue] -> (Ptr JValue -> IO JObject) -> IO JObject
forall a. [JValue] -> (Ptr JValue -> IO a) -> IO a
withJValues [JValue]
args ((Ptr JValue -> IO JObject) -> IO JObject)
-> (Ptr JValue -> IO JObject) -> IO JObject
forall a b. (a -> b) -> a -> b
$ \Ptr JValue
cargs -> do
      JMethodID
constr <- JClass -> String -> MethodSignature -> IO JMethodID
getMethodID JClass
cls String
"<init>" MethodSignature
sig
      Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CU.exp| jobject {
        (*$(JNIEnv *env))->NewObjectA($(JNIEnv *env),
                                      $fptr-ptr:(jclass cls),
                                      $(jmethodID constr),
                                      $(jvalue *cargs)) } |]

getFieldID
  :: JClass -- ^ A class object as returned by 'findClass'
  -> JNI.String -- ^ Field name
  -> Signature -- ^ JNI signature
  -> IO JFieldID
getFieldID :: JClass -> String -> Signature -> IO JFieldID
getFieldID JClass
cls String
fieldname (Signature -> String
coerce -> String
sig) = JClass -> IO JFieldID -> IO JFieldID
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JFieldID -> IO JFieldID) -> IO JFieldID -> IO JFieldID
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JFieldID) -> IO JFieldID
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JFieldID) -> IO JFieldID)
-> (Ptr JNIEnv -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JFieldID -> IO JFieldID
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JFieldID -> IO JFieldID) -> IO JFieldID -> IO JFieldID
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
fieldname ((Ptr CChar -> IO JFieldID) -> IO JFieldID)
-> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fieldnamep ->
    String -> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
sig ((Ptr CChar -> IO JFieldID) -> IO JFieldID)
-> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sigp ->
    [CU.exp| jfieldID {
      (*$(JNIEnv *env))->GetFieldID($(JNIEnv *env),
                                    $fptr-ptr:(jclass cls),
                                    $(char *fieldnamep),
                                    $(char *sigp)) } |]

getStaticFieldID
  :: JClass -- ^ A class object as returned by 'findClass'
  -> JNI.String -- ^ Field name
  -> Signature -- ^ JNI signature
  -> IO JFieldID
getStaticFieldID :: JClass -> String -> Signature -> IO JFieldID
getStaticFieldID JClass
cls String
fieldname (Signature -> String
coerce -> String
sig) = JClass -> IO JFieldID -> IO JFieldID
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JFieldID -> IO JFieldID) -> IO JFieldID -> IO JFieldID
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JFieldID) -> IO JFieldID
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JFieldID) -> IO JFieldID)
-> (Ptr JNIEnv -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JFieldID -> IO JFieldID
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JFieldID -> IO JFieldID) -> IO JFieldID -> IO JFieldID
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
fieldname ((Ptr CChar -> IO JFieldID) -> IO JFieldID)
-> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fieldnamep ->
    String -> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
sig ((Ptr CChar -> IO JFieldID) -> IO JFieldID)
-> (Ptr CChar -> IO JFieldID) -> IO JFieldID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sigp ->
    [CU.exp| jfieldID {
      (*$(JNIEnv *env))->GetStaticFieldID($(JNIEnv *env),
                                          $fptr-ptr:(jclass cls),
                                          $(char *fieldnamep),
                                          $(char *sigp)) } |]

#define GET_FIELD(name, hs_rettype, c_rettype) \
get/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> IO hs_rettype; \
get/**/name/**/Field (coerce -> upcast -> obj) field = withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.exp| c_rettype { \
      (*$(JNIEnv *env))->Get/**/name/**/Field($(JNIEnv *env), \
                                              $fptr-ptr:(jobject obj), \
                                              $(jfieldID field)) } |]

getObjectField :: Coercible o (J a) => o -> JFieldID -> IO JObject
getObjectField :: o -> JFieldID -> IO JObject
getObjectField o
x JFieldID
y =
    let GET_FIELD(Object, (Ptr JObject), jobject)
    in Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< o -> JFieldID -> IO (Ptr JObject)
forall o (a :: JType).
Coercible o (J a) =>
o -> JFieldID -> IO (Ptr JObject)
getObjectField o
x JFieldID
y
GET_FIELD(Boolean, Word8, jboolean)
GET_FIELD(Byte, CChar, jbyte)
GET_FIELD(Char, Word16, jchar)
GET_FIELD(Short, Int16, jshort)
GET_FIELD(Int, Int32, jint)
GET_FIELD(Long, Int64, jlong)
GET_FIELD(Float, Float, jfloat)
GET_FIELD(Double, Double, jdouble)

#define GET_STATIC_FIELD(name, hs_rettype, c_rettype) \
getStatic/**/name/**/Field :: JClass -> JFieldID -> IO hs_rettype; \
getStatic/**/name/**/Field klass field = throwIfJNull klass $ \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.exp| c_rettype { \
      (*$(JNIEnv *env))->GetStatic/**/name/**/Field($(JNIEnv *env), \
                                                    $fptr-ptr:(jclass klass), \
                                                    $(jfieldID field)) } |]

getStaticObjectField :: JClass -> JFieldID -> IO JObject
getStaticObjectField :: JClass -> JFieldID -> IO JObject
getStaticObjectField JClass
x JFieldID
y =
    let GET_STATIC_FIELD(Object, (Ptr JObject), jobject)
    in Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JClass -> JFieldID -> IO (Ptr JObject)
getStaticObjectField JClass
x JFieldID
y
GET_STATIC_FIELD(Boolean, Word8, jboolean)
GET_STATIC_FIELD(Byte, CChar, jbyte)
GET_STATIC_FIELD(Char, Word16, jchar)
GET_STATIC_FIELD(Short, Int16, jshort)
GET_STATIC_FIELD(Int, Int32, jint)
GET_STATIC_FIELD(Long, Int64, jlong)
GET_STATIC_FIELD(Float, Float, jfloat)
GET_STATIC_FIELD(Double, Double, jdouble)

#define SET_FIELD(name, hs_fieldtype, c_fieldtype) \
set/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> hs_fieldtype -> IO (); \
set/**/name/**/Field (coerce -> upcast -> obj) field x = \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.block| void { \
      (*$(JNIEnv *env))->Set/**/name/**/Field($(JNIEnv *env), \
                                              $fptr-ptr:(jobject obj), \
                                              $(jfieldID field), \
                                              $(c_fieldtype x)); } |]

setObjectField :: Coercible o (J a) => o -> JFieldID -> JObject -> IO ()
setObjectField :: o -> JFieldID -> JObject -> IO ()
setObjectField o
x JFieldID
y JObject
z =
    let SET_FIELD(Object, (Ptr JObject), jobject)
    in ForeignPtr JObject -> (Ptr JObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (JObject -> ForeignPtr JObject
coerce JObject
z) (o -> JFieldID -> Ptr JObject -> IO ()
forall o (a :: JType).
Coercible o (J a) =>
o -> JFieldID -> Ptr JObject -> IO ()
setObjectField o
x JFieldID
y)
SET_FIELD(Boolean, Word8, jboolean)
SET_FIELD(Byte, CChar, jbyte)
SET_FIELD(Char, Word16, jchar)
SET_FIELD(Short, Int16, jshort)
SET_FIELD(Int, Int32, jint)
SET_FIELD(Long, Int64, jlong)
SET_FIELD(Float, Float, jfloat)
SET_FIELD(Double, Double, jdouble)

#define SET_STATIC_FIELD(name, hs_fieldtype, c_fieldtype) \
setStatic/**/name/**/Field :: JClass -> JFieldID -> hs_fieldtype -> IO (); \
setStatic/**/name/**/Field klass field x = throwIfJNull klass $ \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.block| void { \
      (*$(JNIEnv *env))->SetStatic/**/name/**/Field($(JNIEnv *env), \
                                                    $fptr-ptr:(jclass klass), \
                                                    $(jfieldID field), \
                                                    $(c_fieldtype x)); } |]

setStaticObjectField :: JClass -> JFieldID -> JObject -> IO ()
setStaticObjectField :: JClass -> JFieldID -> JObject -> IO ()
setStaticObjectField JClass
x JFieldID
y JObject
z =
    let SET_STATIC_FIELD(Object, (Ptr JObject), jobject)
    in ForeignPtr JObject -> (Ptr JObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (JObject -> ForeignPtr JObject
coerce JObject
z) (JClass -> JFieldID -> Ptr JObject -> IO ()
setStaticObjectField JClass
x JFieldID
y)
SET_STATIC_FIELD(Boolean, Word8, jboolean)
SET_STATIC_FIELD(Byte, CChar, jbyte)
SET_STATIC_FIELD(Char, Word16, jchar)
SET_STATIC_FIELD(Short, Int16, jshort)
SET_STATIC_FIELD(Int, Int32, jint)
SET_STATIC_FIELD(Long, Int64, jlong)
SET_STATIC_FIELD(Float, Float, jfloat)
SET_STATIC_FIELD(Double, Double, jdouble)

getMethodID
  :: JClass -- ^ A class object as returned by 'findClass'
  -> JNI.String -- ^ Field name
  -> MethodSignature -- ^ JNI signature
  -> IO JMethodID
getMethodID :: JClass -> String -> MethodSignature -> IO JMethodID
getMethodID JClass
cls String
methodname (MethodSignature -> String
coerce -> String
sig) = JClass -> IO JMethodID -> IO JMethodID
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JMethodID -> IO JMethodID) -> IO JMethodID -> IO JMethodID
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JMethodID) -> IO JMethodID
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JMethodID) -> IO JMethodID)
-> (Ptr JNIEnv -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JMethodID -> IO JMethodID
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JMethodID -> IO JMethodID) -> IO JMethodID -> IO JMethodID
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
methodname ((Ptr CChar -> IO JMethodID) -> IO JMethodID)
-> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
methodnamep ->
    String -> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
sig ((Ptr CChar -> IO JMethodID) -> IO JMethodID)
-> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sigp ->
    [CU.exp| jmethodID {
      (*$(JNIEnv *env))->GetMethodID($(JNIEnv *env),
                                     $fptr-ptr:(jclass cls),
                                     $(char *methodnamep),
                                     $(char *sigp)) } |]

getStaticMethodID
  :: JClass -- ^ A class object as returned by 'findClass'
  -> JNI.String -- ^ Field name
  -> MethodSignature -- ^ JNI signature
  -> IO JMethodID
getStaticMethodID :: JClass -> String -> MethodSignature -> IO JMethodID
getStaticMethodID JClass
cls String
methodname (MethodSignature -> String
coerce -> String
sig) = JClass -> IO JMethodID -> IO JMethodID
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JMethodID -> IO JMethodID) -> IO JMethodID -> IO JMethodID
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JMethodID) -> IO JMethodID
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JMethodID) -> IO JMethodID)
-> (Ptr JNIEnv -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JMethodID -> IO JMethodID
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JMethodID -> IO JMethodID) -> IO JMethodID -> IO JMethodID
forall a b. (a -> b) -> a -> b
$
    String -> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
methodname ((Ptr CChar -> IO JMethodID) -> IO JMethodID)
-> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
methodnamep ->
    String -> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a. String -> (Ptr CChar -> IO a) -> IO a
JNI.withString String
sig ((Ptr CChar -> IO JMethodID) -> IO JMethodID)
-> (Ptr CChar -> IO JMethodID) -> IO JMethodID
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sigp ->
    [CU.exp| jmethodID {
      (*$(JNIEnv *env))->GetStaticMethodID($(JNIEnv *env),
                                           $fptr-ptr:(jclass cls),
                                           $(char *methodnamep),
                                           $(char *sigp)) } |]

getObjectClass :: Coercible o (J ty) => o -> IO JClass
getObjectClass :: o -> IO JClass
getObjectClass (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = JObject -> IO JClass -> IO JClass
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObject
obj (IO JClass -> IO JClass) -> IO JClass -> IO JClass
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JClass) -> IO JClass)
-> (Ptr JNIEnv -> IO JClass) -> IO JClass
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JClass -> IO JClass
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JClass -> IO JClass) -> IO (Ptr JClass) -> IO JClass
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [CU.exp| jclass {
      (*$(JNIEnv *env))->GetObjectClass($(JNIEnv *env),
                                        $fptr-ptr:(jobject obj)) } |]

-- | Creates a global reference to the object referred to by
-- the given reference.
--
-- Arranges for a finalizer to call 'deleteGlobalRef' when the
-- global reference is no longer reachable on the Haskell side.
newGlobalRef :: Coercible o (J ty) => o -> IO o
newGlobalRef :: o -> IO o
newGlobalRef (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO o) -> IO o
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO o) -> IO o) -> (Ptr JNIEnv -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env -> do
    Ptr JObject
gobj <-
      [CU.exp| jobject {
        (*$(JNIEnv *env))->NewGlobalRef($(JNIEnv *env),
                                        $fptr-ptr:(jobject obj)) } |]
    (o -> IO o) -> IO o
forall a. (a -> IO a) -> IO a
fixIO ((o -> IO o) -> IO o) -> (o -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \o
j ->
      JObject -> o
coerce (JObject -> o)
-> (ForeignPtr JObject -> JObject) -> ForeignPtr JObject -> o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr JObject -> JObject
forall (a :: JType). ForeignPtr (J a) -> J a
J (ForeignPtr JObject -> o) -> IO (ForeignPtr JObject) -> IO o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr JObject -> IO () -> IO (ForeignPtr JObject)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newConcForeignPtr Ptr JObject
gobj (o -> IO ()
forall o (ty :: JType). Coercible o (J ty) => o -> IO ()
deleteGlobalRefNonFinalized o
j)

deleteGlobalRef :: Coercible o (J ty) => o -> IO ()
deleteGlobalRef :: o -> IO ()
deleteGlobalRef (o -> J Any
coerce -> J ForeignPtr (J Any)
p) = ForeignPtr (J Any) -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr (J Any)
p

-- | Like 'newGlobalRef' but it doesn't attach a finalizer to destroy
-- the reference when it is not longer reachable. Use
-- 'deleteGlobalRefNonFinalized' to destroy this reference.
newGlobalRefNonFinalized :: Coercible o (J ty) => o -> IO o
newGlobalRefNonFinalized :: o -> IO o
newGlobalRefNonFinalized (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO o) -> IO o
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO o) -> IO o) -> (Ptr JNIEnv -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env -> do
    Ptr JObject
gobj <-
      [CU.exp| jobject {
        (*$(JNIEnv *env))->NewGlobalRef($(JNIEnv *env),
                                        $fptr-ptr:(jobject obj)) } |]
    JObject -> o
coerce (JObject -> o)
-> (ForeignPtr JObject -> JObject) -> ForeignPtr JObject -> o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr JObject -> JObject
forall (a :: JType). ForeignPtr (J a) -> J a
J (ForeignPtr JObject -> o) -> IO (ForeignPtr JObject) -> IO o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr JObject -> IO (ForeignPtr JObject)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr JObject
gobj

-- | Like 'deleteGlobalRef' but it can be used only on references created with
-- 'newGlobalRefNonFinalized'.
deleteGlobalRefNonFinalized :: Coercible o (J ty) => o -> IO ()
deleteGlobalRefNonFinalized :: o -> IO ()
deleteGlobalRefNonFinalized (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = do
    IO (Choice "read")
-> (Choice "read" -> IO ()) -> (Choice "read" -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (RWLock -> IO (Choice "read")
tryAcquireReadLock RWLock
globalJVMLock)
            (\Choice "read"
doRead -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Choice "read" -> Bool
forall (a :: Symbol). Choice a -> Bool
toBool Choice "read"
doRead) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RWLock -> IO ()
releaseReadLock RWLock
globalJVMLock)
            ((Choice "read" -> IO ()) -> IO ())
-> (Choice "read" -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Choice "read"
doRead ->
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Choice "read" -> Bool
forall (a :: Symbol). Choice a -> Bool
toBool Choice "read"
doRead) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env -> do
        [CU.block| void { (*$(JNIEnv *env))->DeleteGlobalRef($(JNIEnv *env)
                                                            ,$fptr-ptr:(jobject obj));
                        } |]

-- NB: Cannot add a finalizer to local references because it may
-- run in a thread where the reference is not valid.
newLocalRef :: Coercible o (J ty) => o -> IO o
newLocalRef :: o -> IO o
newLocalRef (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO o) -> IO o
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO o) -> IO o) -> (Ptr JNIEnv -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    JObject -> o
coerce (JObject -> o) -> IO JObject -> IO o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    [CU.exp| jobject {
      (*$(JNIEnv *env))->NewLocalRef($(JNIEnv *env),
                                     $fptr-ptr:(jobject obj)) } |]

deleteLocalRef :: Coercible o (J ty) => o -> IO ()
deleteLocalRef :: o -> IO ()
deleteLocalRef (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    [CU.exp| void {
      (*$(JNIEnv *env))->DeleteLocalRef($(JNIEnv *env),
                                        $fptr-ptr:(jobject obj)) } |]

pushLocalFrame :: Int32 -> IO ()
pushLocalFrame :: Int32 -> IO ()
pushLocalFrame (Int32 -> Int32
coerce -> Int32
capacity) = (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    -- We ignore the output as it is always 0 on success and throws an
    -- exception otherwise.
    Ptr JNIEnv -> IO () -> IO ()
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$
    [CU.block| jint {
      (*$(JNIEnv *env))->PushLocalFrame($(JNIEnv *env),
                                        $(jint capacity)); } |]

popLocalFrame :: Coercible o (J ty) => o -> IO o
popLocalFrame :: o -> IO o
popLocalFrame (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
obj) = (Ptr JNIEnv -> IO o) -> IO o
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO o) -> IO o) -> (Ptr JNIEnv -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    JObject -> o
coerce (JObject -> o) -> IO JObject -> IO o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    [CU.exp| jobject {
      (*$(JNIEnv *env))->PopLocalFrame($(JNIEnv *env),
                                       $fptr-ptr:(jobject obj)) } |]

-- 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 $ \
    withJValues args $ \cargs -> \
    [C.exp| c_rettype { \
      (*$(JNIEnv *env))->Call/**/name/**/MethodA($(JNIEnv *env), \
                                                 $fptr-ptr:(jobject obj), \
                                                 $(jmethodID method), \
                                                 $(jvalue *cargs)) } |]

CALL_METHOD(Void, (), void)
callObjectMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO JObject
callObjectMethod :: o -> JMethodID -> [JValue] -> IO JObject
callObjectMethod o
x JMethodID
y [JValue]
z =
    let CALL_METHOD(Object, (Ptr JObject), jobject)
    in Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< o -> JMethodID -> [JValue] -> IO (Ptr JObject)
forall o (a :: JType).
Coercible o (J a) =>
o -> JMethodID -> [JValue] -> IO (Ptr JObject)
callObjectMethod o
x JMethodID
y [JValue]
z
callBooleanMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO Bool
callBooleanMethod :: o -> JMethodID -> [JValue] -> IO Bool
callBooleanMethod o
x JMethodID
y [JValue]
z =
    let CALL_METHOD(Boolean, Word8, jboolean)
    in Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Bool) -> IO Word8 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> o -> JMethodID -> [JValue] -> IO Word8
forall o (a :: JType).
Coercible o (J a) =>
o -> JMethodID -> [JValue] -> IO Word8
callBooleanMethod o
x JMethodID
y [JValue]
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 = throwIfJNull cls $ \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    withJValues args $ \cargs -> \
    [C.exp| c_rettype { \
      (*$(JNIEnv *env))->CallStatic/**/name/**/MethodA($(JNIEnv *env), \
                                                       $fptr-ptr:(jclass cls), \
                                                       $(jmethodID method), \
                                                       $(jvalue *cargs)) } |]

CALL_STATIC_METHOD(Void, (), void)
callStaticObjectMethod :: JClass -> JMethodID -> [JValue] -> IO JObject
callStaticObjectMethod :: JClass -> JMethodID -> [JValue] -> IO JObject
callStaticObjectMethod JClass
x JMethodID
y [JValue]
z =
    let CALL_STATIC_METHOD(Object, (Ptr JObject), jobject)
    in Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JClass -> JMethodID -> [JValue] -> IO (Ptr JObject)
callStaticObjectMethod JClass
x JMethodID
y [JValue]
z
callStaticBooleanMethod :: JClass -> JMethodID -> [JValue] -> IO Bool
callStaticBooleanMethod :: JClass -> JMethodID -> [JValue] -> IO Bool
callStaticBooleanMethod JClass
x JMethodID
y [JValue]
z =
    let CALL_STATIC_METHOD(Boolean, Word8, jboolean)
    in Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Bool) -> IO Word8 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JClass -> JMethodID -> [JValue] -> IO Word8
callStaticBooleanMethod JClass
x JMethodID
y [JValue]
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 :: Int32 -> JClass -> IO JObjectArray
newObjectArray Int32
sz JClass
cls = JClass -> IO JObjectArray -> IO JObjectArray
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JClass
cls (IO JObjectArray -> IO JObjectArray)
-> IO JObjectArray -> IO JObjectArray
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO JObjectArray) -> IO JObjectArray
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JObjectArray) -> IO JObjectArray)
-> (Ptr JNIEnv -> IO JObjectArray) -> IO JObjectArray
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JObjectArray -> IO JObjectArray
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JObjectArray -> IO JObjectArray)
-> IO JObjectArray -> IO JObjectArray
forall a b. (a -> b) -> a -> b
$
    Ptr JObjectArray -> IO JObjectArray
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObjectArray -> IO JObjectArray)
-> IO (Ptr JObjectArray) -> IO JObjectArray
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [CU.exp| jobjectArray {
      (*$(JNIEnv *env))->NewObjectArray($(JNIEnv *env),
                                        $(jsize sz),
                                        $fptr-ptr:(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 $ \
    objectFromPtr =<< \
    [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 Word16 -> Int32 -> IO JString
newString Ptr Word16
ptr Int32
len = (Ptr JNIEnv -> IO JString) -> IO JString
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JString) -> IO JString)
-> (Ptr JNIEnv -> IO JString) -> IO JString
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    Ptr JNIEnv -> IO JString -> IO JString
forall a. Ptr JNIEnv -> IO a -> IO a
throwIfException Ptr JNIEnv
env (IO JString -> IO JString) -> IO JString -> IO JString
forall a b. (a -> b) -> a -> b
$
    Ptr JString -> IO JString
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JString -> IO JString) -> IO (Ptr JString) -> IO JString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [CU.exp| jstring {
      (*$(JNIEnv *env))->NewString($(JNIEnv *env),
                                   $(jchar *ptr),
                                   $(jsize len)) } |]

getArrayLength :: Coercible o (JArray a) => o -> IO Int32
getArrayLength :: o -> IO Int32
getArrayLength (o -> J Any
coerce -> J Any -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
array) = JObject -> IO Int32 -> IO Int32
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObject
array (IO Int32 -> IO Int32) -> IO Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO Int32) -> IO Int32
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO Int32) -> IO Int32)
-> (Ptr JNIEnv -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    [C.exp| jsize {
      (*$(JNIEnv *env))->GetArrayLength($(JNIEnv *env),
                                        $fptr-ptr:(jarray array)) } |]

getStringLength :: JString -> IO Int32
getStringLength :: JString -> IO Int32
getStringLength JString
jstr = JString -> IO Int32 -> IO Int32
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JString
jstr (IO Int32 -> IO Int32) -> IO Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO Int32) -> IO Int32
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO Int32) -> IO Int32)
-> (Ptr JNIEnv -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    [CU.exp| jsize {
      (*$(JNIEnv *env))->GetStringLength($(JNIEnv *env),
                                         $fptr-ptr:(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) = throwIfJNull array $ \
    withJNIEnv $ \env -> \
    throwIfNull ArrayCopyFailed $ \
    [CU.exp| c_rettype* { \
      (*$(JNIEnv *env))->Get/**/name/**/ArrayElements($(JNIEnv *env), \
                                                      $fptr-ptr:(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 :: JString -> IO (Ptr Word16)
getStringChars JString
jstr = JString -> IO (Ptr Word16) -> IO (Ptr Word16)
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JString
jstr (IO (Ptr Word16) -> IO (Ptr Word16))
-> IO (Ptr Word16) -> IO (Ptr Word16)
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO (Ptr Word16)) -> IO (Ptr Word16)
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO (Ptr Word16)) -> IO (Ptr Word16))
-> (Ptr JNIEnv -> IO (Ptr Word16)) -> IO (Ptr Word16)
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    ArrayCopyFailed -> IO (Ptr Word16) -> IO (Ptr Word16)
forall e a. Exception e => e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull ArrayCopyFailed
ArrayCopyFailed (IO (Ptr Word16) -> IO (Ptr Word16))
-> IO (Ptr Word16) -> IO (Ptr Word16)
forall a b. (a -> b) -> a -> b
$
    [CU.exp| const jchar* {
      (*$(JNIEnv *env))->GetStringChars($(JNIEnv *env),
                                        $fptr-ptr:(jstring jstr),
                                        NULL) } |]

#define GET_ARRAY_REGION(name, hs_argtype, c_argtype) \
get/**/name/**/ArrayRegion :: J/**/name/**/Array -> Int32 -> Int32 -> Ptr hs_argtype -> IO (); \
get/**/name/**/ArrayRegion array start len buf = throwIfJNull array $ \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.exp| void { \
      (*$(JNIEnv *env))->Get/**/name/**/ArrayRegion($(JNIEnv *env), \
                                                    $fptr-ptr:(c_argtype/**/Array array), \
                                                    $(jsize start), \
                                                    $(jsize len), \
                                                    $(c_argtype *buf)) } |]

GET_ARRAY_REGION(Boolean, Word8, jboolean)
GET_ARRAY_REGION(Byte, CChar, jbyte)
GET_ARRAY_REGION(Char, Word16, jchar)
GET_ARRAY_REGION(Short, Int16, jshort)
GET_ARRAY_REGION(Int, Int32, jint)
GET_ARRAY_REGION(Long, Int64, jlong)
GET_ARRAY_REGION(Float, Float, jfloat)
GET_ARRAY_REGION(Double, Double, jdouble)

#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 = throwIfJNull array $ \
    withJNIEnv $ \env -> \
    throwIfException env $ \
    [CU.exp| void { \
      (*$(JNIEnv *env))->Set/**/name/**/ArrayRegion($(JNIEnv *env), \
                                                    $fptr-ptr:(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 = throwIfJNull array $ \
    withJNIEnv $ \env -> \
    [CU.exp| void { \
      (*$(JNIEnv *env))->Release/**/name/**/ArrayElements($(JNIEnv *env), \
                                                          $fptr-ptr:(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 :: JString -> Ptr Word16 -> IO ()
releaseStringChars JString
jstr Ptr Word16
chars = JString -> IO () -> IO ()
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JString
jstr (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    [CU.exp| void {
      (*$(JNIEnv *env))->ReleaseStringChars($(JNIEnv *env),
                                            $fptr-ptr:(jstring jstr),
                                            $(jchar *chars)) } |]

getObjectArrayElement
  :: forall a o.
     (IsReferenceType a, Coercible o (J a))
  => JArray a
  -> Int32
  -> IO o
getObjectArrayElement :: JArray a -> Int32 -> IO o
getObjectArrayElement (JArray a -> JObjectArray
forall (ty :: JType).
IsReferenceType ty =>
J ('Array ty) -> JObjectArray
arrayUpcast -> JObjectArray
array) Int32
i = JObjectArray -> IO o -> IO o
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObjectArray
array (IO o -> IO o) -> IO o -> IO o
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO o) -> IO o
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO o) -> IO o) -> (Ptr JNIEnv -> IO o) -> IO o
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    ( (J a -> o
coerce :: J a -> o)
    (J a -> o) -> (JObject -> J a) -> JObject -> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JObject -> J a
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast :: JObject -> J a)
    ) (JObject -> o) -> IO JObject -> IO o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    [C.exp| jobject {
      (*$(JNIEnv *env))->GetObjectArrayElement($(JNIEnv *env),
                                               $fptr-ptr:(jarray array),
                                               $(jsize i)) } |]

setObjectArrayElement
  :: forall a o.
     (IsReferenceType a, Coercible o (J a))
  => JArray a
  -> Int32
  -> o
  -> IO ()
setObjectArrayElement :: JArray a -> Int32 -> o -> IO ()
setObjectArrayElement (JArray a -> JObjectArray
forall (ty :: JType).
IsReferenceType ty =>
J ('Array ty) -> JObjectArray
arrayUpcast -> JObjectArray
array)
                      Int32
i
                      ((o -> J a
coerce :: o -> J a) -> J a -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
x) =
    JObjectArray -> IO () -> IO ()
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObjectArray
array (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO ()) -> IO ()
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO ()) -> IO ()) -> (Ptr JNIEnv -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    [C.exp| void {
      (*$(JNIEnv *env))->SetObjectArrayElement($(JNIEnv *env),
                                               $fptr-ptr:(jobjectArray array),
                                               $(jsize i),
                                               $fptr-ptr:(jobject x)); } |]

newDirectByteBuffer :: Ptr CChar -> Int64 -> IO JByteBuffer
newDirectByteBuffer :: Ptr CChar -> Int64 -> IO JByteBuffer
newDirectByteBuffer (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
address) Int64
capacity =
    (NullPointerException -> IO (Ptr ()) -> IO (Ptr ())
forall e a. Exception e => e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull NullPointerException
NullPointerException (Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
address) IO (Ptr ()) -> IO JByteBuffer -> IO JByteBuffer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (IO JByteBuffer -> IO JByteBuffer)
-> IO JByteBuffer -> IO JByteBuffer
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO JByteBuffer) -> IO JByteBuffer
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO JByteBuffer) -> IO JByteBuffer)
-> (Ptr JNIEnv -> IO JByteBuffer) -> IO JByteBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    (JObject -> JByteBuffer) -> IO JObject -> IO JByteBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JObject -> JByteBuffer
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast :: JObject -> JByteBuffer) (IO JObject -> IO JByteBuffer) -> IO JObject -> IO JByteBuffer
forall a b. (a -> b) -> a -> b
$
    (Ptr JObject -> IO JObject
forall (a :: JType). Ptr (J a) -> IO (J a)
objectFromPtr (Ptr JObject -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO (Ptr JObject) -> IO JObject) -> IO (Ptr JObject) -> IO JObject
forall a b. (a -> b) -> a -> b
$
    DirectBufferFailed -> IO (Ptr JObject) -> IO (Ptr JObject)
forall e a. Exception e => e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull DirectBufferFailed
DirectBufferFailed (IO (Ptr JObject) -> IO (Ptr JObject))
-> IO (Ptr JObject) -> IO (Ptr JObject)
forall a b. (a -> b) -> a -> b
$
    [C.exp| jobject {
      (*$(JNIEnv *env))->NewDirectByteBuffer($(JNIEnv *env),
                                             $(void *address),
                                             $(jlong capacity)) } |]

getDirectBufferAddress :: JByteBuffer -> IO (Ptr CChar)
getDirectBufferAddress :: JByteBuffer -> IO (Ptr CChar)
getDirectBufferAddress (JByteBuffer -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
jbuffer) =
    JObject -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObject
jbuffer (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
    (Ptr JNIEnv -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr JNIEnv -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
    (Ptr () -> Ptr CChar) -> IO (Ptr ()) -> IO (Ptr CChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr ()) -> IO (Ptr CChar)) -> IO (Ptr ()) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
    DirectBufferFailed -> IO (Ptr ()) -> IO (Ptr ())
forall e a. Exception e => e -> IO (Ptr a) -> IO (Ptr a)
throwIfNull DirectBufferFailed
DirectBufferFailed (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
    [C.exp| void* {
      (*$(JNIEnv *env))->GetDirectBufferAddress($(JNIEnv *env),
                                                $fptr-ptr:(jobject jbuffer)) } |]

getDirectBufferCapacity :: JByteBuffer -> IO Int64
getDirectBufferCapacity :: JByteBuffer -> IO Int64
getDirectBufferCapacity (JByteBuffer -> JObject
forall (a :: JType). J a -> JObject
upcast -> JObject
jbuffer) = do
    Int64
capacity <- JObject -> IO Int64 -> IO Int64
forall (ty :: JType) a. J ty -> IO a -> IO a
throwIfJNull JObject
jbuffer (IO Int64 -> IO Int64) -> IO Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$
      (Ptr JNIEnv -> IO Int64) -> IO Int64
forall a. (Ptr JNIEnv -> IO a) -> IO a
withJNIEnv ((Ptr JNIEnv -> IO Int64) -> IO Int64)
-> (Ptr JNIEnv -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr JNIEnv
env ->
      [C.exp| jlong {
        (*$(JNIEnv *env))->GetDirectBufferCapacity($(JNIEnv *env),
                                                   $fptr-ptr:(jobject jbuffer)) } |]
    if Int64
capacity Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 then
      Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
capacity
    else
      DirectBufferFailed -> IO Int64
forall e a. Exception e => e -> IO a
throwIO DirectBufferFailed
DirectBufferFailed