jvm 0.2.0 → 0.2.1
raw patch · 2 files changed
+41/−21 lines, 2 filesdep +choice
Dependencies added: choice
Files
- jvm.cabal +2/−1
- src/Language/Java.hs +39/−20
jvm.cabal view
@@ -1,5 +1,5 @@ name: jvm-version: 0.2.0+version: 0.2.1 synopsis: Call JVM methods from Haskell. description: Please see README.md. homepage: http://github.com/tweag/inline-java/tree/master/jvm#readme@@ -25,6 +25,7 @@ build-depends: base >= 4.7 && < 5, bytestring >=0.10,+ choice >= 0.1, distributed-closure >=0.3, jni >= 0.3.0, singletons >= 2.0,
src/Language/Java.hs view
@@ -55,6 +55,7 @@ , call , callStatic , jvalue+ , CoercionFailure(..) , Coercible(..) , Reify(..) , Reflect(..)@@ -66,10 +67,13 @@ import Control.Distributed.Closure import Control.Distributed.Closure.TH+import Control.Exception (Exception, throw) import Control.Monad import Data.Char (chr, ord)+import qualified Data.Choice as Choice import qualified Data.Coerce as Coerce import Data.Int+import Data.Typeable (Typeable, TypeRep, typeOf) import Data.Word import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS@@ -78,15 +82,16 @@ import Data.String (fromString) import qualified Data.Text.Foreign as Text import Data.Text (Text)-#if ! __GLASGOW_HASKELL__ == 800+#if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1) 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 (FunPtr, Ptr, Storable, newForeignPtr, withForeignPtr)+import Foreign (Ptr, Storable, withForeignPtr)+import Foreign.Concurrent (newForeignPtr) #endif import Foreign.C (CChar)-import Foreign.JNI+import Foreign.JNI hiding (throw) import Foreign.JNI.Types import qualified Foreign.JNI.String as JNI import GHC.TypeLits (KnownSymbol, Symbol)@@ -123,45 +128,64 @@ -- | The identity instance. instance SingI ty => Coercible (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+ { coercionActual :: JValue+ , coercionExpected :: TypeRep+ }++instance Exception CoercionFailure++instance Show CoercionFailure where+ show (CoercionFailure actual expected) =+ "Can't coerce " ++ show actual ++ " to " ++ show expected ++ "."++withTypeRep :: Typeable a => (TypeRep -> a) -> a+withTypeRep f = let x = f (typeOf x) in x+ instance Coercible Bool ('Prim "boolean") where coerce x = JBoolean (fromIntegral (fromEnum x)) unsafeUncoerce (JBoolean x) = toEnum (fromIntegral x)- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible CChar ('Prim "byte") where coerce = JByte unsafeUncoerce (JByte x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Char ('Prim "char") where coerce x = JChar (fromIntegral (ord x)) unsafeUncoerce (JChar x) = chr (fromIntegral x)- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Word16 ('Prim "char") where coerce = JChar unsafeUncoerce (JChar x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Int16 ('Prim "short") where coerce = JShort unsafeUncoerce (JShort x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Int32 ('Prim "int") where coerce = JInt unsafeUncoerce (JInt x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Int64 ('Prim "long") where coerce = JLong unsafeUncoerce (JLong x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Float ('Prim "float") where coerce = JFloat unsafeUncoerce (JFloat x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible Double ('Prim "double") where coerce = JDouble unsafeUncoerce (JDouble x) = x- unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type."+ unsafeUncoerce val = withTypeRep (throw . CoercionFailure val) instance Coercible () 'Void where coerce = error "Void value undefined." unsafeUncoerce _ = ()+instance Coercible (Choice.Choice a) ('Prim "boolean") where+ coerce = coerce . Choice.toBool+ unsafeUncoerce = Choice.fromBool . unsafeUncoerce -- | Get the Java class of an object or anything 'Coercible' to one. classOf@@ -317,11 +341,7 @@ => Reflect a ty where reflect :: a -> IO (J ty) -#if ! __GLASGOW_HASKELL__ == 800-foreign import ccall "wrapper" wrapFinalizer- :: (Ptr a -> IO ())- -> IO (FunPtr (Ptr a -> IO ()))-+#if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1) reifyMVector :: Storable a => (JArray ty -> IO (Ptr a))@@ -331,8 +351,7 @@ reifyMVector mk finalize jobj = do n <- getArrayLength jobj ptr <- mk jobj- ffinalize <- wrapFinalizer (finalize jobj)- fptr <- newForeignPtr ffinalize ptr+ fptr <- newForeignPtr ptr (finalize jobj ptr) return (MVector.unsafeFromForeignPtr0 fptr (fromIntegral n)) reflectMVector@@ -483,7 +502,7 @@ -- Instances can't be compiled on GHC 8.0.1 due to -- https://ghc.haskell.org/trac/ghc/ticket/12082.-#if ! __GLASGOW_HASKELL__ == 800+#if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1) type instance Interp (IOVector Int32) = 'Array ('Prim "int") instance Reify (IOVector Int32) ('Array ('Prim "int")) where