summaryrefslogtreecommitdiff
path: root/wayland/Wayland/Server/Client.hs
diff options
context:
space:
mode:
Diffstat (limited to 'wayland/Wayland/Server/Client.hs')
-rw-r--r--wayland/Wayland/Server/Client.hs92
1 files changed, 86 insertions, 6 deletions
diff --git a/wayland/Wayland/Server/Client.hs b/wayland/Wayland/Server/Client.hs
index 99d11d6..e7325c9 100644
--- a/wayland/Wayland/Server/Client.hs
+++ b/wayland/Wayland/Server/Client.hs
@@ -1,18 +1,98 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- |
+-- Module : Wayland.Server.Client
+-- Description: Low-level API for wrapping Wayland client handles.
+
module Wayland.Server.Client
- ( Client
+ ( -- * Handles
+ Client
+ , ClientMessage(..)
+ , createClient
, unwrapClient
, wrapClient
+ , -- * Data
+ ClientData
+ , ClientDataReader
+ , newClientData
+ , destroyClientData
) where
+import Data.Hashable (Hashable)
+import Control.Monad.Trans (MonadIO(..))
+import Control.Monad.Reader (ReaderT, asks)
+import Foreign (newStablePtr, castStablePtrToPtr, FunPtr, freeHaskellFunPtr, Ptr, castPtrToStablePtr, deRefStablePtr, freeStablePtr)
+import Wayland.Server.Types (Handle, createHandle, Message(..), invalidateHandle, MessageClass, resolveHandle)
import Wayland.Server.System
-data Client = Client WLClient
+-- | A handle to a Wayland client.
+--
+-- The handle remains valid and can be used for equality checks even after the underlying libwayland client was
+-- destroyed. However, actions accessing the client will fail.
+newtype Client = Client (Handle WLClient)
+ deriving (Show, Eq, Ord, Hashable)
+
+-- | Messages informing the server that a client has been created/connected to the server or destroyed.
+data ClientMessage
+ = ClientCreated Client
+ | ClientDestroyed Client
deriving (Show, Eq)
+-- | Client-related data.
+newtype ClientData = ClientData { dataDestroyFunc :: FunPtr WLUserDataDestroyFunc }
+
+-- | A reader monad providing an instance of 'ClientData'.
+type ClientDataReader = ReaderT ClientData IO
+
+instance MessageClass ClientMessage
+
+-- | Initialize client-related data.
+newClientData
+ :: (Message -> IO ()) -- ^ Message handler used to dispatch messages when clients were destroyed.
+ -> IO ClientData -- ^ Action creating the data.
+newClientData handler = do
+ destroyFunc <- wrapWLUserDataDestroyFunc (destroyClient handler)
+ pure $ ClientData { dataDestroyFunc = destroyFunc }
+
+-- | Destroy client-related data, freeing all acquired resources.
+--
+-- This should only be done after no wl_client instances are alive as it will free memory used by them.
+destroyClientData :: ClientData -> IO ()
+destroyClientData c = do
+ freeHaskellFunPtr (dataDestroyFunc c)
+
+-- | Create a wrapper for a native wl_client instance.
+--
+-- This will associate user data with the client and register a destroy function which dispatches a message.
+createClient :: WLClient -> ClientDataReader Client
+createClient c = do
+ destroyFunc <- asks dataDestroyFunc
+ liftIO $ do
+ handle <- createHandle c
+ let client = Client handle
+ clientPtr <- newStablePtr client
+ wlClientSetUserData c (castStablePtrToPtr clientPtr) destroyFunc
+ pure client
+
+-- | Callback used when a client was destroyed, disassociating any data and dispatching a message to the message loop.
+destroyClient :: (Message -> IO ()) -> Ptr () -> IO ()
+destroyClient handler c = do
+ let clientPtr = castPtrToStablePtr c
+ client@(Client handle) <- deRefStablePtr clientPtr
+ invalidateHandle handle
+ freeStablePtr clientPtr
+ handler $ Message $ ClientDestroyed client
+
+-- | Get the underlying Wayland client wrapped by a 'Client'.
+--
+-- This function may raise an error if the underlying client is no longer alive.
unwrapClient :: Client -> IO WLClient
-unwrapClient (Client c) = pure c
+unwrapClient (Client handle) = resolveHandle handle
+-- | Get the existing wrapper for a Wayland client.
+--
+-- The client wrapper is stored as a StablePtr in the client's userdata.
wrapClient :: WLClient -> IO Client
-wrapClient c = pure $ Client c
-
--- TODO: Lifecycle
+wrapClient c = do
+ clientPtr <- castPtrToStablePtr <$> wlClientGetUserData c
+ deRefStablePtr clientPtr