diff --git a/src/Quasar/Wayland/Server/Surface.hs b/src/Quasar/Wayland/Server/Surface.hs index ee457198582b053c13cc7adcd7a6197097f1dbc4..84719f337c0017bf199aea3f5d53e3e0abf5de72 100644 --- a/src/Quasar/Wayland/Server/Surface.hs +++ b/src/Quasar/Wayland/Server/Surface.hs @@ -1,8 +1,10 @@ module Quasar.Wayland.Server.Surface ( initializeServerSurface, initializeWlBuffer, + getBuffer, ) where +import Control.Monad.Catch import Quasar.Prelude import Quasar.Wayland.Protocol import Quasar.Wayland.Protocol.Generated @@ -104,3 +106,10 @@ initializeWlBuffer wlBuffer buffer = do -- TODO propagate buffer destruction destroy = destroyBuffer buffer } + +getBuffer :: forall b. BufferBackend b => Object 'Server Interface_wl_buffer -> STM (Buffer b) +getBuffer wlBuffer = do + ifd <- getInterfaceData @(Buffer b) wlBuffer + case ifd of + Just buffer -> pure buffer + Nothing -> throwM $ InternalError ("Missing interface data on " <> show wlBuffer) diff --git a/src/Quasar/Wayland/Surface.hs b/src/Quasar/Wayland/Surface.hs index d2839d151227d0be372a287357c5674649306e53..9bea2f8a793103c159bce4cff6651071800280ac 100644 --- a/src/Quasar/Wayland/Surface.hs +++ b/src/Quasar/Wayland/Surface.hs @@ -5,7 +5,6 @@ module Quasar.Wayland.Surface ( newBuffer, lockBuffer, destroyBuffer, - getBuffer, -- * Surface Damage(..), @@ -76,14 +75,6 @@ tryFinalizeBuffer buffer = do releaseBufferStorage @b buffer.content -getBuffer :: forall b. BufferBackend b => Object 'Server Interface_wl_buffer -> STM (Buffer b) -getBuffer wlBuffer = do - ifd <- getInterfaceData @(Buffer b) wlBuffer - case ifd of - Just buffer -> pure buffer - Nothing -> throwM $ InternalError ("Missing interface data on " <> show wlBuffer) - - class SurfaceRole a where surfaceRoleName :: a -> String