From a5e12ca090a67b6692fd04bb17723a57b12edb4d Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Thu, 9 Sep 2021 19:06:22 +0200
Subject: [PATCH] Move messageInstanceD out of where block
---
src/Quasar/Wayland/Protocol/TH.hs | 35 ++++++++++++++++---------------
1 file changed, 18 insertions(+), 17 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index e89bd81..87f36f7 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -102,23 +102,24 @@ interfaceDec interface = execWriterT do
eConName (EventSpec event) = mkName $ "E_" <> interface.name <> "_" <> event.name
eCon :: EventSpec -> Q Con
eCon event = normalC (eConName event) []
- messageInstanceD :: Q Type -> [(MessageSpec, Name)] -> Q Dec
- messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD, showMessageD, getMessageD, putMessageD]
- where
- opcodeNameD :: Q Dec
- opcodeNameD = funD 'opcodeName (opcodeNameClauseD <$> messages)
- opcodeNameClauseD :: (MessageSpec, Name) -> Q Clause
- opcodeNameClauseD (msg, conName) = clause [litP (integerL (fromIntegral msg.opcode))] (normalB ([|Just $(stringE msg.name)|])) []
- showMessageD :: Q Dec
- showMessageD = funD 'showMessage (showMessageClauseD <$> messages)
- showMessageClauseD :: (MessageSpec, Name) -> Q Clause
- showMessageClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) []
- getMessageD :: Q Dec
- getMessageD = funD 'getMessage (getMessageClauseD <$> messages)
- getMessageClauseD :: (MessageSpec, Name) -> Q Clause
- getMessageClauseD (msg, conName) = clause [[p|_object|], litP (integerL (fromIntegral msg.opcode))] (normalB ([|$(conE conName) <$ dropRemaining|])) []
- putMessageD :: Q Dec
- putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []]
+
+messageInstanceD :: Q Type -> [(MessageSpec, Name)] -> Q Dec
+messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD, showMessageD, getMessageD, putMessageD]
+ where
+ opcodeNameD :: Q Dec
+ opcodeNameD = funD 'opcodeName (opcodeNameClauseD <$> messages)
+ opcodeNameClauseD :: (MessageSpec, Name) -> Q Clause
+ opcodeNameClauseD (msg, conName) = clause [litP (integerL (fromIntegral msg.opcode))] (normalB ([|Just $(stringE msg.name)|])) []
+ showMessageD :: Q Dec
+ showMessageD = funD 'showMessage (showMessageClauseD <$> messages)
+ showMessageClauseD :: (MessageSpec, Name) -> Q Clause
+ showMessageClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) []
+ getMessageD :: Q Dec
+ getMessageD = funD 'getMessage (getMessageClauseD <$> messages)
+ getMessageClauseD :: (MessageSpec, Name) -> Q Clause
+ getMessageClauseD (msg, conName) = clause [[p|_object|], litP (integerL (fromIntegral msg.opcode))] (normalB ([|$(conE conName) <$ dropRemaining|])) []
+ putMessageD :: Q Dec
+ putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []]
interfaceN :: InterfaceSpec -> Name
interfaceN interface = mkName $ "I_" <> interface.name
--
GitLab