{-# 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

-- | Represents an instance of the QML class which wraps the type @tt@.
newtype ObjRef tt = ObjRef HsQMLObjectHandle

instance (Typeable tt) => Marshal (ObjRef tt) where
    type MarshalMode (ObjRef tt) c d = ModeObjBidi tt c
    marshaller :: MarshallerFor (ObjRef tt)
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc (ObjRef tt)
mTypeCVal_ = Tagged AnyObjRef TypeId -> MTypeCValFunc (ObjRef tt)
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (Tagged AnyObjRef TypeId
forall t. Marshal t => MTypeCValFunc t
mTypeCVal :: Tagged AnyObjRef TypeId),
        mFromCVal_ :: MFromCValFunc (ObjRef tt)
mFromCVal_ = \Ptr ()
ptr -> do
            AnyObjRef
anyObj <- MFromCValFunc AnyObjRef
forall t. Marshal t => MFromCValFunc t
mFromCVal Ptr ()
ptr
            IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt))
-> IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt)
forall a b. (a -> b) -> a -> b
$ AnyObjRef -> IO (Maybe (ObjRef tt))
forall tt. Typeable tt => AnyObjRef -> IO (Maybe (ObjRef tt))
fromAnyObjRefIO AnyObjRef
anyObj,
        mToCVal_ :: MToCValFunc (ObjRef tt)
mToCVal_ = \(ObjRef HsQMLObjectHandle
hndl) Ptr ()
ptr ->
            MToCValFunc AnyObjRef
forall t. Marshal t => MToCValFunc t
mToCVal (HsQMLObjectHandle -> AnyObjRef
AnyObjRef HsQMLObjectHandle
hndl) Ptr ()
ptr,
        mWithCVal_ :: MWithCValFunc (ObjRef tt)
mWithCVal_ = \(ObjRef HsQMLObjectHandle
hndl) Ptr () -> IO b
f ->
            AnyObjRef -> (Ptr () -> IO b) -> IO b
forall t. Marshal t => MWithCValFunc t
MWithCValFunc AnyObjRef
mWithCVal (HsQMLObjectHandle -> AnyObjRef
AnyObjRef HsQMLObjectHandle
hndl) Ptr () -> IO b
f,
        mFromJVal_ :: MFromJValFunc (ObjRef tt)
mFromJVal_ = \Strength
_ HsQMLJValHandle
ptr -> do
            AnyObjRef
anyObj <- MFromJValFunc AnyObjRef
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
Weak HsQMLJValHandle
ptr
            IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt))
-> IO (Maybe (ObjRef tt)) -> ErrIO (ObjRef tt)
forall a b. (a -> b) -> a -> b
$ AnyObjRef -> IO (Maybe (ObjRef tt))
forall tt. Typeable tt => AnyObjRef -> IO (Maybe (ObjRef tt))
fromAnyObjRefIO AnyObjRef
anyObj,
        mWithJVal_ :: MWithJValFunc (ObjRef tt)
mWithJVal_ = \(ObjRef HsQMLObjectHandle
hndl) HsQMLJValHandle -> IO b
f ->
            AnyObjRef -> (HsQMLJValHandle -> IO b) -> IO b
forall t. Marshal t => MWithJValFunc t
MWithJValFunc AnyObjRef
mWithJVal (HsQMLObjectHandle -> AnyObjRef
AnyObjRef HsQMLObjectHandle
hndl) HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc (ObjRef tt)
mFromHndl_ =
            ObjRef tt -> IO (ObjRef tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjRef tt -> IO (ObjRef tt))
-> (HsQMLObjectHandle -> ObjRef tt) -> MFromHndlFunc (ObjRef tt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsQMLObjectHandle -> ObjRef tt
forall tt. HsQMLObjectHandle -> ObjRef tt
ObjRef,
        mToHndl_ :: MToHndlFunc (ObjRef tt)
mToHndl_ = \(ObjRef HsQMLObjectHandle
hndl) ->
            HsQMLObjectHandle -> IO HsQMLObjectHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HsQMLObjectHandle
hndl}

fromObjRefIO :: ObjRef tt -> IO tt
fromObjRefIO :: forall tt. ObjRef tt -> IO tt
fromObjRefIO (ObjRef HsQMLObjectHandle
hndl) = HsQMLObjectHandle -> IO tt
forall a. HsQMLObjectHandle -> IO a
hsqmlObjectGetHsValue HsQMLObjectHandle
hndl

-- | Represents an instance of a QML class which wraps an arbitrary Haskell
-- type. Unlike 'ObjRef', an 'AnyObjRef' only carries the type of its Haskell
-- value dynamically and does not encode it into the static type.
newtype AnyObjRef = AnyObjRef HsQMLObjectHandle

instance Marshal AnyObjRef where
    type MarshalMode AnyObjRef c d = ModeObjBidi No c
    marshaller :: MarshallerFor AnyObjRef
marshaller = Marshaller {
        mTypeCVal_ :: Tagged AnyObjRef TypeId
mTypeCVal_ = TypeId -> Tagged AnyObjRef TypeId
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyJSValue,
        mFromCVal_ :: MFromCValFunc AnyObjRef
mFromCVal_ = MFromCValFunc AnyObjRef
forall t. Marshal t => MFromCValFunc t
jvalFromCVal,
        mToCVal_ :: MToCValFunc AnyObjRef
mToCVal_ = MToCValFunc AnyObjRef
forall t. Marshal t => MToCValFunc t
jvalToCVal,
        mWithCVal_ :: MWithCValFunc AnyObjRef
mWithCVal_ = AnyObjRef -> (Ptr () -> IO b) -> IO b
forall t. Marshal t => MWithCValFunc t
MWithCValFunc AnyObjRef
jvalWithCVal,
        mFromJVal_ :: MFromJValFunc AnyObjRef
mFromJVal_ = \Strength
_ HsQMLJValHandle
ptr -> IO (Maybe AnyObjRef) -> MaybeT IO AnyObjRef
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe AnyObjRef) -> MaybeT IO AnyObjRef)
-> IO (Maybe AnyObjRef) -> MaybeT IO AnyObjRef
forall a b. (a -> b) -> a -> b
$ do
            HsQMLObjectHandle
hndl <- HsQMLJValHandle -> IO HsQMLObjectHandle
hsqmlGetObjectFromJval HsQMLJValHandle
ptr
            Maybe AnyObjRef -> IO (Maybe AnyObjRef)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AnyObjRef -> IO (Maybe AnyObjRef))
-> Maybe AnyObjRef -> IO (Maybe AnyObjRef)
forall a b. (a -> b) -> a -> b
$ if HsQMLObjectHandle -> Bool
isNullObjectHandle HsQMLObjectHandle
hndl
                then Maybe AnyObjRef
forall a. Maybe a
Nothing else AnyObjRef -> Maybe AnyObjRef
forall a. a -> Maybe a
Just (AnyObjRef -> Maybe AnyObjRef) -> AnyObjRef -> Maybe AnyObjRef
forall a b. (a -> b) -> a -> b
$ HsQMLObjectHandle -> AnyObjRef
AnyObjRef HsQMLObjectHandle
hndl,
        mWithJVal_ :: MWithJValFunc AnyObjRef
mWithJVal_ = \(AnyObjRef hndl :: HsQMLObjectHandle
hndl@(HsQMLObjectHandle ForeignPtr HsQMLObjectHandle
ptr)) HsQMLJValHandle -> IO b
f -> do
            HsQMLJValHandle
jval <- HsQMLObjectHandle -> IO HsQMLJValHandle
hsqmlObjectGetJval HsQMLObjectHandle
hndl
            b
ret <- HsQMLJValHandle -> IO b
f HsQMLJValHandle
jval
            ForeignPtr HsQMLObjectHandle -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr HsQMLObjectHandle
ptr
            b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
ret,
        mFromHndl_ :: MFromHndlFunc AnyObjRef
mFromHndl_ =
            AnyObjRef -> IO AnyObjRef
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyObjRef -> IO AnyObjRef)
-> (HsQMLObjectHandle -> AnyObjRef) -> MFromHndlFunc AnyObjRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsQMLObjectHandle -> AnyObjRef
AnyObjRef,
        mToHndl_ :: MToHndlFunc AnyObjRef
mToHndl_ = \(AnyObjRef HsQMLObjectHandle
hndl) ->
            HsQMLObjectHandle -> IO HsQMLObjectHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HsQMLObjectHandle
hndl}

fromAnyObjRefIO :: forall tt. (Typeable tt) =>
    AnyObjRef -> IO (Maybe (ObjRef tt))
fromAnyObjRefIO :: forall tt. Typeable tt => AnyObjRef -> IO (Maybe (ObjRef tt))
fromAnyObjRefIO (AnyObjRef HsQMLObjectHandle
hndl) = do
    ClassInfo
info <- HsQMLObjectHandle -> IO ClassInfo
hsqmlObjectGetHsTyperep HsQMLObjectHandle
hndl
    let srcRep :: TypeRep
srcRep = tt -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (tt
forall a. HasCallStack => a
undefined :: tt)
        dstRep :: TypeRep
dstRep = ClassInfo -> TypeRep
cinfoObjType ClassInfo
info
    Maybe (ObjRef tt) -> IO (Maybe (ObjRef tt))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ObjRef tt) -> IO (Maybe (ObjRef tt)))
-> Maybe (ObjRef tt) -> IO (Maybe (ObjRef tt))
forall a b. (a -> b) -> a -> b
$ if TypeRep
srcRep TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
dstRep
        then ObjRef tt -> Maybe (ObjRef tt)
forall a. a -> Maybe a
Just (ObjRef tt -> Maybe (ObjRef tt)) -> ObjRef tt -> Maybe (ObjRef tt)
forall a b. (a -> b) -> a -> b
$ HsQMLObjectHandle -> ObjRef tt
forall tt. HsQMLObjectHandle -> ObjRef tt
ObjRef HsQMLObjectHandle
hndl
        else Maybe (ObjRef tt)
forall a. Maybe a
Nothing