java-bridge 0.9 → 0.99

raw patch · 7 files changed

+161/−92 lines, 7 filesdep +hxPVP ok

version bump matches the API change (PVP)

Dependencies added: hx

API changes (from Hackage documentation)

Files

• dist/build/Foreign/Java.hs +8/−1
• dist/build/Foreign/Java/Bindings.hs +68/−42
• java-bridge.cabal +2/−1
• src/Foreign/Java.cpphs +8/−1
• src/Foreign/Java/Bindings.cpphs +68/−42
• src/Foreign/Java/JavaMonad.hs +1/−1
• src/Foreign/Java/Value.hs +6/−4

@@ -213,14 +213,21 @@     asObject :: a -> Java JObject      -- | Returns a reference to the Class of the given object.-    classOf  :: a -> Java JClass+    classOf :: a -> Java JClass +    -- | Returns a string representation of the type.+    jtypeOf :: a -> Java String+     -- | Checks two objects for equality using their @equals@ methods.     equals   :: JavaObject b => a -> b -> Java Bool      toString obj = asObject obj >>= toString     hashCode obj = asObject obj >>= hashCode     classOf obj  = asObject obj >>= classOf+    jtypeOf obj  = do+        (Just clazz) <- getClass "java.lang.Class"+        getName <- clazz `bindMethod` "getName" ::= string+        classOf obj >>= asObject >>= getName >>= return . maybe "" id      equals this obj = do         this'  <- asObject this

@@ -4,6 +4,9 @@     , FlexibleContexts     , FlexibleInstances     , TypeSynonymInstances+    , MultiParamTypeClasses+    , ScopedTypeVariables+    , NoImplicitPrelude  #-} {-# OPTIONS     -Wall@@ -23,15 +26,12 @@ -- not be imported directly. module Foreign.Java.Bindings where -import Control.Monad.State hiding (void)+import Haskell.X.Prelude hiding (toList, arr) -import Data.Int-import Data.Word-import Data.Maybe+import Control.Monad.State hiding (void) -import Foreign.Ptr-import Foreign.ForeignPtr-import Foreign.C.Types+import Foreign+import Foreign.C  import Foreign.Java import Foreign.Java.JavaMonad@@ -45,7 +45,7 @@ ---------------  -object' :: String -> Q+object' :: [Char] -> Q object' = T.object'  @@ -199,9 +199,9 @@                            (maybe (return [])                                   (fmap (map (toEnum . fromIntegral)) . toList)) -instance ArrayResult [String] where-    type ArrayResultType [String] = T.L-    type ArrayResultComponent [String] = Maybe JObject+instance ArrayResult [[Char]] where+    type ArrayResultType [[Char]] = T.L+    type ArrayResultComponent [[Char]] = Maybe JObject      toArrayResult =         either (\exc -> toString exc >>= fail)@@ -214,37 +214,55 @@ -- All other objects -- ----------------------- +newtype AsString o = AsString [Char]+    deriving (Eq, Show, Ord) +newtype AsList a o = AsList [a]+    deriving (Eq, Show, Ord)++class ObjectToList o e where+    objectToList :: o -> JObject -> Java [e]+ -- | The result of a function call that is of type @object@. class ObjectResult m where     -- |      toObjectResult :: Either JThrowable (Maybe JObject) -> Java m -instance UnsafeCast a => ObjectResult (Value JThrowable a) where+instance ObjectResult (AsString a) where+    toObjectResult = fmap AsString . either (\exc -> toString exc >>= fail)+                                            (maybe (return "null") toString)++instance ObjectToList o e => ObjectResult (AsList e o) where+    toObjectResult = fmap AsList . either (\exc -> toString exc >>= fail)+                                          (maybe (return []) (objectToList (undefined :: o)))++instance UnsafeCast a => ObjectResult (Value a) where     toObjectResult = either (return . Fail)                             (maybe (return NoValue)                                    (fmap Value . unsafeFromJObject)) +instance UnsafeCast a => ObjectResult (Either JThrowable a) where+    toObjectResult = either (return . Left)+                            (maybe (fmap Left nullPointer)+                                   (fmap Right . unsafeFromJObject))+      where+        nullPointer :: Java JThrowable+        nullPointer = do+            (Just clazz) <- getClass "java.lang.NullPointerException"+            (Just (Core.JObject obj)) <- newObject clazz+            return $ Core.JThrowable (castForeignPtr obj)+ instance UnsafeCast a => ObjectResult (Either (Maybe JThrowable) a) where     toObjectResult = either (return . Left . Just)                             (maybe (return (Left Nothing))                                    (fmap Right . unsafeFromJObject)) -instance UnsafeCast a => ObjectResult (Either JThrowable (Maybe a)) where-    toObjectResult = either (return . Left)-                            (fmap Right . maybe (return Nothing)-                                                (fmap Just . unsafeFromJObject))- instance UnsafeCast a => ObjectResult (Maybe a) where     toObjectResult = either (\exc -> toString exc >>= fail)                             (maybe (return Nothing)                                    (fmap Just . unsafeFromJObject)) -instance ObjectResult [Char] where-    toObjectResult = either (\exc -> toString exc >>= fail)-                            (maybe (return "null") toString) - --------------------------------------------------- -- Advanced features (Callbacks, Subtyping, ...) -- ---------------------------------------------------@@ -303,45 +321,32 @@     vm <- getVM     io $ withForeignPtr ptr $ \clazz -> JNI.registerCallbacks vm clazz + -- | A wrapped function can be used as a callback from the -- JVM into the Haskell runtime environment.-type WrappedFun = Ptr Core.JVM -- Ptr to JEnv+type WrappedFunc = Ptr Core.JVM -- Ptr to JEnv                -> Ptr Core.JObjectRef -- Ptr to this, a proxy                -> Ptr Core.JObjectRef -- Ptr to method, the requested method                -> Ptr Core.JObjectRef -- Ptr to a JObject-Array (Object[]), the arguments                -> IO (Ptr Core.JObjectRef) -- Returns a pointer to the result +type InterfaceFunc = JObject -> JObject -> JObject -> Java (Maybe JObject)  runJava_ :: Ptr Core.JVM -> Java a -> IO a runJava_ vm f = runStateT (_runJava f) (newJVMState vm) >>= return . fst  foreign import ccall safe "wrapper"-    wrap_ :: WrappedFun -> IO (FunPtr WrappedFun)+    wrap_ :: WrappedFunc -> IO (FunPtr WrappedFunc) -foreign export ccall freeFunPtr :: FunPtr WrappedFun -> IO ()+foreign export ccall freeFunPtr :: FunPtr WrappedFunc -> IO ()  -freeFunPtr :: FunPtr WrappedFun -> IO ()+freeFunPtr :: FunPtr WrappedFunc -> IO () freeFunPtr ptr = freeHaskellFunPtr ptr  -wrap :: Java () -> IO (FunPtr WrappedFun)-wrap f = do--    let func vm _self _method _args = do-            runJava_ vm f-            return nullPtr-            -    func' <- wrap_ func--    return func'--intify :: Java () -> IO Int64-intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap---sushimaki :: String -> Java () -> Java JObject-sushimaki ifaceName func = do+implementInterfaceBy :: [Char] -> InterfaceFunc -> Java JObject+implementInterfaceBy ifaceName func = do     iface <- getClass ifaceName >>= asObject . fromJust     (Just clazz) <- getClass "HFunction"     _success <- registerCallbacks clazz@@ -349,6 +354,27 @@         ::= object "java.lang.Class" --> long --> object "java.lang.Object"     (Just impl) <- io (intify func) >>= makeFunction (Just iface)     return impl+  where+    wrap :: InterfaceFunc -> IO (FunPtr WrappedFunc)+    wrap f = do++        let proxyFunc vm self method args = do+                self'   <- Core.JObject <$> newForeignPtr JNI.release self+                method' <- Core.JObject <$> newForeignPtr JNI.release method+                args'   <- Core.JObject <$> newForeignPtr JNI.release args++                jobj <- runJava_ vm (f self' method' args')++                case jobj of+                    Nothing -> return nullPtr+                    Just (Core.JObject ptr) -> withForeignPtr ptr return++        wrappedFunc <- wrap_ proxyFunc++        return wrappedFunc++    intify :: InterfaceFunc -> IO Int64+    intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap   delete :: Core.JObject -> Java ()

@@ -1,5 +1,5 @@ name:           java-bridge-version:        0.9+version:        0.99  license:        MIT license-file:   LICENSE@@ -154,6 +154,7 @@                             , strings >= 1.1                             , mtl >= 2.1.1                             , transformers >= 0.3+                            , hx >= 0.4          other-modules:      Foreign.Java.Types                             , Foreign.Java.JavaMonad

@@ -212,14 +212,21 @@     asObject :: a -> Java JObject      -- | Returns a reference to the Class of the given object.-    classOf  :: a -> Java JClass+    classOf :: a -> Java JClass +    -- | Returns a string representation of the type.+    jtypeOf :: a -> Java String+     -- | Checks two objects for equality using their @equals@ methods.     equals   :: JavaObject b => a -> b -> Java Bool      toString obj = asObject obj >>= toString     hashCode obj = asObject obj >>= hashCode     classOf obj  = asObject obj >>= classOf+    jtypeOf obj  = do+        (Just clazz) <- getClass "java.lang.Class"+        getName <- clazz `bindMethod` "getName" ::= string+        classOf obj >>= asObject >>= getName >>= return . maybe "" id      equals this obj = do         this'  <- asObject this

@@ -3,6 +3,9 @@     , FlexibleContexts     , FlexibleInstances     , TypeSynonymInstances+    , MultiParamTypeClasses+    , ScopedTypeVariables+    , NoImplicitPrelude  #-} {-# OPTIONS     -Wall@@ -22,15 +25,12 @@ -- not be imported directly. module Foreign.Java.Bindings where -import Control.Monad.State hiding (void)+import Haskell.X.Prelude hiding (toList, arr) -import Data.Int-import Data.Word-import Data.Maybe+import Control.Monad.State hiding (void) -import Foreign.Ptr-import Foreign.ForeignPtr-import Foreign.C.Types+import Foreign+import Foreign.C  import Foreign.Java import Foreign.Java.JavaMonad@@ -44,7 +44,7 @@ ---------------  -object' :: String -> Q+object' :: [Char] -> Q object' = T.object'  @@ -198,9 +198,9 @@                            (maybe (return [])                                   (fmap (map (toEnum . fromIntegral)) . toList)) -instance ArrayResult [String] where-    type ArrayResultType [String] = T.L-    type ArrayResultComponent [String] = Maybe JObject+instance ArrayResult [[Char]] where+    type ArrayResultType [[Char]] = T.L+    type ArrayResultComponent [[Char]] = Maybe JObject      toArrayResult =         either (\exc -> toString exc >>= fail)@@ -213,37 +213,55 @@ -- All other objects -- ----------------------- +newtype AsString o = AsString [Char]+    deriving (Eq, Show, Ord) +newtype AsList a o = AsList [a]+    deriving (Eq, Show, Ord)++class ObjectToList o e where+    objectToList :: o -> JObject -> Java [e]+ -- | The result of a function call that is of type @object@. class ObjectResult m where     -- |      toObjectResult :: Either JThrowable (Maybe JObject) -> Java m -instance UnsafeCast a => ObjectResult (Value JThrowable a) where+instance ObjectResult (AsString a) where+    toObjectResult = fmap AsString . either (\exc -> toString exc >>= fail)+                                            (maybe (return "null") toString)++instance ObjectToList o e => ObjectResult (AsList e o) where+    toObjectResult = fmap AsList . either (\exc -> toString exc >>= fail)+                                          (maybe (return []) (objectToList (undefined :: o)))++instance UnsafeCast a => ObjectResult (Value a) where     toObjectResult = either (return . Fail)                             (maybe (return NoValue)                                    (fmap Value . unsafeFromJObject)) +instance UnsafeCast a => ObjectResult (Either JThrowable a) where+    toObjectResult = either (return . Left)+                            (maybe (fmap Left nullPointer)+                                   (fmap Right . unsafeFromJObject))+      where+        nullPointer :: Java JThrowable+        nullPointer = do+            (Just clazz) <- getClass "java.lang.NullPointerException"+            (Just (Core.JObject obj)) <- newObject clazz+            return $ Core.JThrowable (castForeignPtr obj)+ instance UnsafeCast a => ObjectResult (Either (Maybe JThrowable) a) where     toObjectResult = either (return . Left . Just)                             (maybe (return (Left Nothing))                                    (fmap Right . unsafeFromJObject)) -instance UnsafeCast a => ObjectResult (Either JThrowable (Maybe a)) where-    toObjectResult = either (return . Left)-                            (fmap Right . maybe (return Nothing)-                                                (fmap Just . unsafeFromJObject))- instance UnsafeCast a => ObjectResult (Maybe a) where     toObjectResult = either (\exc -> toString exc >>= fail)                             (maybe (return Nothing)                                    (fmap Just . unsafeFromJObject)) -instance ObjectResult [Char] where-    toObjectResult = either (\exc -> toString exc >>= fail)-                            (maybe (return "null") toString) - --------------------------------------------------- -- Advanced features (Callbacks, Subtyping, ...) -- ---------------------------------------------------@@ -302,45 +320,32 @@     vm <- getVM     io $ withForeignPtr ptr $ \clazz -> JNI.registerCallbacks vm clazz + -- | A wrapped function can be used as a callback from the -- JVM into the Haskell runtime environment.-type WrappedFun = Ptr Core.JVM -- Ptr to JEnv+type WrappedFunc = Ptr Core.JVM -- Ptr to JEnv                -> Ptr Core.JObjectRef -- Ptr to this, a proxy                -> Ptr Core.JObjectRef -- Ptr to method, the requested method                -> Ptr Core.JObjectRef -- Ptr to a JObject-Array (Object[]), the arguments                -> IO (Ptr Core.JObjectRef) -- Returns a pointer to the result +type InterfaceFunc = JObject -> JObject -> JObject -> Java (Maybe JObject)  runJava_ :: Ptr Core.JVM -> Java a -> IO a runJava_ vm f = runStateT (_runJava f) (newJVMState vm) >>= return . fst  foreign import ccall safe "wrapper"-    wrap_ :: WrappedFun -> IO (FunPtr WrappedFun)+    wrap_ :: WrappedFunc -> IO (FunPtr WrappedFunc) -foreign export ccall freeFunPtr :: FunPtr WrappedFun -> IO ()+foreign export ccall freeFunPtr :: FunPtr WrappedFunc -> IO ()  -freeFunPtr :: FunPtr WrappedFun -> IO ()+freeFunPtr :: FunPtr WrappedFunc -> IO () freeFunPtr ptr = freeHaskellFunPtr ptr  -wrap :: Java () -> IO (FunPtr WrappedFun)-wrap f = do--    let func vm _self _method _args = do-            runJava_ vm f-            return nullPtr-            -    func' <- wrap_ func--    return func'--intify :: Java () -> IO Int64-intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap---sushimaki :: String -> Java () -> Java JObject-sushimaki ifaceName func = do+implementInterfaceBy :: [Char] -> InterfaceFunc -> Java JObject+implementInterfaceBy ifaceName func = do     iface <- getClass ifaceName >>= asObject . fromJust     (Just clazz) <- getClass "HFunction"     _success <- registerCallbacks clazz@@ -348,6 +353,27 @@         ::= object "java.lang.Class" --> long --> object "java.lang.Object"     (Just impl) <- io (intify func) >>= makeFunction (Just iface)     return impl+  where+    wrap :: InterfaceFunc -> IO (FunPtr WrappedFunc)+    wrap f = do++        let proxyFunc vm self method args = do+                self'   <- Core.JObject <$> newForeignPtr JNI.release self+                method' <- Core.JObject <$> newForeignPtr JNI.release method+                args'   <- Core.JObject <$> newForeignPtr JNI.release args++                jobj <- runJava_ vm (f self' method' args')++                case jobj of+                    Nothing -> return nullPtr+                    Just (Core.JObject ptr) -> withForeignPtr ptr return++        wrappedFunc <- wrap_ proxyFunc++        return wrappedFunc++    intify :: InterfaceFunc -> IO Int64+    intify = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap   delete :: Core.JObject -> Java ()

@@ -144,7 +144,7 @@ -- Use one of 'runJava' or 'runJava'' to perform operations in the -- Java monad. newtype Java a = Java { _runJava :: StateT JVMState IO a }-    deriving (Monad, MonadState JVMState, Functor, MonadIO)+  deriving (Monad, MonadState JVMState, Functor, MonadIO)  -- | INTERNAL Retrieve the 'jvmPtr' from this Java Monads -- State.

@@ -17,18 +17,20 @@ -- nothing, or a special value describing an error condition. module Foreign.Java.Value where +import Foreign.Java.JNI.Types (JThrowable)+ -- | A ternary value type to hold one of two possible value types -- or none at all.-data Value e a+data Value a   = Value a -- ^ An actual value   | NoValue -- ^ No value-  | Fail e  -- ^ A value describing the error+  | Fail JThrowable -- ^ A value describing the error  -- | fold on a 'Value', like 'either' for 'Either' or 'maybe' for 'Maybe'. value :: b -- ^ default value if neither a value nor a fail value is given-      -> (e -> b) -- ^ function to handle a fail value+      -> (JThrowable -> b) -- ^ function to handle a fail value       -> (a -> b) -- ^ function to handle an actual value-      -> Value e a -- ^ the value+      -> Value a -- ^ the value       -> b -- ^ the final return value value noValue fail success value = case value of     (Value a) -> success a