Fix warnings

src/Quasar/Wayland/Connection.hs

@@ -9,15 +9,11 @@ module Quasar.Wayland.Connection (
 import Control.Monad.Catch
 import Data.Bits ((.&.))
 import Data.ByteString qualified as BS
-import Data.ByteString.Internal (createUptoN)
 import Data.ByteString.Lazy qualified as BSL
-import Foreign.Storable (sizeOf)
 import Language.C.Inline qualified as C
 import Language.C.Inline.Unsafe qualified as CU
 import Network.Socket (Socket)
 import Network.Socket qualified as Socket
-import Network.Socket.ByteString qualified as Socket
-import Network.Socket.ByteString.Lazy qualified as SocketL
 import Quasar
 import Quasar.Prelude
 import Quasar.Wayland.Protocol
@@ -69,7 +65,7 @@ newWaylandConnection initializeProtocolAction socket = do
     t1 <- connectionThread connection $ sendThread connection
     t2 <- connectionThread connection $ receiveThread connection
 
-    registerDisposeActionIO do
+    registerDisposeActionIO_ do
       await $ isDisposed t1
       await $ isDisposed t2
       closeConnection connection
@@ -77,10 +73,11 @@ newWaylandConnection initializeProtocolAction socket = do
     pure (result, connection)
 
 connectionThread :: (MonadIO m, MonadQuasar m) => WaylandConnection s -> IO () -> m (Async ())
-connectionThread connection work = asyncWithUnmask' \unmask -> work `catch` traceAndDisposeConnection
+connectionThread connection work = asyncWithUnmask' \unmask -> unmask work `catch` traceAndDisposeConnection
   where
     traceAndDisposeConnection :: SomeException -> IO ()
     traceAndDisposeConnection (isCancelAsync -> True) = pure ()
+    -- TODO this logs- and then discard exceptions. Ensure this is the desired behavior?
     traceAndDisposeConnection ex = traceIO (displayException ex) >> disposeEventuallyIO_ connection
 
 sendThread :: WaylandConnection s -> IO ()
@@ -102,14 +99,14 @@ sendThread connection = mask_ $ forever do
       sent <- sendMsg connection.socket chunks (Socket.encodeCmsg <$> fds) mempty
       let nowRemaining = remaining - sent
       when (nowRemaining > 0) do
-        send nowRemaining (drop sent chunks) []
+        send nowRemaining (dropL sent chunks) []
 
-    drop :: Int -> [BS.ByteString] -> [BS.ByteString]
-    drop _ [] = []
-    drop amount (chunk:chunks) =
+    dropL :: Int -> [BS.ByteString] -> [BS.ByteString]
+    dropL _ [] = []
+    dropL amount (chunk:chunks) =
       if (amount < BS.length chunk)
         then (BS.drop amount chunk : chunks)
-        else drop (amount - BS.length chunk) chunks
+        else dropL (amount - BS.length chunk) chunks
 
 
 receiveThread :: IsSide s => WaylandConnection s -> IO ()

src/Quasar/Wayland/Protocol/Core.hs

@@ -612,7 +612,7 @@ bindNewObject protocol version messageHandler = runProtocolM protocol do
 
 
 fromSomeObject
-  :: forall s i m. IsInterfaceSide s i
+  :: forall s i. IsInterfaceSide s i
   => SomeObject s -> Either String (Object s i)
 fromSomeObject (SomeObject someObject) =
   case cast someObject of
@@ -657,13 +657,13 @@ getNullableObject oId = Just <$> getObject oId
 -- | Handle a wl_display.error message. Because this is part of the core protocol but generated from the xml it has to
 -- be called from the client module.
 handleWlDisplayError :: ProtocolHandle 'Client -> GenericObjectId -> Word32 -> WlString -> STM ()
-handleWlDisplayError _protocol oId code message = throwM $ ServerError code (toString message)
+handleWlDisplayError _protocol _oId code message = throwM $ ServerError code (toString message)
 
 -- | Handle a wl_display.delete_id message. Because this is part of the core protocol but generated from the xml it has
 -- to be called from the client module.
 handleWlDisplayDeleteId :: ProtocolHandle 'Client -> Word32 -> STM ()
 handleWlDisplayDeleteId protocol oId = runProtocolM protocol do
-  -- TODO call destructor
+  -- TODO mark as deleted
   modifyProtocolVar (.objectsVar) $ HM.delete (GenericObjectId oId)
 
 
@@ -711,7 +711,6 @@ sendMessage object message = do
   traceM $ "-> " <> showObjectMessage object message
   sendRawMessage (putHeader opcode (8 + bodyLength) >> putBody) fds
   where
-    oId = genericObjectId object
     (GenericObjectId objectIdWord) = genericObjectId object
     putHeader :: Opcode -> Int -> Put
     putHeader opcode msgSize = do

src/Quasar/Wayland/Protocol/TH.hs

@@ -122,7 +122,7 @@ generateWaylandProcol protocolFile = do
 
 generateWaylandProcols :: [FilePath] -> Q [Dec]
 generateWaylandProcols protocolFiles = do
-  mapM addDependentFile protocolFiles
+  mapM_ addDependentFile protocolFiles
   xmls <- mapM (liftIO . BS.readFile) protocolFiles
   protocol <- mconcat <$> mapM parseProtocol xmls
   (public, internals) <- unzip <$> mapM interfaceDecs protocol.interfaces
@@ -603,8 +603,8 @@ parseEvent :: MonadFail m => String -> (Opcode, Element) -> m EventSpec
 parseEvent x y = EventSpec <$> parseMessage False x y
 
 parseMessage :: MonadFail m => Bool -> String -> (Opcode, Element) -> m MessageSpec
-parseMessage isRequest interface (opcode, element) = do
-  let isEvent = not isRequest
+parseMessage _isRequest interface (opcode, element) = do
+  -- let isEvent = not isRequest
 
   name <- getAttr "name" element