jvm 0.2.1 → 0.2.2
raw patch · 3 files changed
+69/−36 lines, 3 filesdep +template-haskell
Dependencies added: template-haskell
Files
- jvm.cabal +3/−1
- src/Language/Java.hs +20/−35
- src/Language/Java/TH.hs +46/−0
jvm.cabal view
@@ -1,5 +1,5 @@ name: jvm-version: 0.2.1+version: 0.2.2 synopsis: Call JVM methods from Haskell. description: Please see README.md. homepage: http://github.com/tweag/inline-java/tree/master/jvm#readme@@ -22,6 +22,7 @@ hs-source-dirs: src exposed-modules: Language.Java+ Language.Java.TH build-depends: base >= 4.7 && < 5, bytestring >=0.10,@@ -29,6 +30,7 @@ distributed-closure >=0.3, jni >= 0.3.0, singletons >= 2.0,+ template-haskell >= 2.10, text >=1.2, vector >=0.11 default-language: Haskell2010
src/Language/Java.hs view
@@ -55,7 +55,6 @@ , call , callStatic , jvalue- , CoercionFailure(..) , Coercible(..) , Reify(..) , Reflect(..)@@ -67,13 +66,11 @@ 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@@ -82,16 +79,15 @@ import Data.String (fromString) import qualified Data.Text.Foreign as Text import Data.Text (Text)-#if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1)+#if ! __GLASGOW_HASKELL__ == 800 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 (FunPtr, Ptr, Storable, newForeignPtr, withForeignPtr) #endif import Foreign.C (CChar)-import Foreign.JNI hiding (throw)+import Foreign.JNI import Foreign.JNI.Types import qualified Foreign.JNI.String as JNI import GHC.TypeLits (KnownSymbol, Symbol)@@ -128,58 +124,42 @@ -- | 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 val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible CChar ('Prim "byte") where coerce = JByte unsafeUncoerce (JByte x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Char ('Prim "char") where coerce x = JChar (fromIntegral (ord x)) unsafeUncoerce (JChar x) = chr (fromIntegral x)- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Word16 ('Prim "char") where coerce = JChar unsafeUncoerce (JChar x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Int16 ('Prim "short") where coerce = JShort unsafeUncoerce (JShort x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Int32 ('Prim "int") where coerce = JInt unsafeUncoerce (JInt x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Int64 ('Prim "long") where coerce = JLong unsafeUncoerce (JLong x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Float ('Prim "float") where coerce = JFloat unsafeUncoerce (JFloat x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible Double ('Prim "double") where coerce = JDouble unsafeUncoerce (JDouble x) = x- unsafeUncoerce val = withTypeRep (throw . CoercionFailure val)+ unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." instance Coercible () 'Void where coerce = error "Void value undefined." unsafeUncoerce _ = ()@@ -341,7 +321,11 @@ => Reflect a ty where reflect :: a -> IO (J ty) -#if ! (__GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1)+#if ! __GLASGOW_HASKELL__ == 800+foreign import ccall "wrapper" wrapFinalizer+ :: (Ptr a -> IO ())+ -> IO (FunPtr (Ptr a -> IO ()))+ reifyMVector :: Storable a => (JArray ty -> IO (Ptr a))@@ -351,7 +335,8 @@ reifyMVector mk finalize jobj = do n <- getArrayLength jobj ptr <- mk jobj- fptr <- newForeignPtr ptr (finalize jobj ptr)+ ffinalize <- wrapFinalizer (finalize jobj)+ fptr <- newForeignPtr ffinalize ptr return (MVector.unsafeFromForeignPtr0 fptr (fromIntegral n)) reflectMVector@@ -502,7 +487,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 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1)+#if ! __GLASGOW_HASKELL__ == 800 type instance Interp (IOVector Int32) = 'Array ('Prim "int") instance Reify (IOVector Int32) ('Array ('Prim "int")) where
+ src/Language/Java/TH.hs view
@@ -0,0 +1,46 @@+-- | Optional code macros for convenience.++{-# LANGUAGE TemplateHaskell #-}++module Language.Java.TH (makeConversions) where++import Control.Distributed.Closure.TH (withStatic)+import qualified Language.Haskell.TH as TH+import Language.Java++-- | Define instances of the three conversion classes, 'Coercible', 'Reify' and+-- 'Reflect' for the given datatype. Example usage:+--+-- @+-- import qualified Language.Java.TH as Java+--+-- newtype JOptionPane = JOptionPane (J ('Class "javax.swing.JOptionPane"))+-- Java.makeConversions ''JOptionPane+-- @+--+-- This is equivalent to:+--+-- @+-- newtype JOptionPane = JOptionPane (J ('Class "javax.swing.JOptionPane"))+-- instance Coercible JOptionPane ('Class "javax.swing.JOptionPane")+-- instance Reify JOptionPane ('Class "javax.swing.JOptionPane")+-- instance Reflect JOptionPane ('Class "javax.swing.JOptionPane")+-- @+makeConversions :: TH.Name -> TH.Q [TH.Dec]+makeConversions x = do+ info <- TH.reify x+ let ty_x = return (TH.ConT x)+ ty_cls = case info of+ TH.TyConI (TH.DataD [] _ _ _ [cstr] _) -> case cstr of+ TH.NormalC _ [(_, TH.AppT (TH.ConT nm) ty)] | nm == ''J -> return ty+ TH.RecC _ [(_, _, TH.AppT (TH.ConT nm) ty)] | nm == ''J -> return ty+ _ -> notsupported+ _ -> notsupported+ withStatic [d|+ instance Coercible $ty_x $ty_cls+ instance Reify $ty_x $ty_cls+ instance Reflect $ty_x $ty_cls+ |]+ where+ notsupported = fail+ "makeConversions failed. Only newtype wrappers of (J ty) are supported."