From 8d28ad4c8a7d3179665fdf25cae618831a15242f Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 15 Sep 2021 00:29:55 +0200
Subject: [PATCH] Return opcode from putMessage
---
src/Quasar/Wayland/Protocol/Core.hs | 6 +++---
src/Quasar/Wayland/Protocol/TH.hs | 7 ++++---
2 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index e983781..da5c8f2 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -196,8 +196,8 @@ class (
getDown :: forall s m i. IsInterfaceSide s i => Object s m i -> Opcode -> Get (Down s i)
getDown = getMessage @(Down s i)
-putUp :: forall s i. IsInterfaceSide s i => Up s i -> Put
-putUp = putMessage @(Up s i)
+putUp :: forall s m i. IsInterfaceSide s i => Object s m i -> Up s i -> PutM Opcode
+putUp _ = putMessage @(Up s i)
class IsInterfaceSide s i => IsInterfaceHandler s m i a where
@@ -256,7 +256,7 @@ instance IsObjectSide (SomeObject s m) where
class (Eq a, Show a) => IsMessage a where
opcodeName :: Opcode -> Maybe String
getMessage :: IsInterface i => Object s m i -> Opcode -> Get a
- putMessage :: a -> PutM ()
+ putMessage :: a -> PutM Opcode
instance IsMessage Void where
opcodeName _ = Nothing
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index dab855a..8be2a10 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -247,9 +247,10 @@ isMessageInstanceD t msgs = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD,
putMessageClauseD msg = clause [msgConP msg] (normalB (putMessageE msg.msgSpec.arguments)) []
where
putMessageE :: [ArgumentSpec] -> Q Exp
- putMessageE [] = [|pure ()|]
- putMessageE args = doE ((\arg -> noBindS [|putArgument @($(argumentSpecType arg)) $(msgArgE msg arg)|]) <$> args)
-
+ putMessageE [] = opcodeE
+ putMessageE args = doE (((\arg -> noBindS [|putArgument @($(argumentSpecType arg)) $(msgArgE msg arg)|]) <$> args) <> [noBindS opcodeE])
+ opcodeE :: Q Exp
+ opcodeE = [|pure $(litE $ integerL $ fromIntegral msg.msgSpec.opcode)|]
derivingEq :: Q DerivClause
--
GitLab