{-# LANGUAGE
ScopedTypeVariables,
TypeFamilies
#-}
module Graphics.QML.Internal.Objects where
import Graphics.QML.Internal.BindObj
import Graphics.QML.Internal.Marshal
import Graphics.QML.Internal.Types
import Control.Monad.Trans.Maybe
import Data.Tagged
import Data.Typeable
import Foreign.ForeignPtr
newtype ObjRef tt = ObjRef HsQMLObjectHandle
instance (Typeable tt) => Marshal (ObjRef tt) where
type MarshalMode (ObjRef tt) c d = ModeObjBidi tt c
marshaller = Marshaller {
mTypeCVal_ = retag (mTypeCVal :: Tagged AnyObjRef TypeId),
mFromCVal_ = \ptr -> do
anyObj <- mFromCVal ptr
MaybeT $ fromAnyObjRefIO anyObj,
mToCVal_ = \(ObjRef hndl) ptr ->
mToCVal (AnyObjRef hndl) ptr,
mWithCVal_ = \(ObjRef hndl) f ->
mWithCVal (AnyObjRef hndl) f,
mFromJVal_ = \_ ptr -> do
anyObj <- mFromJVal Weak ptr
MaybeT $ fromAnyObjRefIO anyObj,
mWithJVal_ = \(ObjRef hndl) f ->
mWithJVal (AnyObjRef hndl) f,
mFromHndl_ =
return . ObjRef,
mToHndl_ = \(ObjRef hndl) ->
return hndl}
fromObjRefIO :: ObjRef tt -> IO tt
fromObjRefIO (ObjRef hndl) = hsqmlObjectGetHsValue hndl
newtype AnyObjRef = AnyObjRef HsQMLObjectHandle
instance Marshal AnyObjRef where
type MarshalMode AnyObjRef c d = ModeObjBidi No c
marshaller = Marshaller {
mTypeCVal_ = Tagged tyJSValue,
mFromCVal_ = jvalFromCVal,
mToCVal_ = jvalToCVal,
mWithCVal_ = jvalWithCVal,
mFromJVal_ = \_ ptr -> MaybeT $ do
hndl <- hsqmlGetObjectFromJval ptr
return $ if isNullObjectHandle hndl
then Nothing else Just $ AnyObjRef hndl,
mWithJVal_ = \(AnyObjRef hndl@(HsQMLObjectHandle ptr)) f -> do
jval <- hsqmlObjectGetJval hndl
ret <- f jval
touchForeignPtr ptr
return ret,
mFromHndl_ =
return . AnyObjRef,
mToHndl_ = \(AnyObjRef hndl) ->
return hndl}
fromAnyObjRefIO :: forall tt. (Typeable tt) =>
AnyObjRef -> IO (Maybe (ObjRef tt))
fromAnyObjRefIO (AnyObjRef hndl) = do
info <- hsqmlObjectGetHsTyperep hndl
let srcRep = typeOf (undefined :: tt)
dstRep = cinfoObjType info
return $ if srcRep == dstRep
then Just $ ObjRef hndl
else Nothing