From 2b09dd0f23795816564b17e911dbb539abb90bd3 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 15 Dec 2021 12:20:13 +0100
Subject: [PATCH] Improve invalid object id error message
---
src/Quasar/Wayland/Protocol/Core.hs | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index b6bb0a0..cf279d5 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -569,10 +569,11 @@ fromSomeObject
:: forall s i m. IsInterfaceSide s i
=> SomeObject s -> Either String (Object s i)
fromSomeObject (UnknownObject interface _) =
- Left $ mconcat ["Object is of unknown interface ", interface]
+ Left $ mconcat ["Expected object with type ", interfaceName @i, ", but object has unknown type ", interface]
fromSomeObject (SomeObject someObject) =
case cast someObject of
- Nothing -> Left $ mconcat ["Expected object for interface ", interfaceName @i, ", but object is ", objectInterfaceName someObject]
+ Nothing -> Left $
+ mconcat ["Expected object with type ", interfaceName @i, ", but object has type ", objectInterfaceName someObject]
Just object -> pure object
@@ -589,11 +590,13 @@ lookupObject oId = do
Left err -> Left err
Right object -> pure object
+-- | Lookup an object for an id or throw a `ProtocolException`. To be used from generated code when receiving an object
+-- id.
getObject
:: forall s i. IsInterfaceSide s i
=> ObjectId (InterfaceName i)
-> ProtocolM s (Object s i)
-getObject oId = either (throwM . InvalidObject) pure =<< lookupObject oId
+getObject oId = either (throwM . ProtocolException . ("Received invalid object id: " <>)) pure =<< lookupObject oId
--
GitLab