1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module : Wayland.Server.Client
-- Description: Low-level API for wrapping Wayland client handles.
module Wayland.Server.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
-- | 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 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 = do
clientPtr <- castPtrToStablePtr <$> wlClientGetUserData c
deRefStablePtr clientPtr
|
