#line 1 "src/Foreign/Java/Bindings/Support.cpphs"
module Foreign.Java.Bindings.Support where
import Control.Monad.State hiding (void)
import Data.Int
import Data.Word
import Data.Maybe
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.Java
import Foreign.Java.JavaMonad
import Foreign.Java.Types as T
import qualified Foreign.Java.JNI.Safe as JNI
import qualified Foreign.Java.JNI.Types as Core
object' :: String -> Q
object' = T.object'
class JBoolean a where toBoolean :: a -> Java Bool
class JChar a where toChar :: a -> Java Word16
class JByte a where toByte :: a -> Java Int8
class JShort a where toShort :: a -> Java Int16
class JInt a where toInt :: a -> Java Int32
class JLong a where toLong :: a -> Java Int64
class JFloat a where toFloat :: a -> Java Float
class JDouble a where toDouble :: a -> Java Double
instance JBoolean Bool where toBoolean = return
instance JChar Char where toChar = return . fromIntegral . fromEnum
instance JChar Int8 where toChar = return . fromIntegral
instance JChar Word16 where toChar = return
instance JByte Int8 where toByte = return
instance JShort Int8 where toShort = return . fromIntegral
instance JShort Word8 where toShort = return . fromIntegral
instance JShort Int16 where toShort = return
instance JInt Int where toInt = return . fromIntegral
instance JInt Int8 where toInt = return . fromIntegral
instance JInt Word8 where toInt = return . fromIntegral
instance JInt Int16 where toInt = return . fromIntegral
instance JInt Word16 where toInt = return . fromIntegral
instance JInt Int32 where toInt = return
instance JLong Int where toLong = return . fromIntegral
instance JLong Int8 where toLong = return . fromIntegral
instance JLong Word8 where toLong = return . fromIntegral
instance JLong Int16 where toLong = return . fromIntegral
instance JLong Word16 where toLong = return . fromIntegral
instance JLong Int32 where toLong = return . fromIntegral
instance JLong Word32 where toLong = return . fromIntegral
instance JLong Int64 where toLong = return
instance JFloat CFloat where toFloat = return . realToFrac
instance JFloat Float where toFloat = return
instance JDouble CDouble where toDouble = return . realToFrac
instance JDouble Double where toDouble = return
class Array a where
asMaybeArrayObject :: a -> Java (Maybe JObject)
class BooleanResult m where { toBooleanResult :: Either JThrowable Bool -> Java m } ; instance BooleanResult Bool where { toBooleanResult = either (\exc -> toString exc >>= fail) return } ; instance BooleanResult (Either JThrowable Bool) where { toBooleanResult = return }
class CharResult m where { toCharResult :: Either JThrowable Word16 -> Java m } ; instance CharResult Word16 where { toCharResult = either (\exc -> toString exc >>= fail) return } ; instance CharResult (Either JThrowable Word16) where { toCharResult = return }
class ByteResult m where { toByteResult :: Either JThrowable Int8 -> Java m } ; instance ByteResult Int8 where { toByteResult = either (\exc -> toString exc >>= fail) return } ; instance ByteResult (Either JThrowable Int8) where { toByteResult = return }
class ShortResult m where { toShortResult :: Either JThrowable Int16 -> Java m } ; instance ShortResult Int16 where { toShortResult = either (\exc -> toString exc >>= fail) return } ; instance ShortResult (Either JThrowable Int16) where { toShortResult = return }
class IntResult m where { toIntResult :: Either JThrowable Int32 -> Java m } ; instance IntResult Int32 where { toIntResult = either (\exc -> toString exc >>= fail) return } ; instance IntResult (Either JThrowable Int32) where { toIntResult = return }
class LongResult m where { toLongResult :: Either JThrowable Int64 -> Java m } ; instance LongResult Int64 where { toLongResult = either (\exc -> toString exc >>= fail) return } ; instance LongResult (Either JThrowable Int64) where { toLongResult = return }
class FloatResult m where { toFloatResult :: Either JThrowable Float -> Java m } ; instance FloatResult Float where { toFloatResult = either (\exc -> toString exc >>= fail) return } ; instance FloatResult (Either JThrowable Float) where { toFloatResult = return }
class DoubleResult m where { toDoubleResult :: Either JThrowable Double -> Java m } ; instance DoubleResult Double where { toDoubleResult = either (\exc -> toString exc >>= fail) return } ; instance DoubleResult (Either JThrowable Double) where { toDoubleResult = return }
class VoidResult m where
toVoidResult :: Either JThrowable () -> Java m
instance VoidResult () where
toVoidResult = either (\exc -> toString exc >>= fail) return
instance VoidResult (Either JThrowable ()) where
toVoidResult = return
instance VoidResult (Maybe JThrowable) where
toVoidResult = return . either Just (const Nothing)
class JavaArray (ArrayResultType m) (ArrayResultComponent m) => ArrayResult m where
type ArrayResultType m
type ArrayResultComponent m
toArrayResult :: Either JThrowable (Maybe (JArray (ArrayResultType m))) -> Java m
instance ArrayResult a => ArrayResult (Either JThrowable a) where
type ArrayResultType (Either JThrowable a) = ArrayResultType a
type ArrayResultComponent (Either JThrowable a) = ArrayResultComponent a
toArrayResult = either (return . Left) (toArrayResult . Right)
instance ArrayResult [Bool] where { type ArrayResultType [Bool] = T.Z ; type ArrayResultComponent [Bool] = Bool ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Word16] where { type ArrayResultType [Word16] = T.C ; type ArrayResultComponent [Word16] = Word16 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Int8] where { type ArrayResultType [Int8] = T.B ; type ArrayResultComponent [Int8] = Int8 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Int16] where { type ArrayResultType [Int16] = T.S ; type ArrayResultComponent [Int16] = Int16 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Int32] where { type ArrayResultType [Int32] = T.I ; type ArrayResultComponent [Int32] = Int32 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Int64] where { type ArrayResultType [Int64] = T.J ; type ArrayResultComponent [Int64] = Int64 ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Float] where { type ArrayResultType [Float] = T.F ; type ArrayResultComponent [Float] = Float ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Double] where { type ArrayResultType [Double] = T.D ; type ArrayResultComponent [Double] = Double ; toArrayResult = either (\exc -> toString exc >>= fail) (maybe (return []) toList) }
instance ArrayResult [Char] where
type ArrayResultType [Char] = T.C
type ArrayResultComponent [Char] = Word16
toArrayResult = either (\exc -> toString exc >>= fail)
(maybe (return [])
(fmap (map (toEnum . fromIntegral)) . toList))
instance ArrayResult [String] where
type ArrayResultType [String] = T.L
type ArrayResultComponent [String] = Maybe JObject
toArrayResult =
either (\exc -> toString exc >>= fail)
(maybe (return [])
(\arr -> toList arr >>= mapM (maybe (return "") toString)))
class ObjectResult m where
toObjectResult :: Either JThrowable (Maybe JObject) -> Java m
instance UnsafeCast a => ObjectResult (Value JThrowable a) where
toObjectResult = either (return . Fail)
(maybe (return NoValue)
(fmap Value . unsafeFromJObject))
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)
class InstanceOf a where
type CoercedType a
instanceOf :: JavaObject o => o -> a -> Java Bool
whenInstanceOf :: JavaObject o => o -> a -> (CoercedType a -> Java d) -> Java (Maybe d)
coerce :: JavaObject o => o -> a -> Java (Maybe (CoercedType a))
instanceOf o t =
whenInstanceOf o t (return . const ())
>>= return . maybe False (const True)
whenInstanceOf o t a =
coerce o t >>= maybe (return Nothing) (fmap Just . a)
coerce o t = whenInstanceOf o t return
class UnsafeCast a where
unsafeFromJObject :: JObject -> Java a
registerCallbacks :: Core.JClass -> Java Bool
registerCallbacks (Core.JClass ptr) = do
vm <- getVM
io $ withForeignPtr ptr $ \clazz -> JNI.registerCallbacks vm clazz
type WrappedFun = Ptr Core.JVM
-> Ptr Core.JObjectRef
-> Ptr Core.JObjectRef
-> Ptr Core.JObjectRef
-> IO (Ptr Core.JObjectRef)
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)
foreign export ccall freeFunPtr :: FunPtr WrappedFun -> IO ()
freeFunPtr :: FunPtr WrappedFun -> 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
iface <- getClass ifaceName >>= asObject . fromJust
(Just clazz) <- getClass "HFunction"
_success <- registerCallbacks clazz
makeFunction <- clazz `bindStaticMethod` "makeFunction"
::= object "java.lang.Class" --> long --> object "java.lang.Object"
(Just impl) <- io (intify func) >>= makeFunction (Just iface)
return impl
delete :: Core.JObject -> Java ()
delete (Core.JObject ptr) = io $ do
finalizeForeignPtr ptr