From 846d7969bae4b1e8bdc3a5da7905124e72d90727 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 21 Sep 2021 18:21:07 +0200
Subject: [PATCH] Prefix interface types with 'Interface_'
---
src/Quasar/Wayland/Display.hs | 4 ++--
src/Quasar/Wayland/Protocol/Display.hs | 4 ++--
src/Quasar/Wayland/Protocol/TH.hs | 2 +-
src/Quasar/Wayland/Registry.hs | 10 +++++-----
4 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/src/Quasar/Wayland/Display.hs b/src/Quasar/Wayland/Display.hs
index 4d8a087..4ccf4c3 100644
--- a/src/Quasar/Wayland/Display.hs
+++ b/src/Quasar/Wayland/Display.hs
@@ -11,12 +11,12 @@ import Quasar.Wayland.Protocol.Generated
import Quasar.Wayland.Registry
data ClientDisplay = ClientDisplay {
- wlDisplay :: Object 'Client I_wl_display,
+ wlDisplay :: Object 'Client Interface_wl_display,
registry :: ClientRegistry
}
newClientDisplay
- :: (IsInterfaceSide 'Client I_wl_display)
+ :: (IsInterfaceSide 'Client Interface_wl_display)
=> STM (ClientDisplay, ProtocolHandle 'Client)
newClientDisplay =
initializeProtocol clientWlDisplayCallback \wlDisplay -> do
diff --git a/src/Quasar/Wayland/Protocol/Display.hs b/src/Quasar/Wayland/Protocol/Display.hs
index 3d17d5f..46e99fb 100644
--- a/src/Quasar/Wayland/Protocol/Display.hs
+++ b/src/Quasar/Wayland/Protocol/Display.hs
@@ -12,11 +12,11 @@ import Quasar.Wayland.Protocol.Generated
--
-- This is only required when manually managing the @wl_display@ interface (usually it's applied by
-- 'Quasar.Wayland.Display.newClientDisplay').
-clientWlDisplayCallback :: IsInterfaceSide 'Client I_wl_display => Callback 'Client I_wl_display
+clientWlDisplayCallback :: IsInterfaceSide 'Client Interface_wl_display => Callback 'Client Interface_wl_display
clientWlDisplayCallback = internalFnCallback handler
where
-- | wl_display is specified to never change, so manually specifying the callback is safe
- handler :: Object 'Client I_wl_display -> WireEvent_wl_display -> ProtocolM 'Client ()
+ handler :: Object 'Client Interface_wl_display -> WireEvent_wl_display -> ProtocolM 'Client ()
-- TODO parse oId
handler _ (WireEvent_wl_display_error oId code message) = throwM $ ServerError code (toString message)
handler _ (WireEvent_wl_display_delete_id deletedId) = pure () -- TODO confirm delete
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index 613e77f..f24a007 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -170,7 +170,7 @@ interfaceSideInstanceDs interface = execWriterT do
interfaceN :: InterfaceSpec -> Name
-interfaceN interface = mkName $ "I_" <> interface.name
+interfaceN interface = mkName $ "Interface_" <> interface.name
interfaceT :: InterfaceSpec -> Q Type
interfaceT interface = conT (interfaceN interface)
diff --git a/src/Quasar/Wayland/Registry.hs b/src/Quasar/Wayland/Registry.hs
index 0f50133..e7e545d 100644
--- a/src/Quasar/Wayland/Registry.hs
+++ b/src/Quasar/Wayland/Registry.hs
@@ -14,15 +14,15 @@ import Quasar.Wayland.Protocol
import Quasar.Wayland.Protocol.Generated
data ClientRegistry = ClientRegistry {
- wlRegistry :: Object 'Client I_wl_registry,
+ wlRegistry :: Object 'Client Interface_wl_registry,
globalsVar :: TVar (HM.HashMap Word32 (WlString, Word32))
}
-createClientRegistry :: Object 'Client I_wl_display -> ProtocolM 'Client ClientRegistry
+createClientRegistry :: Object 'Client Interface_wl_display -> ProtocolM 'Client ClientRegistry
createClientRegistry wlDisplay = mfix \clientRegistry -> do
globalsVar <- lift $ newTVar HM.empty
- (wlRegistry, newId) <- newObject @'Client @I_wl_registry (traceCallback (callback clientRegistry))
+ (wlRegistry, newId) <- newObject @'Client @Interface_wl_registry (traceCallback (callback clientRegistry))
sendMessage wlDisplay $ WireRequest_wl_display_get_registry newId
pure ClientRegistry {
@@ -30,11 +30,11 @@ createClientRegistry wlDisplay = mfix \clientRegistry -> do
globalsVar
}
where
- callback :: ClientRegistry -> IsInterfaceSide 'Client I_wl_registry => Callback 'Client I_wl_registry
+ callback :: ClientRegistry -> IsInterfaceSide 'Client Interface_wl_registry => Callback 'Client Interface_wl_registry
callback clientRegistry = internalFnCallback handler
where
-- | wl_registry is specified to never change, so manually specifying the callback is safe
- handler :: Object 'Client I_wl_registry -> WireEvent_wl_registry -> ProtocolM 'Client ()
+ handler :: Object 'Client Interface_wl_registry -> WireEvent_wl_registry -> ProtocolM 'Client ()
handler _ (WireEvent_wl_registry_global name interface version) = do
lift $ modifyTVar clientRegistry.globalsVar (HM.insert name (interface, version))
handler _ (WireEvent_wl_registry_global_remove name) = do
--
GitLab