Propagate IsInterfaceSide further and generate instances

src/Quasar/Wayland/Client.hs

@@ -31,9 +31,9 @@ instance IsDisposable WaylandClient where
   toDisposable (WaylandClient connection) = toDisposable connection
 
 newWaylandClient :: MonadResourceManager m => Socket -> m WaylandClient
-newWaylandClient socket = WaylandClient <$> newWaylandConnection clientCallback clientCallback socket
+newWaylandClient socket = WaylandClient <$> newWaylandConnection @I_wl_display @I_wl_registry clientCallback clientCallback socket
 
-clientCallback :: IsInterface i => ClientCallback STM i
+clientCallback :: IsInterfaceSide 'Client i => ClientCallback STM i
 clientCallback = Callback {
   messageCallback = \object message ->
     lift $ traceM $ objectInterfaceName object <> "@" <> show (objectId object) <> "." <> showMessage message

src/Quasar/Wayland/Connection.hs

@@ -34,7 +34,12 @@ data SocketClosed = SocketClosed
   deriving stock Show
   deriving anyclass Exception
 
-newWaylandConnection :: forall s m. (IsSide s, MonadResourceManager m) => Callback s STM I_wl_display -> Callback s STM I_wl_registry -> Socket -> m (WaylandConnection s)
+newWaylandConnection
+  :: forall wl_display wl_registry s m. (IsInterfaceSide s wl_display, IsInterfaceSide s wl_registry, MonadResourceManager m)
+  => Callback s STM wl_display
+  -> Callback s STM wl_registry
+  -> Socket
+  -> m (WaylandConnection s)
 newWaylandConnection wlDisplayCallback wlRegistryCallback socket = do
   protocolStateVar <- liftIO $ newTVarIO $ initialProtocolState wlDisplayCallback wlRegistryCallback
   outboxVar <- liftIO newEmptyTMVarIO

src/Quasar/Wayland/Core.hs

@@ -2,9 +2,10 @@ module Quasar.Wayland.Core (
   ObjectId,
   Opcode,
   Fixed,
-  IsInterface(..),
-  Side(..),
   IsSide,
+  Side(..),
+  IsInterface(..),
+  IsInterfaceSide(..),
   Object,
   IsObject(..),
   IsObject,

src/Quasar/Wayland/TH.hs

@@ -59,7 +59,7 @@ tellQs = tell <=< lift
 
 interfaceDec :: InterfaceSpec -> Q [Dec]
 interfaceDec interface = execWriterT do
-  tellQ $ dataD (pure []) iName [] Nothing [normalC iName []] []
+  tellQ $ dataD (pure []) iName [] Nothing [normalC iName []] [derivingInterfaceClient, derivingInterfaceServer]
   tellQ $ instanceD (pure []) [t|IsInterface $iT|] instanceDecs
 
   when (length interface.requests > 0) do
@@ -125,6 +125,11 @@ interfaceT interface = conT (interfaceN interface)
 derivingShow :: Q DerivClause
 derivingShow = derivClause (Just StockStrategy) [[t|Show|]]
 
+derivingInterfaceClient :: Q DerivClause
+derivingInterfaceClient = derivClause (Just AnyclassStrategy) [[t|IsInterfaceSide 'Client|]]
+
+derivingInterfaceServer :: Q DerivClause
+derivingInterfaceServer = derivClause (Just AnyclassStrategy) [[t|IsInterfaceSide 'Server|]]