| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Language.Java.Unsafe
Description
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 marshallunmarshall Java objects fromto 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.
Synopsis
- withJVM :: [ByteString] -> IO a -> IO a
- classOf :: forall a sym. (Ty a ~ 'Class sym, Coercible a, KnownSymbol sym) => a -> String
- getClass :: IsReferenceType ty => Sing (ty :: JType) -> IO JClass
- setGetClassFunction :: (forall ty. IsReferenceType ty => Sing (ty :: JType) -> IO JClass) -> IO ()
- new :: forall a f sym. (Ty a ~ 'Class sym, Coercible a (J ('Class sym)), Coercible a, VariadicIO f a) => f
- newArray :: forall ty. SingI ty => Int32 -> IO (J ('Array ty))
- toArray :: forall ty. (SingI ty, IsReferenceType ty) => [J ty] -> IO (J ('Array ty))
- call :: forall a b ty f. (VariadicIO f b, ty ~ Ty a, IsReferenceType ty, Coercible a, Coercible b, Coercible a (J ty)) => a -> String -> f
- callStatic :: forall a ty f. (ty ~ Ty a, Coercible a, VariadicIO f a) => String -> String -> f
- getStaticField :: forall a ty. (ty ~ Ty a, Coercible a) => String -> String -> IO a
- type VariadicIO f b = (ReturnTypeIO f ~ b, VariadicIO_ f)
- push :: (MonadCatch m, MonadIO m) => m (Pop a) -> m a
- pushWithSizeHint :: forall a m. (MonadCatch m, MonadIO m) => Int32 -> m (Pop a) -> m a
- data Pop a where
- pop :: Monad m => m (Pop ())
- popWithObject :: (ty ~ Ty a, Coercible a, Coercible a (J ty), IsReferenceType ty, Monad m) => a -> m (Pop a)
- popWithValue :: Monad m => a -> m (Pop a)
- withLocalRef :: (MonadMask m, MonadIO m, Coercible o (J ty)) => m o -> (o -> m a) -> m a
- data CoercionFailure = CoercionFailure {
- coercionActual :: JValue
- coercionExpected :: TypeRep
- class SingI (Ty a) => Coercible a where
- type Ty a :: JType
- coerce :: a -> JValue
- unsafeUncoerce :: JValue -> a
- jvalue :: (ty ~ Ty a, Coercible a) => a -> JValue
- jobject :: (ty ~ Ty a, Coercible a, IsReferenceType ty) => a -> J ty
- class (SingI (Interp a), IsReferenceType (Interp a)) => Interpretation (a :: k) where
- type Interp a :: JType
- class Interpretation a => Reify a where
- class Interpretation a => Reflect a where
- sing :: SingI a => Sing a
JVM instance management
withJVM :: [ByteString] -> IO a -> IO a #
JVM calls
classOf :: forall a sym. (Ty a ~ 'Class sym, Coercible a, KnownSymbol sym) => a -> String Source #
Get the Java class of an object or anything Coercible to one.
getClass :: IsReferenceType ty => Sing (ty :: JType) -> IO JClass Source #
Yields a class referece. It behaves as findClass unless setGetClassFunction is used.
setGetClassFunction :: (forall ty. IsReferenceType ty => Sing (ty :: JType) -> IO JClass) -> IO () Source #
Sets the function to use for loading classes.
findClass is used by default.
new :: forall a f sym. (Ty a ~ 'Class sym, Coercible a (J ('Class sym)), Coercible a, VariadicIO f a) => f Source #
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.
newArray :: forall ty. SingI ty => Int32 -> IO (J ('Array ty)) Source #
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")) <-newArray50 return arr
toArray :: forall ty. (SingI ty, IsReferenceType ty) => [J ty] -> IO (J ('Array ty)) Source #
Creates an array from a list of references.
call :: forall a b ty f. (VariadicIO f b, ty ~ Ty a, IsReferenceType ty, Coercible a, Coercible b, Coercible a (J ty)) => a -> String -> f Source #
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
Arguments
| :: forall a ty f. (ty ~ Ty a, Coercible a, VariadicIO f a) | |
| => String | Class name |
| -> String | Method name |
| -> f |
Arguments
| :: forall a ty. (ty ~ Ty a, Coercible a) | |
| => String | Class name |
| -> String | Static field name |
| -> IO a |
Get a static field.
type VariadicIO f b = (ReturnTypeIO f ~ b, VariadicIO_ f) Source #
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ₙ)
Reference management
push :: (MonadCatch m, MonadIO m) => m (Pop a) -> m a Source #
Open a new scope for allocating (JNI) local references to JVM objects.
pushWithSizeHint :: forall a m. (MonadCatch m, MonadIO m) => Int32 -> m (Pop a) -> m a Source #
Like push, but specify explicitly a minimum size for the frame. You probably don't need this.
popWithObject :: (ty ~ Ty a, Coercible a, Coercible a (J ty), IsReferenceType ty, Monad m) => a -> m (Pop a) Source #
Pop a frame and return a JVM object.
popWithValue :: Monad m => a -> m (Pop a) Source #
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.
withLocalRef :: (MonadMask m, MonadIO m, Coercible o (J ty)) => m o -> (o -> m a) -> m a Source #
Create a local ref and delete it when the given action completes.
Coercions
data CoercionFailure Source #
A JNI call may cause a (Java) exception to be raised. This module raises it as a Haskell exception wrapping the Java exception.
Constructors
| CoercionFailure | |
Fields
| |
Instances
| Show CoercionFailure Source # | |
Defined in Language.Java.Unsafe Methods showsPrec :: Int -> CoercionFailure -> ShowS # show :: CoercionFailure -> String # showList :: [CoercionFailure] -> ShowS # | |
| Exception CoercionFailure Source # | |
Defined in Language.Java.Unsafe Methods toException :: CoercionFailure -> SomeException # | |
class SingI (Ty a) => Coercible a where Source #
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.
Minimal complete definition
Nothing
Methods
coerce :: a -> JValue Source #
unsafeUncoerce :: JValue -> a Source #
default unsafeUncoerce :: Coercible (J (Ty a)) a => JValue -> a Source #
Instances
| Coercible Bool Source # | |
| Coercible Char Source # | |
| Coercible Double Source # | |
| Coercible Float Source # | |
| Coercible Int16 Source # | |
| Coercible Int32 Source # | |
| Coercible Int64 Source # | |
| Coercible Word16 Source # | |
| Coercible () Source # | |
Defined in Language.Java.Unsafe | |
| Coercible CChar Source # | |
| SingI ty => Coercible (J ty) Source # | The identity instance. |
Defined in Language.Java.Unsafe | |
| Coercible (Choice a) Source # | |
Defined in Language.Java.Unsafe | |
jvalue :: (ty ~ Ty a, Coercible a) => a -> JValue Source #
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.
jobject :: (ty ~ Ty a, Coercible a, IsReferenceType ty) => a -> J ty Source #
If ty is a reference type, then it should be possible to get an object from a value.
Conversions
class (SingI (Interp a), IsReferenceType (Interp a)) => Interpretation (a :: k) Source #
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.
Associated Types
type Interp a :: JType Source #
Map a Haskell type to the symbolic representation of a Java type.
Instances
class Interpretation a => Reify a where Source #
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.
Minimal complete definition
Nothing
Methods
reify :: J (Interp a) -> IO a Source #
Invariant: The result and the argument share no direct JVM object references.
Instances
| Reify Bool Source # | |
| Reify Double Source # | |
| Reify Float Source # | |
| Reify Int16 Source # | |
| Reify Int32 Source # | |
| Reify Int64 Source # | |
| Reify Word16 Source # | |
| Reify () Source # | |
| Reify CChar Source # | |
| Reify ByteString Source # | |
Defined in Language.Java.Unsafe Methods reify :: J (Interp ByteString) -> IO ByteString Source # | |
| Reify Text Source # | |
| Reify a => Reify [a] Source # | |
| Interpretation (J ty) => Reify (J ty) Source # | |
| (Storable a, Reify (IOVector a)) => Reify (Vector a) Source # | |
| Reify (IOVector Double) Source # | |
| Reify (IOVector Float) Source # | |
| Reify (IOVector Int16) Source # | |
| Reify (IOVector Int32) Source # | |
| Reify (IOVector Int64) Source # | |
| Reify (IOVector Word16) Source # | |
| Static (Reify Bool) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Bool)) | |
| Static (Reify Double) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Double)) | |
| Static (Reify Float) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Float)) | |
| Static (Reify Int16) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Int16)) | |
| Static (Reify Int32) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Int32)) | |
| Static (Reify Int64) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Int64)) | |
| (Typeable (Dict (Reify [a])), Typeable (Dict (Reify a)), Static (Reify a)) => Static (Reify [a]) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify [a])) | |
| Static (Reify Word16) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Word16)) | |
| Static (Reify ()) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify ())) | |
| Static (Reify CChar) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify CChar)) | |
| Static (Reify ByteString) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify ByteString)) | |
| Static (Reify Text) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify Text)) | |
| (Typeable (Dict (Reify (J ty))), Typeable (Dict (Interpretation (J ty))), Static (Interpretation (J ty))) => Static (Reify (J ty)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (J ty))) | |
| (Typeable (Dict (Reify (Vector a))), Typeable (Dict (Storable a)), Typeable (Dict (Reify (IOVector a))), Static (Storable a), Static (Reify (IOVector a))) => Static (Reify (Vector a)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (Vector a))) | |
| Static (Reify (IOVector Double)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Double))) | |
| Static (Reify (IOVector Float)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Float))) | |
| Static (Reify (IOVector Int16)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Int16))) | |
| Static (Reify (IOVector Int32)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Int32))) | |
| Static (Reify (IOVector Int64)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Int64))) | |
| Static (Reify (IOVector Word16)) Source # | |
Defined in Language.Java.Unsafe Methods closureDict :: Closure (Dict (Reify (IOVector Word16))) | |
class Interpretation a => Reflect a where Source #
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.
Minimal complete definition
Nothing
Methods
reflect :: a -> IO (J (Interp a)) Source #
Invariant: The result and the argument share no direct JVM object references.