diff --git a/src/Quasar/Wayland/Display.hs b/src/Quasar/Wayland/Display.hs index 4d8a0872c519a1e575bede7cfa3f0088821e6bb9..4ccf4c30169b0a4cbb9bbc4edf1df69e019d9373 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 3d17d5ffcc51cc9b5d149c7fa43f2d6a8849b2cc..46e99fbfa710796fbbfcb1403a4ac226edd3d7a4 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 613e77f242d89a6ab71792ce8a6620a22e2600f1..f24a0073b63e996c2a9b3a8c08a86376daf2bcf4 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 0f5013365204f58c0828ae19108e3a3d05320db1..e7e545d061012277abe841272bd919d8759b6142 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