From c035d905ce27f80f134c76daf421a439f566f74e Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 15 Sep 2021 23:09:53 +0200
Subject: [PATCH] Add function to create objects from incoming ids
---
src/Quasar/Wayland/Protocol/Core.hs | 26 ++++++++++++++++++--------
1 file changed, 18 insertions(+), 8 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index 3ab1775..4d75ebe 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -403,7 +403,7 @@ setException ex = protocolStep do
State.modify \st -> st{protocolException = Just (toException ex)}
--- Create an object. The caller is responsible for sending the 'NewId' exactly once before using the object.
+-- | Create an object. The caller is responsible for sending the 'NewId' exactly once before using the object.
newObject
:: forall s m i. (IsInterfaceSide s i, MonadCatch m)
=> Callback s m i
@@ -415,14 +415,12 @@ newObjectInternal
=> Callback s m i
-> ProtocolAction s m (Object s m i, NewId (InterfaceName i))
newObjectInternal callback = do
- oId <- allocateObjectId @s @m @i
- let
- object = Object oId callback
- someObject = SomeObject object
- State.modify \st -> st { objects = HM.insert oId someObject st.objects}
- pure (object, NewId oId)
+ genOId <- allocateObjectId @s @m
+ let oId = NewId @(InterfaceName i) genOId
+ object <- newObjectFromId oId callback
+ pure (object, oId)
where
- allocateObjectId :: forall s m i. (IsInterfaceSide s i, MonadCatch m) => ProtocolAction s m GenericObjectId
+ allocateObjectId :: forall s m. (IsSide s, MonadCatch m) => ProtocolAction s m GenericObjectId
allocateObjectId = do
st <- State.get
let
@@ -433,6 +431,18 @@ newObjectInternal callback = do
State.put $ st {nextId = nextId'}
pure id
+newObjectFromId
+ :: forall s m i. (IsInterfaceSide s i, MonadCatch m)
+ => NewId (InterfaceName i)
+ -> Callback s m i
+ -> ProtocolAction s m (Object s m i)
+newObjectFromId (NewId oId) callback = do
+ let
+ object = Object oId callback
+ someObject = SomeObject object
+ State.modify \st -> st { objects = HM.insert oId someObject st.objects}
+ pure object
+
-- | Sends a message without checking any ids or creating proxy objects objects.
sendMessage :: forall s m i. (IsInterfaceSide s i, MonadCatch m) => Object s m i -> Up s i -> ProtocolStep s m ()
--
GitLab