-- | Facilities for working with weak references, finalisers, and factory
-- pools.
module Graphics.QML.Objects.Weak (
    -- * Weak Object References
    WeakObjRef,
    toWeakObjRef,
    fromWeakObjRef,

    -- * Object Finalisers
    ObjFinaliser,
    newObjFinaliser,
    addObjFinaliser,

    -- * Factory Pools
    FactoryPool,
    newFactoryPool,
    getPoolObject
) where

import Graphics.QML.Internal.BindObj
import Graphics.QML.Internal.Objects

import Control.Concurrent.MVar
import qualified Data.Map as Map
import Data.Map (Map)

-- | Represents a weak reference to a QML object which wraps the type @tt@.
--
-- Unlike ordinary strong references, a weak reference does not prevent the
-- QML garbage collector from collecting the underlying object. Weak references
-- can be used to monitor the life cycles of QML objects.
newtype WeakObjRef tt = WeakObjRef HsQMLObjectHandle

-- | Converts a strong 'ObjRef' into a 'WeakObjRef'. 
toWeakObjRef :: ObjRef tt -> IO (WeakObjRef tt)
toWeakObjRef :: forall tt. ObjRef tt -> IO (WeakObjRef tt)
toWeakObjRef (ObjRef HsQMLObjectHandle
hndl) = do
    HsQMLObjectHandle
hndl' <- HsQMLObjectHandle -> Bool -> IO HsQMLObjectHandle
copyObjectHandle HsQMLObjectHandle
hndl Bool
True
    WeakObjRef tt -> IO (WeakObjRef tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakObjRef tt -> IO (WeakObjRef tt))
-> WeakObjRef tt -> IO (WeakObjRef tt)
forall a b. (a -> b) -> a -> b
$ HsQMLObjectHandle -> WeakObjRef tt
forall tt. HsQMLObjectHandle -> WeakObjRef tt
WeakObjRef HsQMLObjectHandle
hndl'

-- | Converts a 'WeakObjRef' into a strong 'ObjRef'.
--
-- If the underlying QML object has already been collected then the resulting
-- 'ObjRef' can be used to reincarnate it.
fromWeakObjRef :: WeakObjRef tt -> IO (ObjRef tt)
fromWeakObjRef :: forall tt. WeakObjRef tt -> IO (ObjRef tt)
fromWeakObjRef (WeakObjRef HsQMLObjectHandle
hndl) = do
    HsQMLObjectHandle
hndl' <- HsQMLObjectHandle -> Bool -> IO HsQMLObjectHandle
copyObjectHandle HsQMLObjectHandle
hndl Bool
False
    ObjRef tt -> IO (ObjRef tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjRef tt -> IO (ObjRef tt)) -> ObjRef tt -> IO (ObjRef tt)
forall a b. (a -> b) -> a -> b
$ HsQMLObjectHandle -> ObjRef tt
forall tt. HsQMLObjectHandle -> ObjRef tt
ObjRef HsQMLObjectHandle
hndl'

-- | Represents an object finaliser function for QML objects which wrap the
-- type @tt@.
data ObjFinaliser tt = ObjFinaliser HsQMLObjFinaliserHandle

-- | Create a new object finaliser from a finaliser function.
--
-- Note that at the time the finaliser is called the runtime will have already
-- comitted to collecting the underlying QML object. The 'ObjRef' passed into
-- the finaliser can be used to reincarnate the object, but this QML object
-- will have a distinct identity to the original.
newObjFinaliser :: (ObjRef tt -> IO ()) -> IO (ObjFinaliser tt)
newObjFinaliser :: forall tt. (ObjRef tt -> IO ()) -> IO (ObjFinaliser tt)
newObjFinaliser ObjRef tt -> IO ()
f = do
    FunPtr ObjFinaliserFunc
fPtr <- ObjFinaliserFunc -> IO (FunPtr ObjFinaliserFunc)
marshalObjFinaliser (ObjFinaliserFunc -> IO (FunPtr ObjFinaliserFunc))
-> ObjFinaliserFunc -> IO (FunPtr ObjFinaliserFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr HsQMLObjectHandle
hPtr -> do
        HsQMLObjectHandle
hndl <- Ptr HsQMLObjectHandle -> IO HsQMLObjectHandle
newObjectHandle Ptr HsQMLObjectHandle
hPtr
        ObjRef tt -> IO ()
f (ObjRef tt -> IO ()) -> ObjRef tt -> IO ()
forall a b. (a -> b) -> a -> b
$ HsQMLObjectHandle -> ObjRef tt
forall tt. HsQMLObjectHandle -> ObjRef tt
ObjRef HsQMLObjectHandle
hndl
    HsQMLObjFinaliserHandle
final <- FunPtr ObjFinaliserFunc -> IO HsQMLObjFinaliserHandle
hsqmlCreateObjFinaliser FunPtr ObjFinaliserFunc
fPtr
    ObjFinaliser tt -> IO (ObjFinaliser tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjFinaliser tt -> IO (ObjFinaliser tt))
-> ObjFinaliser tt -> IO (ObjFinaliser tt)
forall a b. (a -> b) -> a -> b
$ HsQMLObjFinaliserHandle -> ObjFinaliser tt
forall tt. HsQMLObjFinaliserHandle -> ObjFinaliser tt
ObjFinaliser HsQMLObjFinaliserHandle
final

-- | Adds an object finaliser to an QML object.
--
-- The finaliser will be called no more than once for each time it was added to
-- an object. The timing of finaliser execution is subject to the combined
-- behaviour of the Haskell and QML garbage collectors. All outstanding
-- finalisers will be run when the QML engine is terminated provided that the
-- program does not prematurely exit.
addObjFinaliser :: ObjFinaliser tt -> ObjRef tt -> IO ()
addObjFinaliser :: forall tt. ObjFinaliser tt -> ObjRef tt -> IO ()
addObjFinaliser (ObjFinaliser HsQMLObjFinaliserHandle
final) (ObjRef HsQMLObjectHandle
hndl) =
    HsQMLObjectHandle -> HsQMLObjFinaliserHandle -> IO ()
hsqmlObjectAddFinaliser HsQMLObjectHandle
hndl HsQMLObjFinaliserHandle
final

-- | Represents an object factory which maintains a one-to-one mapping between
-- values of type @tt@ and QML object instances.
--
-- 'ObjRef's manufactured by the pool are cached using the wrapped type @tt@ as
-- the lookup key in an ordered map. The pool uses weak references to
-- automatically purge objects which no longer have any strong references
-- leading to them from either Haskell or QML code.

-- Hence, the pool guarantees that if QML code is using a pool object (e.g. as
-- a source for data binding) then the same object instance can be obtained
-- again from the pool. Conversely, if an object instance is no longer being
-- used then pool will not prevent it from being garbage collected.
data FactoryPool tt = FactoryPool {
    forall tt. FactoryPool tt -> tt -> IO (ObjRef tt)
factory_   :: tt -> IO (ObjRef tt),
    forall tt. FactoryPool tt -> MVar (Map tt (WeakObjRef tt))
pool_      :: MVar (Map tt (WeakObjRef tt)),
    forall tt. FactoryPool tt -> ObjFinaliser tt
finaliser_ :: ObjFinaliser tt
}

-- | Creates a new 'FactoryPool' using the supplied factory function.
newFactoryPool :: (Ord tt) =>
    (tt -> IO (ObjRef tt)) -> IO (FactoryPool tt)
newFactoryPool :: forall tt. Ord tt => (tt -> IO (ObjRef tt)) -> IO (FactoryPool tt)
newFactoryPool tt -> IO (ObjRef tt)
factory = do
    MVar (Map tt (WeakObjRef tt))
pool <- Map tt (WeakObjRef tt) -> IO (MVar (Map tt (WeakObjRef tt)))
forall a. a -> IO (MVar a)
newMVar Map tt (WeakObjRef tt)
forall k a. Map k a
Map.empty
    ObjFinaliser tt
finaliser <- (ObjRef tt -> IO ()) -> IO (ObjFinaliser tt)
forall tt. (ObjRef tt -> IO ()) -> IO (ObjFinaliser tt)
newObjFinaliser ((ObjRef tt -> IO ()) -> IO (ObjFinaliser tt))
-> (ObjRef tt -> IO ()) -> IO (ObjFinaliser tt)
forall a b. (a -> b) -> a -> b
$ \ObjRef tt
obj -> do
        tt
value <- ObjRef tt -> IO tt
forall tt. ObjRef tt -> IO tt
fromObjRefIO ObjRef tt
obj
        MVar (Map tt (WeakObjRef tt))
-> (Map tt (WeakObjRef tt) -> IO (Map tt (WeakObjRef tt))) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map tt (WeakObjRef tt))
pool (Map tt (WeakObjRef tt) -> IO (Map tt (WeakObjRef tt))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map tt (WeakObjRef tt) -> IO (Map tt (WeakObjRef tt)))
-> (Map tt (WeakObjRef tt) -> Map tt (WeakObjRef tt))
-> Map tt (WeakObjRef tt)
-> IO (Map tt (WeakObjRef tt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tt -> Map tt (WeakObjRef tt) -> Map tt (WeakObjRef tt)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete tt
value)
    FactoryPool tt -> IO (FactoryPool tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FactoryPool tt -> IO (FactoryPool tt))
-> FactoryPool tt -> IO (FactoryPool tt)
forall a b. (a -> b) -> a -> b
$ (tt -> IO (ObjRef tt))
-> MVar (Map tt (WeakObjRef tt))
-> ObjFinaliser tt
-> FactoryPool tt
forall tt.
(tt -> IO (ObjRef tt))
-> MVar (Map tt (WeakObjRef tt))
-> ObjFinaliser tt
-> FactoryPool tt
FactoryPool tt -> IO (ObjRef tt)
factory MVar (Map tt (WeakObjRef tt))
pool ObjFinaliser tt
finaliser

-- | Return the pool's canonical QML object for a value of @tt@, either by
-- creating it or looking it up in the pool's cache of objects.
getPoolObject :: (Ord tt) =>
    FactoryPool tt -> tt -> IO (ObjRef tt)
getPoolObject :: forall tt. Ord tt => FactoryPool tt -> tt -> IO (ObjRef tt)
getPoolObject (FactoryPool tt -> IO (ObjRef tt)
factory MVar (Map tt (WeakObjRef tt))
pool ObjFinaliser tt
finaliser) tt
value =
    MVar (Map tt (WeakObjRef tt))
-> (Map tt (WeakObjRef tt)
    -> IO (Map tt (WeakObjRef tt), ObjRef tt))
-> IO (ObjRef tt)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Map tt (WeakObjRef tt))
pool ((Map tt (WeakObjRef tt) -> IO (Map tt (WeakObjRef tt), ObjRef tt))
 -> IO (ObjRef tt))
-> (Map tt (WeakObjRef tt)
    -> IO (Map tt (WeakObjRef tt), ObjRef tt))
-> IO (ObjRef tt)
forall a b. (a -> b) -> a -> b
$ \Map tt (WeakObjRef tt)
pmap ->
        case tt -> Map tt (WeakObjRef tt) -> Maybe (WeakObjRef tt)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup tt
value Map tt (WeakObjRef tt)
pmap of
            Just WeakObjRef tt
wkObj -> do
                ObjRef tt
obj <- WeakObjRef tt -> IO (ObjRef tt)
forall tt. WeakObjRef tt -> IO (ObjRef tt)
fromWeakObjRef WeakObjRef tt
wkObj
                (Map tt (WeakObjRef tt), ObjRef tt)
-> IO (Map tt (WeakObjRef tt), ObjRef tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map tt (WeakObjRef tt)
pmap, ObjRef tt
obj)
            Maybe (WeakObjRef tt)
Nothing  -> do
                ObjRef tt
obj <- tt -> IO (ObjRef tt)
factory tt
value
                ObjFinaliser tt -> ObjRef tt -> IO ()
forall tt. ObjFinaliser tt -> ObjRef tt -> IO ()
addObjFinaliser ObjFinaliser tt
finaliser ObjRef tt
obj
                WeakObjRef tt
wkObj <- ObjRef tt -> IO (WeakObjRef tt)
forall tt. ObjRef tt -> IO (WeakObjRef tt)
toWeakObjRef ObjRef tt
obj
                (Map tt (WeakObjRef tt), ObjRef tt)
-> IO (Map tt (WeakObjRef tt), ObjRef tt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (tt
-> WeakObjRef tt
-> Map tt (WeakObjRef tt)
-> Map tt (WeakObjRef tt)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert tt
value WeakObjRef tt
wkObj Map tt (WeakObjRef tt)
pmap, ObjRef tt
obj)