From 26c34d41058632141118af2d7118b5bded090b5c Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 17 Aug 2022 18:51:32 +0200
Subject: [PATCH] Move getBuffer to server module
---
src/Quasar/Wayland/Server/Surface.hs | 9 +++++++++
src/Quasar/Wayland/Surface.hs | 9 ---------
2 files changed, 9 insertions(+), 9 deletions(-)
diff --git a/src/Quasar/Wayland/Server/Surface.hs b/src/Quasar/Wayland/Server/Surface.hs
index ee45719..84719f3 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 d2839d1..9bea2f8 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
--
GitLab