diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs index 1b65d458c49826cb34cb27f6557c85725bf5c20e..8668bee36a81e2ada0295b61842d01621b37a061 100644 --- a/src/Quasar/Wayland/Protocol/Core.hs +++ b/src/Quasar/Wayland/Protocol/Core.hs @@ -225,7 +225,6 @@ instance IsSide 'Server where maximumId = 0xffffffff ---- | Empty class, used to combine constraints class ( IsSide s, IsInterface i, @@ -506,9 +505,9 @@ runProtocolTransaction (protocol@ProtocolHandle{stateVar}) action = do -- | Run a 'ProtocolM'-action inside 'STM'. -- --- Exceptions are not handled and reset the transaction (as usual with STM). --- -- Throws an exception, if the protocol is already in a failed state. +-- +-- Exceptions are not handled (i.e. they usually reset the STM transaction and are not stored as a protocol failure). runProtocolM :: ProtocolHandle s -> ProtocolM s a -> STM a runProtocolM protocol action = either throwM (runReaderT action) =<< readTVar protocol.stateVar @@ -635,7 +634,10 @@ getMessageAction -> Get (ProtocolM s ()) getMessageAction object@(Object _ _ _ _ objectHandler) opcode = do verifyMessage <- getWireDown object opcode - pure $ handlerHandleMessage objectHandler object =<< verifyMessage + pure do + message <- verifyMessage + traceM $ "<- " <> showObjectMessage object message + handlerHandleMessage objectHandler object message type RawMessage = (GenericObjectId, Opcode, BSL.ByteString) diff --git a/src/Quasar/Wayland/Registry.hs b/src/Quasar/Wayland/Registry.hs index bb6ea7c468ee60ae1d293da775be70504ed19120..815f80872bead7d8f5cccb6b9b700d324a4cbddc 100644 --- a/src/Quasar/Wayland/Registry.hs +++ b/src/Quasar/Wayland/Registry.hs @@ -22,7 +22,7 @@ createClientRegistry :: Object 'Client Interface_wl_display -> ProtocolM 'Client createClientRegistry wlDisplay = mfix \clientRegistry -> do globalsVar <- lift $ newTVar HM.empty - (wlRegistry, newId) <- newObject @'Client @Interface_wl_registry (traceWireCallback (callback clientRegistry)) + (wlRegistry, newId) <- newObject @'Client @Interface_wl_registry (callback clientRegistry) sendMessage wlDisplay $ WireRequest_wl_display_get_registry newId pure ClientRegistry {