finish implementing wayland server api

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