Skip to content
Snippets Groups Projects
Commit 028968bc authored by Jens Nolte's avatar Jens Nolte
Browse files

Order generated code (public api before internal api)

parent ac5ed142
No related branches found
No related tags found
No related merge requests found
...@@ -53,7 +53,8 @@ generateWaylandProcol protocolFile = do ...@@ -53,7 +53,8 @@ generateWaylandProcol protocolFile = do
addDependentFile protocolFile addDependentFile protocolFile
xml <- liftIO (BS.readFile protocolFile) xml <- liftIO (BS.readFile protocolFile)
protocol <- parseProtocol xml 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 () tellQ :: Q a -> WriterT [a] Q ()
...@@ -66,16 +67,21 @@ tellQ action = tell =<< lift (singleton <$> action) ...@@ -66,16 +67,21 @@ tellQ action = tell =<< lift (singleton <$> action)
tellQs :: Q [a] -> WriterT [a] Q () tellQs :: Q [a] -> WriterT [a] Q ()
tellQs = tell <=< lift tellQs = tell <=< lift
interfaceDec :: InterfaceSpec -> Q [Dec] interfaceDecs :: InterfaceSpec -> Q ([Dec], [Dec])
interfaceDec interface = execWriterT do interfaceDecs interface = do
tellQ $ dataD (pure []) iName [] Nothing [normalC iName []] [derivingInterfaceClient, derivingInterfaceServer] public <- execWriterT do
tellQ $ instanceD (pure []) [t|IsInterface $iT|] instanceDecs 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 when (length interface.requests > 0) do
tellQs $ messageTypeDecs rTypeName (requestContext <$> interface.requests) tellQs $ messageTypeDecs rTypeName (requestContext <$> interface.requests)
when (length interface.events > 0) do when (length interface.events > 0) do
tellQs $ messageTypeDecs eTypeName (eventContext <$> interface.events) tellQs $ messageTypeDecs eTypeName (eventContext <$> interface.events)
pure (public, internals)
where where
iName = interfaceN interface iName = interfaceN interface
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment