From 028968bcbbad7c5fbfb0262edd580b612ade224a Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Fri, 10 Sep 2021 00:41:48 +0200
Subject: [PATCH] Order generated code (public api before internal api)
---
src/Quasar/Wayland/Protocol/TH.hs | 24 +++++++++++++++---------
1 file changed, 15 insertions(+), 9 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index 50dc54b..4b73143 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -53,7 +53,8 @@ generateWaylandProcol protocolFile = do
addDependentFile protocolFile
xml <- liftIO (BS.readFile protocolFile)
protocol <- parseProtocol xml
- concat <$> mapM interfaceDec protocol.interfaces
+ (public, internals) <- unzip <$> mapM interfaceDecs protocol.interfaces
+ pure $ mconcat public <> mconcat internals
tellQ :: Q a -> WriterT [a] Q ()
@@ -66,16 +67,21 @@ tellQ action = tell =<< lift (singleton <$> action)
tellQs :: Q [a] -> WriterT [a] Q ()
tellQs = tell <=< lift
-interfaceDec :: InterfaceSpec -> Q [Dec]
-interfaceDec interface = execWriterT do
- tellQ $ dataD (pure []) iName [] Nothing [normalC iName []] [derivingInterfaceClient, derivingInterfaceServer]
- tellQ $ instanceD (pure []) [t|IsInterface $iT|] instanceDecs
+interfaceDecs :: InterfaceSpec -> Q ([Dec], [Dec])
+interfaceDecs interface = do
+ public <- execWriterT do
+ pure ()
+ internals <- execWriterT do
+ tellQ $ dataD (pure []) iName [] Nothing [normalC iName []] [derivingInterfaceClient, derivingInterfaceServer]
+ tellQ $ instanceD (pure []) [t|IsInterface $iT|] instanceDecs
- when (length interface.requests > 0) do
- tellQs $ messageTypeDecs rTypeName (requestContext <$> interface.requests)
+ when (length interface.requests > 0) do
+ tellQs $ messageTypeDecs rTypeName (requestContext <$> interface.requests)
- when (length interface.events > 0) do
- tellQs $ messageTypeDecs eTypeName (eventContext <$> interface.events)
+ when (length interface.events > 0) do
+ tellQs $ messageTypeDecs eTypeName (eventContext <$> interface.events)
+
+ pure (public, internals)
where
iName = interfaceN interface
--
GitLab