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