Add reexports to TH module so no additional imports are required

queezle42 · Jun 6, 2024 · 7eb19ea · 7eb19ea
1 parent ac586de
commit 7eb19ea
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 5 deletions.
diff --git a/quasar-wayland/src/Quasar/Wayland/Protocol/Core.hs b/quasar-wayland/src/Quasar/Wayland/Protocol/Core.hs
@@ -20,6 +20,7 @@ module Quasar.Wayland.Protocol.Core (
   interfaceVersion,
   IsInterfaceSide(..),
   Object(objectProtocol, version),
+  objectVersion,
   setEventHandler,
   setRequestHandler,
   setMessageHandler,
@@ -362,6 +363,9 @@ instance HasField "isDestroyed" (Object s i) (STMc NoRetry '[] Bool) where
 instance HasField "isDestroyed" (SomeObject s) (STMc NoRetry '[] Bool) where
   getField (SomeObject obj) = isObjectDestroyed obj
 
+objectVersion :: Object s i -> Version
+objectVersion = (.version)
+
 
 getMessageHandler :: (IsInterfaceSide s i, MonadSTMc NoRetry '[SomeException] m) => Object s i -> m (MessageHandler s i)
 getMessageHandler object = liftSTMc @NoRetry @'[SomeException] do

diff --git a/quasar-wayland/src/Quasar/Wayland/Protocol/Generated.hs b/quasar-wayland/src/Quasar/Wayland/Protocol/Generated.hs
@@ -6,15 +6,16 @@
 
 module Quasar.Wayland.Protocol.Generated where
 
--- Imports are here to improve readability when dumping splices
+import Quasar.Wayland.Protocol.TH (generateWaylandProtocols)
+
+-- Additional imports are here to improve readability when dumping splices
 import Control.Monad.Catch
 import Control.Monad.STM
 import Data.Binary
 import Data.Void
 import GHC.Records
 import Quasar.Prelude
-import Quasar.Wayland.Protocol.Core
-import Quasar.Wayland.Protocol.TH
+import Quasar.Wayland.Protocol
 
 $(generateWaylandProtocols [
   "protocols/wayland.xml",

diff --git a/quasar-wayland/src/Quasar/Wayland/Protocol/TH.hs b/quasar-wayland/src/Quasar/Wayland/Protocol/TH.hs
@@ -278,7 +278,7 @@ interfaceDecs interface = do
         fromWireArgument :: ArgumentType -> Q Exp -> Q Exp
         fromWireArgument (ObjectArgument _) objIdE = [|getObject $objIdE|]
         fromWireArgument (NullableObjectArgument _) objIdE = [|getNullableObject $objIdE|]
-        fromWireArgument (NewIdArgument _) objIdE = [|newObjectFromId Nothing $objectE.version $objIdE|]
+        fromWireArgument (NewIdArgument _) objIdE = [|newObjectFromId Nothing (objectVersion $objectE) $objIdE|]
         fromWireArgument _ x = [|pure $x|]
 
 messageProxyInstanceDecs :: Side -> [MessageContext] -> Q [Dec]
@@ -314,7 +314,7 @@ messageProxyInstanceDecs side messageContexts = mapM messageProxyInstanceD messa
 
         -- Constructor: the first argument becomes the return value
         ctorE :: Q Exp
-        ctorE = [|newObject Nothing $objectE.version >>= \(newObj, newId) -> newObj <$ (sendMessage object =<< $(msgE [|pure newId|]))|]
+        ctorE = [|newObject Nothing (objectVersion $objectE) >>= \(newObj, newId) -> newObj <$ (sendMessage object =<< $(msgE [|pure newId|]))|]
           where
             msgE :: Q Exp -> Q Exp
             msgE idArgE = mkWireMsgE (idArgE : (wireArgE <$> args))