-- | High-level helper functions for interacting with Java objects, mapping them
-- to Haskell values and vice versa. The 'Reify' and 'Reflect' classes together
-- are to Java what "Foreign.Storable" is to C: they provide a means to
-- marshall/unmarshall Java objects from/to Haskell data types.
--
-- A typical pattern for wrapping Java API's using this module is:
--
-- @
-- {-\# LANGUAGE DataKinds \#-}
-- {-\# LANGUAGE DeriveAnyClass \#-}
-- module Object where
--
-- import Language.Java.Unsafe as J
--
-- newtype Object = Object ('J' (''Class' "java.lang.Object"))
--   deriving (J.Coercible, J.Interpretation, J.Reify, J.Reflect)
--
-- clone :: Object -> IO Object
-- clone obj = J.'call' obj "clone" []
--
-- equals :: Object -> Object -> IO Bool
-- equals obj1 obj2 = J.'call' obj1 "equals" ['jvalue' obj2]
--
-- ...
-- @
--
-- To call Java methods using quasiquoted Java syntax instead, see
-- "Language.Java.Inline".
--
-- The functions in this module are considered unsafe, as opposed to those in
-- "Language.Java.Safe", which guarantee that local references are not leaked.
-- Functions with a 'VariadicIO' constraint in their context are variadic,
-- meaning that you can apply them to any number of arguments, provided they are
-- 'Coercible'.
--
-- __NOTE 1:__ To use any function in this module, you'll need an initialized
-- JVM in the current process, using 'withJVM' or otherwise.
--
-- __NOTE 2:__ Functions in this module memoize (cache) any implicitly performed
-- class and method lookups, for performance. This memoization is safe only when
-- no new named classes are defined at runtime.

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Language.Java.Unsafe
  ( module Foreign.JNI.Types
  -- * JVM instance management
  , withJVM
  -- * JVM calls
  , classOf
  , getClass
  , setGetClassFunction
  , new
  , newArray
  , toArray
  , call
  , callStatic
  , getStaticField
  , VariadicIO
  -- * Reference management
  , push
  , pushWithSizeHint
  , Pop(..)
  , pop
  , popWithObject
  , popWithValue
  , withLocalRef
  -- * Coercions
  , CoercionFailure(..)
  , Coercible(..)
  , jvalue
  , jobject
  -- * Conversions
  , Interpretation(..)
  , Reify(..)
  , Reflect(..)
  -- * Re-exports
  , sing
  ) where

import Control.Distributed.Closure.TH
import Control.Exception (Exception, throw, finally)
import Control.Monad
import Control.Monad.Catch (MonadCatch, MonadMask, bracket, onException)
import Control.Monad.IO.Class
import Data.Char (chr, ord)
import qualified Data.Choice as Choice
import qualified Data.Coerce as Coerce
import Data.Constraint (Dict(..))
import Data.Int
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable, TypeRep, typeOf)
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Kind (Type)
import Data.Singletons (SingI(..), SomeSing(..))
import qualified Data.Text.Foreign as Text
import Data.Text (Text)
import qualified Data.Vector.Storable as Vector
import Data.Vector.Storable (Vector)
import qualified Data.Vector.Storable.Mutable as MVector
import Data.Vector.Storable.Mutable (IOVector)
import Foreign (Ptr, Storable, withForeignPtr)
import Foreign.Concurrent (newForeignPtr)
import Foreign.C (CChar)
import Foreign.JNI hiding (throw)
import Foreign.JNI.Types
import qualified Foreign.JNI.String as JNI
import GHC.TypeLits (KnownSymbol, TypeError, symbolVal)
import qualified GHC.TypeLits as TypeError (ErrorMessage(..))
import Language.Java.Internal
import System.IO.Unsafe (unsafeDupablePerformIO)

data Pop a where
  PopValue :: a -> Pop a
  PopObject
    :: (ty ~ Ty a, Coercible a, Coerce.Coercible a (J ty), IsReferenceType ty)
    => a
    -> Pop a

-- | Open a new scope for allocating (JNI) local references to JVM objects.
push :: (MonadCatch m, MonadIO m) => m (Pop a) -> m a
push :: m (Pop a) -> m a
push = Int32 -> m (Pop a) -> m a
forall a (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Int32 -> m (Pop a) -> m a
pushWithSizeHint Int32
4

-- | Like 'push', but specify explicitly a minimum size for the frame. You
-- probably don't need this.
pushWithSizeHint :: forall a m. (MonadCatch m, MonadIO m) => Int32 -> m (Pop a) -> m a
pushWithSizeHint :: Int32 -> m (Pop a) -> m a
pushWithSizeHint Int32
capacity m (Pop a)
m = do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> IO ()
pushLocalFrame Int32
capacity
    m (Pop a)
m m (Pop a) -> m (J Any) -> m (Pop a)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` m (J Any)
forall (a :: JType). m (J a)
handler m (Pop a) -> (Pop a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      PopValue a
x -> do
        J Any
_ <- IO (J Any) -> m (J Any)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (J Any) -> m (J Any)) -> IO (J Any) -> m (J Any)
forall a b. (a -> b) -> a -> b
$ J Any -> IO (J Any)
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
popLocalFrame J Any
forall (a :: JType). J a
jnull
        a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      PopObject a
x -> do
        IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ J ty -> a
Coerce.coerce (J ty -> a) -> IO (J ty) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> J ty -> IO (J ty)
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
popLocalFrame (a -> J ty
forall (ty :: JType) a.
(ty ~ Ty a, Coercible a, IsReferenceType ty) =>
a -> J ty
jobject a
x)
  where
    handler :: m (J a)
handler = IO (J a) -> m (J a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (J a) -> m (J a)) -> IO (J a) -> m (J a)
forall a b. (a -> b) -> a -> b
$ J a -> IO (J a)
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
popLocalFrame J a
forall (a :: JType). J a
jnull

-- | Equivalent to 'popWithValue ()'.
pop :: Monad m => m (Pop ())
pop :: m (Pop ())
pop = Pop () -> m (Pop ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Pop ()
forall a. a -> Pop a
PopValue ())

-- | Pop a frame and return a JVM object.
popWithObject
  :: (ty ~ Ty a, Coercible a, Coerce.Coercible a (J ty), IsReferenceType ty, Monad m)
  => a
  -> m (Pop a)
popWithObject :: a -> m (Pop a)
popWithObject a
x = Pop a -> m (Pop a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Pop a
forall (ty :: JType) a.
(ty ~ Ty a, Coercible a, Coercible a (J ty), IsReferenceType ty) =>
a -> Pop a
PopObject a
x)

-- | Pop a frame and return a value. This value MUST NOT be an object reference
-- created in the popped frame. In that case use 'popWithObject' instead.
popWithValue :: Monad m => a -> m (Pop a)
popWithValue :: a -> m (Pop a)
popWithValue a
x = Pop a -> m (Pop a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Pop a
forall a. a -> Pop a
PopValue a
x)

-- | Create a local ref and delete it when the given action completes.
withLocalRef
  :: (MonadMask m, MonadIO m, Coerce.Coercible o (J ty))
  => m o -> (o -> m a) -> m a
withLocalRef :: m o -> (o -> m a) -> m a
withLocalRef m o
m = m o -> (o -> m ()) -> (o -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m o
m (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (o -> IO ()) -> o -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> IO ()
forall o (ty :: JType). Coercible o (J ty) => o -> IO ()
deleteLocalRef)

-- Note [Class lookup memoization]
--
-- By using unsafeDupablePerformIO, we mark the lookup actions as pure. When the
-- body of the function is inlined within the calling context, the lookups
-- typically become closed expressions, therefore are CAF's that can be floated
-- to top-level by the GHC optimizer.

-- | Tag data types that can be coerced in O(1) time without copy to a Java
-- object or primitive type (i.e. have the same representation) by declaring an
-- instance of this type class for that data type.
class SingI (Ty a) => Coercible a where
  type Ty a :: JType
  coerce :: a -> JValue
  unsafeUncoerce :: JValue -> a

  default coerce
    :: Coerce.Coercible a (J (Ty a))
    => a
    -> JValue
  coerce a
x = J (Ty a) -> JValue
forall (a :: JType). SingI a => J a -> JValue
JObject (a -> J (Ty a)
Coerce.coerce a
x :: J (Ty a))

  default unsafeUncoerce
    :: Coerce.Coercible (J (Ty a)) a
    => JValue
    -> a
  unsafeUncoerce (JObject J a
obj) = J (Ty a) -> a
Coerce.coerce (J a -> J (Ty a)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast J a
obj :: J (Ty a))
  unsafeUncoerce JValue
_ =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot unsafeUncoerce: object expected but value of primitive type found."

-- | The identity instance.
instance SingI ty => Coercible (J ty) where
  type Ty (J ty) = ty

-- | A JNI call may cause a (Java) exception to be raised. This module raises it
-- as a Haskell exception wrapping the Java exception.
data CoercionFailure = CoercionFailure
  { CoercionFailure -> JValue
coercionActual :: JValue
  , CoercionFailure -> TypeRep
coercionExpected :: TypeRep
  }

instance Exception CoercionFailure

instance Show CoercionFailure where
  show :: CoercionFailure -> [Char]
show (CoercionFailure JValue
actual TypeRep
expected) =
    [Char]
"Can't coerce " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ JValue -> [Char]
forall a. Show a => a -> [Char]
show JValue
actual [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show TypeRep
expected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."

withTypeRep :: Typeable a => (TypeRep -> a) -> a
withTypeRep :: (TypeRep -> a) -> a
withTypeRep TypeRep -> a
f = let x :: a
x = TypeRep -> a
f (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) in a
x

instance Coercible Bool where
  type Ty Bool = 'Prim "boolean"
  coerce :: Bool -> JValue
coerce Bool
x = Word8 -> JValue
JBoolean (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x))
  unsafeUncoerce :: JValue -> Bool
unsafeUncoerce (JBoolean Word8
x) = Int -> Bool
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
  unsafeUncoerce JValue
val = (TypeRep -> Bool) -> Bool
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Bool
forall a e. Exception e => e -> a
throw (CoercionFailure -> Bool)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible CChar where
  type Ty CChar = 'Prim "byte"
  coerce :: CChar -> JValue
coerce = CChar -> JValue
JByte
  unsafeUncoerce :: JValue -> CChar
unsafeUncoerce (JByte CChar
x) = CChar
x
  unsafeUncoerce JValue
val = (TypeRep -> CChar) -> CChar
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> CChar
forall a e. Exception e => e -> a
throw (CoercionFailure -> CChar)
-> (TypeRep -> CoercionFailure) -> TypeRep -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Char where
  type Ty Char = 'Prim "char"
  coerce :: Char -> JValue
coerce Char
x = Word16 -> JValue
JChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
x))
  unsafeUncoerce :: JValue -> Char
unsafeUncoerce (JChar Word16
x) = Int -> Char
chr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
  unsafeUncoerce JValue
val = (TypeRep -> Char) -> Char
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Char
forall a e. Exception e => e -> a
throw (CoercionFailure -> Char)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Word16 where
  type Ty Word16 = 'Prim "char"
  coerce :: Word16 -> JValue
coerce = Word16 -> JValue
JChar
  unsafeUncoerce :: JValue -> Word16
unsafeUncoerce (JChar Word16
x) = Word16
x
  unsafeUncoerce JValue
val = (TypeRep -> Word16) -> Word16
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Word16
forall a e. Exception e => e -> a
throw (CoercionFailure -> Word16)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Int16 where
  type Ty Int16 = 'Prim "short"
  coerce :: Int16 -> JValue
coerce = Int16 -> JValue
JShort
  unsafeUncoerce :: JValue -> Int16
unsafeUncoerce (JShort Int16
x) = Int16
x
  unsafeUncoerce JValue
val = (TypeRep -> Int16) -> Int16
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Int16
forall a e. Exception e => e -> a
throw (CoercionFailure -> Int16)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Int32 where
  type Ty Int32 = 'Prim "int"
  coerce :: Int32 -> JValue
coerce = Int32 -> JValue
JInt
  unsafeUncoerce :: JValue -> Int32
unsafeUncoerce (JInt Int32
x) = Int32
x
  unsafeUncoerce JValue
val = (TypeRep -> Int32) -> Int32
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Int32
forall a e. Exception e => e -> a
throw (CoercionFailure -> Int32)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Int64 where
  type Ty Int64 = 'Prim "long"
  coerce :: Int64 -> JValue
coerce = Int64 -> JValue
JLong
  unsafeUncoerce :: JValue -> Int64
unsafeUncoerce (JLong Int64
x) = Int64
x
  unsafeUncoerce JValue
val = (TypeRep -> Int64) -> Int64
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Int64
forall a e. Exception e => e -> a
throw (CoercionFailure -> Int64)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Float where
  type Ty Float = 'Prim "float"
  coerce :: Float -> JValue
coerce = Float -> JValue
JFloat
  unsafeUncoerce :: JValue -> Float
unsafeUncoerce (JFloat Float
x) = Float
x
  unsafeUncoerce JValue
val = (TypeRep -> Float) -> Float
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Float
forall a e. Exception e => e -> a
throw (CoercionFailure -> Float)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible Double where
  type Ty Double = 'Prim "double"
  coerce :: Double -> JValue
coerce = Double -> JValue
JDouble
  unsafeUncoerce :: JValue -> Double
unsafeUncoerce (JDouble Double
x) = Double
x
  unsafeUncoerce JValue
val = (TypeRep -> Double) -> Double
forall a. Typeable a => (TypeRep -> a) -> a
withTypeRep (CoercionFailure -> Double
forall a e. Exception e => e -> a
throw (CoercionFailure -> Double)
-> (TypeRep -> CoercionFailure) -> TypeRep -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> TypeRep -> CoercionFailure
CoercionFailure JValue
val)
instance Coercible () where
  type Ty () = 'Void
  coerce :: () -> JValue
coerce = [Char] -> () -> JValue
forall a. HasCallStack => [Char] -> a
error [Char]
"Void value undefined."
  unsafeUncoerce :: JValue -> ()
unsafeUncoerce JValue
_ = ()
instance Coercible (Choice.Choice a) where
  type Ty (Choice.Choice a) = 'Prim "boolean"
  coerce :: Choice a -> JValue
coerce = Bool -> JValue
forall a. Coercible a => a -> JValue
coerce (Bool -> JValue) -> (Choice a -> Bool) -> Choice a -> JValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choice a -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.toBool
  unsafeUncoerce :: JValue -> Choice a
unsafeUncoerce = Bool -> Choice a
forall (a :: Symbol). Bool -> Choice a
Choice.fromBool (Bool -> Choice a) -> (JValue -> Bool) -> JValue -> Choice a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JValue -> Bool
forall a. Coercible a => JValue -> a
unsafeUncoerce

-- | Inject a value (of primitive or reference type) to a 'JValue'. This
-- datatype is useful for e.g. passing arguments as a list of homogeneous type.
-- Synonym for 'coerce'.
jvalue :: (ty ~ Ty a, Coercible a) => a -> JValue
jvalue :: a -> JValue
jvalue = a -> JValue
forall a. Coercible a => a -> JValue
coerce

-- | If @ty@ is a reference type, then it should be possible to get an object
-- from a value.
jobject :: (ty ~ Ty a, Coercible a, IsReferenceType ty) => a -> J ty
jobject :: a -> J ty
jobject a
x
  | JObject J a
jobj <- a -> JValue
forall a. Coercible a => a -> JValue
coerce a
x = J a -> J ty
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast J a
jobj
  | Bool
otherwise = [Char] -> J ty
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

-- | Get the Java class of an object or anything 'Coercible' to one.
classOf
  :: forall a sym. (Ty a ~ 'Class sym, Coercible a, KnownSymbol sym)
  => a
  -> JNI.String
classOf :: a -> String
classOf a
x = [Char] -> String
JNI.fromChars (Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)) String -> JValue -> String
forall a b. a -> b -> a
`const` a -> JValue
forall a. Coercible a => a -> JValue
coerce a
x

-- | @VariadicIO_ f@ constraints @f@ to be of the form
--
-- > f :: a₁ -> ... -> aₙ -> IO b
--
-- for any value of @n@, where the context provides
--
-- > (Coercible a₁, ... , Coercible aₙ)
--
class VariadicIO_ f where
  -- | The singletons of the argument types of @f@.
  --
  -- > sings (Proxy (a₁ -> ... -> aₙ -> IO b) =
  -- >   [SomeSing (sing @a₁), ... , SomeSing (sing @aₙ)]
  --
  sings :: Proxy f -> [SomeSing JType]

  -- | @apply g a₁ ... aₙ = g [coerce a₁, ... , coerce aₙ]@
  apply :: ([JValue] -> IO (ReturnTypeIO f)) -> f

-- | The return type of a variadic function
--
-- In general,
--
-- > ReturnTypeIO (a₁ -> ... -> aₙ -> IO b) = b
--
-- We keep it as a standalone type family to enable
-- the definition of the catch-all @VariadicIO_ x@ instance.
type family ReturnTypeIO f :: Data.Kind.Type

-- | Document that a function is variadic
--
-- @VariadicIO f b@ constraints @f@ to be of the form
--
-- > a₁ -> ... -> aₙ -> IO b
--
-- for any value of @n@, where the context provides
--
-- > (Coercible a₁, ... , Coercible aₙ)
--
type VariadicIO f b = (ReturnTypeIO f ~ b, VariadicIO_ f)

type instance ReturnTypeIO (IO a) = a

instance VariadicIO_ (IO a) where
  sings :: Proxy (IO a) -> [SomeSing JType]
sings Proxy (IO a)
_ = []
  apply :: ([JValue] -> IO (ReturnTypeIO (IO a))) -> IO a
apply [JValue] -> IO (ReturnTypeIO (IO a))
f = [JValue] -> IO (ReturnTypeIO (IO a))
f []

type instance ReturnTypeIO (a -> f) = ReturnTypeIO f

instance (Coercible a, VariadicIO_ f) => VariadicIO_ (a -> f) where
  sings :: Proxy (a -> f) -> [SomeSing JType]
sings Proxy (a -> f)
_ = Sing (Ty a) -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (SingI (Ty a) => Sing (Ty a)
forall k (a :: k). SingI a => Sing a
sing @(Ty a)) SomeSing JType -> [SomeSing JType] -> [SomeSing JType]
forall a. a -> [a] -> [a]
: Proxy f -> [SomeSing JType]
forall f. VariadicIO_ f => Proxy f -> [SomeSing JType]
sings @f Proxy f
forall k (t :: k). Proxy t
Proxy
  apply :: ([JValue] -> IO (ReturnTypeIO (a -> f))) -> a -> f
apply [JValue] -> IO (ReturnTypeIO (a -> f))
f a
x = ([JValue] -> IO (ReturnTypeIO f)) -> f
forall f. VariadicIO_ f => ([JValue] -> IO (ReturnTypeIO f)) -> f
apply (\[JValue]
xs -> [JValue] -> IO (ReturnTypeIO (a -> f))
f (a -> JValue
forall a. Coercible a => a -> JValue
coerce a
x JValue -> [JValue] -> [JValue]
forall a. a -> [a] -> [a]
: [JValue]
xs))

-- All errors of the form "Could not deduce (VariadicIO_ x) from ..."
-- are replaced with the following type error.
instance
  {-# OVERLAPPABLE #-}
  TypeError (TypeError.Text "Expected: a₁ -> ... -> aₙ -> IO b" TypeError.:$$:
             TypeError.Text "Actual: " TypeError.:<>: TypeError.ShowType x) =>
  VariadicIO_ x where
  sings :: Proxy x -> [SomeSing JType]
sings = Proxy x -> [SomeSing JType]
forall a. HasCallStack => a
undefined
  apply :: ([JValue] -> IO (ReturnTypeIO x)) -> x
apply = ([JValue] -> IO (ReturnTypeIO x)) -> x
forall a. HasCallStack => a
undefined

-- | Creates a new instance of the class whose name is resolved from the return
-- type. For instance,
--
-- @
-- do x :: 'J' (''Class' "java.lang.Integer") <- new 42
--    return x
-- @
--
-- You can pass any number of 'Coercible' arguments to the constructor.
new
  :: forall a f sym.
     ( Ty a ~ 'Class sym
     , Coerce.Coercible a (J ('Class sym))
     , Coercible a
     , VariadicIO f a
     ) => f
{-# INLINE new #-}
new :: f
new = ([JValue] -> IO (ReturnTypeIO f)) -> f
forall f. VariadicIO_ f => ([JValue] -> IO (ReturnTypeIO f)) -> f
apply (([JValue] -> IO (ReturnTypeIO f)) -> f)
-> ([JValue] -> IO (ReturnTypeIO f)) -> f
forall a b. (a -> b) -> a -> b
$ \[JValue]
args -> J ('Class sym) -> a
Coerce.coerce (J ('Class sym) -> a) -> IO (J ('Class sym)) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeSing JType] -> [JValue] -> IO (J ('Class sym))
forall (sym :: Symbol) (ty :: JType).
(ty ~ 'Class sym, SingI ty) =>
[SomeSing JType] -> [JValue] -> IO (J ty)
newJ @sym (Proxy f -> [SomeSing JType]
forall f. VariadicIO_ f => Proxy f -> [SomeSing JType]
sings @f Proxy f
forall k (t :: k). Proxy t
Proxy) [JValue]
args

-- | Creates a new Java array of the given size. The type of the elements
-- of the resulting array is determined by the return type a call to
-- 'newArray' has, at the call site, and must not be left ambiguous.
--
-- To create a Java array of 50 booleans:
--
-- @
-- do arr :: 'J' (''Array' (''Prim' "boolean")) <- 'newArray' 50
--    return arr
-- @
newArray :: forall ty. SingI ty => Int32 -> IO (J ('Array ty))
{-# INLINE newArray #-}
newArray :: Int32 -> IO (J ('Array ty))
newArray Int32
sz = do
    let tysing :: Sing ty
tysing = SingI ty => Sing ty
forall k (a :: k). SingI a => Sing a
sing @ty
    case Sing ty
tysing of
      SPrim "boolean" -> J ('Array ('Prim "boolean")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "boolean")) -> J ('Array ty))
-> IO (J ('Array ('Prim "boolean"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "boolean")))
newBooleanArray Int32
sz
      SPrim "byte" -> J ('Array ('Prim "byte")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "byte")) -> J ('Array ty))
-> IO (J ('Array ('Prim "byte"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "byte")))
newByteArray Int32
sz
      SPrim "char" -> J ('Array ('Prim "char")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "char")) -> J ('Array ty))
-> IO (J ('Array ('Prim "char"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "char")))
newCharArray Int32
sz
      SPrim "short" -> J ('Array ('Prim "short")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "short")) -> J ('Array ty))
-> IO (J ('Array ('Prim "short"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "short")))
newShortArray Int32
sz
      SPrim "int" -> J ('Array ('Prim "int")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "int")) -> J ('Array ty))
-> IO (J ('Array ('Prim "int"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "int")))
newIntArray Int32
sz
      SPrim "long" -> J ('Array ('Prim "long")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "long")) -> J ('Array ty))
-> IO (J ('Array ('Prim "long"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "long")))
newLongArray Int32
sz
      SPrim "float" -> J ('Array ('Prim "float")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "float")) -> J ('Array ty))
-> IO (J ('Array ('Prim "float"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "float")))
newFloatArray Int32
sz
      SPrim "double" -> J ('Array ('Prim "double")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Prim "double")) -> J ('Array ty))
-> IO (J ('Array ('Prim "double"))) -> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> IO (J ('Array ('Prim "double")))
newDoubleArray Int32
sz
      Sing ty
SVoid -> [Char] -> IO (J ('Array ty))
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"newArray of void"
      Sing ty
_ -> case Sing ty -> Maybe (Dict (IsReferenceType ty))
forall (ty :: JType). Sing ty -> Maybe (Dict (IsReferenceType ty))
singToIsReferenceType Sing ty
tysing of
        Maybe (Dict (IsReferenceType ty))
Nothing -> [Char] -> IO (J ('Array ty))
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO (J ('Array ty))) -> [Char] -> IO (J ('Array ty))
forall a b. (a -> b) -> a -> b
$ [Char]
"newArray of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SJType ty -> [Char]
forall a. Show a => a -> [Char]
show Sing ty
SJType ty
tysing
        Just Dict (IsReferenceType ty)
Dict -> do
          let klass :: JClass
klass = IO JClass -> JClass
forall a. IO a -> a
unsafeDupablePerformIO (IO JClass -> JClass) -> IO JClass -> JClass
forall a b. (a -> b) -> a -> b
$ do
                JClass
lk <- Sing ty -> IO JClass
forall (ty :: JType). IsReferenceType ty => Sing ty -> IO JClass
getClass Sing ty
tysing
                JClass
gk <- JClass -> IO JClass
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
newGlobalRef JClass
lk
                JClass -> IO ()
forall o (ty :: JType). Coercible o (J ty) => o -> IO ()
deleteLocalRef JClass
lk
                JClass -> IO JClass
forall (m :: * -> *) a. Monad m => a -> m a
return JClass
gk
          J ('Array ('Class "java.lang.Object")) -> J ('Array ty)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast (J ('Array ('Class "java.lang.Object")) -> J ('Array ty))
-> IO (J ('Array ('Class "java.lang.Object")))
-> IO (J ('Array ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> JClass -> IO (J ('Array ('Class "java.lang.Object")))
newObjectArray Int32
sz JClass
klass

-- | Creates an array from a list of references.
toArray
  :: forall ty. (SingI ty, IsReferenceType ty)
  => [J ty]
  -> IO (J ('Array ty))
toArray :: [J ty] -> IO (J ('Array ty))
toArray [J ty]
xs = do
    let n :: Int32
n = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([J ty] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [J ty]
xs)
    J ('Array ty)
jxs <- Int32 -> IO (J ('Array ty))
forall (ty :: JType). SingI ty => Int32 -> IO (J ('Array ty))
newArray Int32
n
    (Int32 -> J ty -> IO ()) -> [Int32] -> [J ty] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (J ('Array ty) -> Int32 -> J ty -> IO ()
forall (a :: JType) o.
(IsReferenceType a, Coercible o (J a)) =>
JArray a -> Int32 -> o -> IO ()
setObjectArrayElement J ('Array ty)
jxs) [Int32
0 .. Int32
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1] [J ty]
xs
    J ('Array ty) -> IO (J ('Array ty))
forall (m :: * -> *) a. Monad m => a -> m a
return J ('Array ty)
jxs

-- | The Swiss Army knife for calling Java methods. Give it an object or any
-- data type coercible to one and any number of 'Coercible' arguments. Based on
-- the types of each argument, and based on the return type, 'call' will invoke
-- the named method using of the @call*Method@ family of functions in the JNI
-- API.
--
-- When the method name is overloaded, use 'upcast' or 'unsafeCast'
-- appropriately on the class instance and/or on the arguments to invoke the
-- right method.
--
-- Example:
--
-- @
-- call obj "frobnicate" x y z
-- @
call
  :: forall a b ty f.
  ( VariadicIO f b
  , ty ~ Ty a
  , IsReferenceType ty
  , Coercible a
  , Coercible b
  , Coerce.Coercible a (J ty)
  )
  => a
  -> JNI.String
  -> f
call :: a -> String -> f
call a
obj String
mname = ([JValue] -> IO (ReturnTypeIO f)) -> f
forall f. VariadicIO_ f => ([JValue] -> IO (ReturnTypeIO f)) -> f
apply (([JValue] -> IO (ReturnTypeIO f)) -> f)
-> ([JValue] -> IO (ReturnTypeIO f)) -> f
forall a b. (a -> b) -> a -> b
$ \[JValue]
args ->
    JValue -> b
forall a. Coercible a => JValue -> a
unsafeUncoerce (JValue -> b) -> IO JValue -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Sing (Ty b)
-> J ty -> String -> [SomeSing JType] -> [JValue] -> IO JValue
forall (ty1 :: JType) (k :: JType).
(IsReferenceType ty1, SingI ty1) =>
Sing k
-> J ty1 -> String -> [SomeSing JType] -> [JValue] -> IO JValue
callToJValue
      (SingI (Ty b) => Sing (Ty b)
forall k (a :: k). SingI a => Sing a
sing @(Ty b))
      (a -> J ty
Coerce.coerce a
obj :: J ty)
      String
mname
      (Proxy f -> [SomeSing JType]
forall f. VariadicIO_ f => Proxy f -> [SomeSing JType]
sings @f Proxy f
forall k (t :: k). Proxy t
Proxy)
      [JValue]
args

-- | Same as 'call', but for static methods.
--
-- Example:
--
-- @
-- callStatic "java.lang.Integer" "parseInt" jstr
-- @
callStatic
  :: forall a ty f.
     (ty ~ Ty a, Coercible a, VariadicIO f a)
  => JNI.String -- ^ Class name
  -> JNI.String -- ^ Method name
  -> f
{-# INLINE callStatic #-}
callStatic :: String -> String -> f
callStatic String
cname String
mname = ([JValue] -> IO (ReturnTypeIO f)) -> f
forall f. VariadicIO_ f => ([JValue] -> IO (ReturnTypeIO f)) -> f
apply (([JValue] -> IO (ReturnTypeIO f)) -> f)
-> ([JValue] -> IO (ReturnTypeIO f)) -> f
forall a b. (a -> b) -> a -> b
$ \[JValue]
args ->
   JValue -> a
forall a. Coercible a => JValue -> a
unsafeUncoerce (JValue -> a) -> IO JValue -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     Sing ty
-> String -> String -> [SomeSing JType] -> [JValue] -> IO JValue
forall (k :: JType).
Sing k
-> String -> String -> [SomeSing JType] -> [JValue] -> IO JValue
callStaticToJValue (SingI ty => Sing ty
forall k (a :: k). SingI a => Sing a
sing @ty) String
cname String
mname (Proxy f -> [SomeSing JType]
forall f. VariadicIO_ f => Proxy f -> [SomeSing JType]
sings @f Proxy f
forall k (t :: k). Proxy t
Proxy) [JValue]
args

-- | Get a static field.
getStaticField
  :: forall a ty. (ty ~ Ty a, Coercible a)
  => JNI.String -- ^ Class name
  -> JNI.String -- ^ Static field name
  -> IO a
{-# INLINE getStaticField #-}
getStaticField :: String -> String -> IO a
getStaticField String
cname String
fname =
    JValue -> a
forall a. Coercible a => JValue -> a
unsafeUncoerce (JValue -> a) -> IO JValue -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing ty -> String -> String -> IO JValue
forall (ty :: JType). Sing ty -> String -> String -> IO JValue
getStaticFieldAsJValue (SingI ty => Sing ty
forall k (a :: k). SingI a => Sing a
sing @ty) String
cname String
fname

-- | The 'Interp' type family is used by both 'Reify' and 'Reflect'. In order to
-- benefit from @-XGeneralizedNewtypeDeriving@ of new instances, we make this an
-- /associated/ type family instead of a standalone one.
class (SingI (Interp a), IsReferenceType (Interp a)) => Interpretation (a :: k) where
  -- | Map a Haskell type to the symbolic representation of a Java type.
  type Interp a :: JType

-- | Extract a concrete Haskell value from the space of Java objects. That is to
-- say, unmarshall a Java object to a Haskell value. Unlike coercing, in general
-- reifying induces allocations and copies.
class Interpretation a => Reify a where
  -- | Invariant: The result and the argument share no direct JVM object
  -- references.
  reify :: J (Interp a) -> IO a

  default reify :: (Coercible a, Interp a ~ Ty a) => J (Interp a) -> IO a
  reify J (Interp a)
x = JValue -> a
forall a. Coercible a => JValue -> a
unsafeUncoerce (JValue -> a) -> (J (Interp a) -> JValue) -> J (Interp a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. J (Interp a) -> JValue
forall (a :: JType). SingI a => J a -> JValue
JObject (J (Interp a) -> a) -> IO (J (Interp a)) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (J (Interp a) -> IO (J (Interp a))
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
newLocalRef J (Interp a)
x :: IO (J (Ty a)))

-- | Inject a concrete Haskell value into the space of Java objects. That is to
-- say, marshall a Haskell value to a Java object. Unlike coercing, in general
-- reflection induces allocations and copies.
class Interpretation a => Reflect a where
  -- | Invariant: The result and the argument share no direct JVM object
  -- references.
  reflect :: a -> IO (J (Interp a))

  default reflect :: (Coercible a, Interp a ~ Ty a) => a -> IO (J (Interp a))
  reflect a
x = J (Interp a) -> IO (J (Interp a))
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
newLocalRef (a -> J (Interp a)
forall (ty :: JType) a.
(ty ~ Ty a, Coercible a, IsReferenceType ty) =>
a -> J ty
jobject a
x)

reifyMVector
  :: Storable a
  => (JArray ty -> IO (Ptr a))
  -> (JArray ty -> Ptr a -> IO ())
  -> JArray ty
  -> IO (IOVector a)
reifyMVector :: (JArray ty -> IO (Ptr a))
-> (JArray ty -> Ptr a -> IO ()) -> JArray ty -> IO (IOVector a)
reifyMVector JArray ty -> IO (Ptr a)
mk JArray ty -> Ptr a -> IO ()
finalize JArray ty
jobj0 = do
    -- jobj might be finalized before the finalizer of fptr runs.
    -- Therefore, we create a global reference without an attached
    -- finalizer.
    -- See https://ghc.haskell.org/trac/ghc/ticket/13439
    JArray ty
jobj <- JArray ty -> IO (JArray ty)
forall o (ty :: JType). Coercible o (J ty) => o -> IO o
newGlobalRefNonFinalized JArray ty
jobj0
    Int32
n <- JArray ty -> IO Int32
forall o (a :: JType). Coercible o (JArray a) => o -> IO Int32
getArrayLength JArray ty
jobj
    Ptr a
ptr <- JArray ty -> IO (Ptr a)
mk JArray ty
jobj
    ForeignPtr a
fptr <- Ptr a -> IO () -> IO (ForeignPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr a
ptr (IO () -> IO (ForeignPtr a)) -> IO () -> IO (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ JArray ty -> Ptr a -> IO ()
finalize JArray ty
jobj Ptr a
ptr
                                  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` JArray ty -> IO ()
forall o (ty :: JType). Coercible o (J ty) => o -> IO ()
deleteGlobalRefNonFinalized JArray ty
jobj
    IOVector a -> IO (IOVector a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a -> Int -> IOVector a
forall a s. Storable a => ForeignPtr a -> Int -> MVector s a
MVector.unsafeFromForeignPtr0 ForeignPtr a
fptr (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n))

reflectMVector
  :: Storable a
  => (Int32 -> IO (JArray ty))
  -> (JArray ty -> Int32 -> Int32 -> Ptr a -> IO ())
  -> IOVector a
  -> IO (JArray ty)
reflectMVector :: (Int32 -> IO (JArray ty))
-> (JArray ty -> Int32 -> Int32 -> Ptr a -> IO ())
-> IOVector a
-> IO (JArray ty)
reflectMVector Int32 -> IO (JArray ty)
newfun JArray ty -> Int32 -> Int32 -> Ptr a -> IO ()
fill IOVector a
mv = do
    let (ForeignPtr a
fptr, Int
n) = IOVector a -> (ForeignPtr a, Int)
forall a s. Storable a => MVector s a -> (ForeignPtr a, Int)
MVector.unsafeToForeignPtr0 IOVector a
mv
    JArray ty
jobj <- Int32 -> IO (JArray ty)
newfun (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ JArray ty -> Int32 -> Int32 -> Ptr a -> IO ()
fill JArray ty
jobj Int32
0 (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    JArray ty -> IO (JArray ty)
forall (m :: * -> *) a. Monad m => a -> m a
return JArray ty
jobj

withStatic [d|
  instance (SingI ty, IsReferenceType ty) => Interpretation (J ty) where type Interp (J ty) = ty
  instance Interpretation (J ty) => Reify (J ty)
  instance Interpretation (J ty) => Reflect (J ty)

  -- Ugly work around the fact that java has no equivalent of the 'unit' type:
  -- We take an arbitrary serializable type to represent it.
  instance Interpretation () where type Interp () = 'Class "java.lang.Short"
  instance Reify () where reify _ = return ()
  instance Reflect () where reflect () = new (0 :: Int16)

  instance Interpretation ByteString where
    type Interp ByteString = 'Array ('Prim "byte")

  instance Reify ByteString where
    reify jobj = do
        n <- getArrayLength (unsafeCast jobj)
        bytes <- getByteArrayElements jobj
        -- TODO could use unsafePackCStringLen instead and avoid a copy if we knew
        -- that been handed an (immutable) copy via JNI isCopy ref.
        bs <- BS.packCStringLen (bytes, fromIntegral n)
        releaseByteArrayElements jobj bytes
        return bs

  instance Reflect ByteString where
    reflect bs = BS.unsafeUseAsCStringLen bs $ \(content, n) -> do
        arr <- newByteArray (fromIntegral n)
        setByteArrayRegion arr 0 (fromIntegral n) content
        return arr

  instance Interpretation Bool where
    type Interp Bool = 'Class "java.lang.Boolean"

  instance Reify Bool where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Boolean")
              m <- getMethodID klass "booleanValue"
                     (methodSignature [] (SPrim "boolean"))
              deleteLocalRef klass
              return m
        callBooleanMethod jobj method []

  instance Reflect Bool where
    reflect = new

  instance Interpretation CChar where
    type Interp CChar = 'Class "java.lang.Byte"

  instance Reify CChar where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Byte")
              m <- getMethodID klass "byteValue"
                     (methodSignature [] (SPrim "byte"))
              deleteLocalRef klass
              return m
        callByteMethod jobj method []

  instance Reflect CChar where
    reflect = Language.Java.Unsafe.new

  instance Interpretation Int16 where
    type Interp Int16 = 'Class "java.lang.Short"

  instance Reify Int16 where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Short")
              m <- getMethodID klass "shortValue"
                     (methodSignature [] (SPrim "short"))
              deleteLocalRef klass
              return m
        callShortMethod jobj method []

  instance Reflect Int16 where
    reflect = new

  instance Interpretation Int32 where
    type Interp Int32 = 'Class "java.lang.Integer"

  instance Reify Int32 where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Integer")
              m <- getMethodID klass "intValue"
                     (methodSignature [] (SPrim "int"))
              deleteLocalRef klass
              return m
        callIntMethod jobj method []

  instance Reflect Int32 where
    reflect = new

  instance Interpretation Int64 where
    type Interp Int64 = 'Class "java.lang.Long"

  instance Reify Int64 where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Long")
              m <- getMethodID klass "longValue"
                     (methodSignature [] (SPrim "long"))
              deleteLocalRef klass
              return m
        callLongMethod jobj method []

  instance Reflect Int64 where
    reflect = new

  instance Interpretation Word16 where
    type Interp Word16 = 'Class "java.lang.Character"

  instance Reify Word16 where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Character")
              m <- getMethodID klass "charValue"
                     (methodSignature [] (SPrim "char"))
              deleteLocalRef klass
              return m
        fromIntegral <$> callCharMethod jobj method []

  instance Reflect Word16 where
    reflect = new

  instance Interpretation Double where
    type Interp Double = 'Class "java.lang.Double"

  instance Reify Double where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Double")
              m <- getMethodID klass "doubleValue"
                     (methodSignature [] (SPrim "double"))
              deleteLocalRef klass
              return m
        callDoubleMethod jobj method []

  instance Reflect Double where
    reflect = new

  instance Interpretation Float where
    type Interp Float = 'Class "java.lang.Float"

  instance Reify Float where
    reify jobj = do
        let method = unsafeDupablePerformIO $ do
              klass <- getClass (SClass "java.lang.Float")
              m <- getMethodID klass "floatValue"
                     (methodSignature [] (SPrim "float"))
              deleteLocalRef klass
              return m
        callFloatMethod jobj method []

  instance Reflect Float where
    reflect = new

  instance Interpretation Text where
    type Interp Text = 'Class "java.lang.String"

  instance Reify Text where
    reify jobj = do
        sz <- getStringLength jobj
        cs <- getStringChars jobj
        txt <- Text.fromPtr cs (fromIntegral sz)
        releaseStringChars jobj cs
        return txt

  instance Reflect Text where
    reflect x =
        Text.useAsPtr x $ \ptr len ->
          newString ptr (fromIntegral len)

  instance Interpretation (IOVector Word16) where
    type Interp (IOVector Word16) = 'Array ('Prim "char")

  instance Reify (IOVector Word16) where
    reify = reifyMVector getCharArrayElements releaseCharArrayElements

  instance Reflect (IOVector Word16) where
    reflect = reflectMVector newCharArray setCharArrayRegion

  instance Interpretation (IOVector Int16) where
    type Interp (IOVector Int16) = 'Array ('Prim "short")

  instance Reify (IOVector Int16) where
    reify = reifyMVector getShortArrayElements releaseShortArrayElements

  instance Reflect (IOVector Int16) where
    reflect = reflectMVector newShortArray setShortArrayRegion

  instance Interpretation (IOVector Int32) where
    type Interp (IOVector Int32) = 'Array ('Prim "int")

  instance Reify (IOVector Int32) where
    reify = reifyMVector (getIntArrayElements) (releaseIntArrayElements)

  instance Reflect (IOVector Int32) where
    reflect = reflectMVector (newIntArray) (setIntArrayRegion)

  instance Interpretation (IOVector Int64) where
    type Interp (IOVector Int64) = 'Array ('Prim "long")

  instance Reify (IOVector Int64) where
    reify = reifyMVector getLongArrayElements releaseLongArrayElements

  instance Reflect (IOVector Int64) where
    reflect = reflectMVector newLongArray setLongArrayRegion

  instance Interpretation (IOVector Float) where
    type Interp (IOVector Float) = 'Array ('Prim "float")

  instance Reify (IOVector Float) where
    reify = reifyMVector getFloatArrayElements releaseFloatArrayElements

  instance Reflect (IOVector Float) where
    reflect = reflectMVector newFloatArray setFloatArrayRegion

  instance Interpretation (IOVector Double) where
    type Interp (IOVector Double) = 'Array ('Prim "double")

  instance Reify (IOVector Double) where
    reify = reifyMVector (getDoubleArrayElements) (releaseDoubleArrayElements)

  instance Reflect (IOVector Double) where
    reflect = reflectMVector (newDoubleArray) (setDoubleArrayRegion)

  instance Interpretation (IOVector a) => Interpretation (Vector a) where
    type Interp (Vector a) = Interp (IOVector a)

  instance (Storable a, Reify (IOVector a)) => Reify (Vector a) where
    reify = Vector.freeze <=< reify

  instance (Storable a, Reflect (IOVector a)) => Reflect (Vector a) where
    reflect = reflect <=< Vector.thaw

  instance Interpretation a => Interpretation [a] where
    type Interp [a] = 'Array (Interp a)

  instance Reify a => Reify [a] where
    reify jobj = do
        n <- getArrayLength jobj
        forM [0..n-1] $ \i -> do
          jx <- getObjectArrayElement jobj i
          x  <- reify jx
          deleteLocalRef jx
          return x

  instance Reflect a => Reflect [a] where
    reflect xs = do
      let n = fromIntegral (length xs)
      array <- newArray n :: IO (J ('Array (Interp a)))
      forM_ (zip [0..n-1] xs) $ \(i, x) -> do
        jx <- reflect x
        setObjectArrayElement array i jx
        deleteLocalRef jx
      return array
  |]