Refactor service typeclasses (#13)

* Refactor `BindServiceProp` type class

* Refactor `ConnectService` type class

src/AGS/Service.purs

@@ -2,55 +2,34 @@ module AGS.Service where
 
 import AGS.Binding (Binding)
 import Effect (Effect)
-import Effect.Uncurried
-  ( EffectFn1
-  , EffectFn10
-  , EffectFn2
-  , EffectFn3
-  , EffectFn4
-  , EffectFn5
-  , EffectFn6
-  , EffectFn7
-  , EffectFn8
-  , EffectFn9
-  )
 import GObject (HandlerID)
-import Prelude (Unit)
-import Prim.TypeError as TE
+import Prim.Row as R
 
 data Service
 
-class BindServiceProp ∷ ∀ k. Service → k → Type → Constraint
-class BindServiceProp s p a | s p → a where
-  bindServiceProp ∷ Effect (Binding a)
-
-class ServiceCallback ∷ Type → Constraint
-class ServiceCallback f
-
-instance ServiceCallback (Effect Unit)
-else instance ServiceCallback (EffectFn1 a Unit)
-else instance ServiceCallback (EffectFn2 a b Unit)
-else instance ServiceCallback (EffectFn3 a b c Unit)
-else instance ServiceCallback (EffectFn4 a b c d Unit)
-else instance ServiceCallback (EffectFn5 a b c d e Unit)
-else instance ServiceCallback (EffectFn6 a b c d e f Unit)
-else instance ServiceCallback (EffectFn7 a b c d e f g Unit)
-else instance ServiceCallback (EffectFn8 a b c d e f g h Unit)
-else instance ServiceCallback (EffectFn9 a b c d e f g h i Unit)
-else instance ServiceCallback (EffectFn10 a b c d e f g h i j Unit)
-else instance
-  TE.Fail (TE.Text "Only EffectFnN can have a ServiceCallback instance") ⇒
-  ServiceCallback other
+class BindServiceProp ∷ Service → Symbol → Row Type → Type → Constraint
+class
+  BindServiceProp service prop props ty
+  | service → props
+  , service prop → ty
+  , props prop → ty
+  where
+  bindServiceProp ∷ ∀ rt. R.Cons prop ty rt props ⇒ Effect (Binding ty)
 
 -- This class mimics `GObjectSignal` but allows the instances
 -- to not expose the service object and wrap the callbacks so
 -- that the object doesn't get passed to them. The former is simply
 -- redundant because the object is known statically, the latter
 -- is usually highly unsafe due to services representing mutable objects.
-class ServiceConnect ∷ ∀ k. Service → k → Type → Constraint
+class ServiceConnect ∷ Service → Symbol → Row Type → Type → Constraint
 class
-  ServiceCallback callback ⇐
-  ServiceConnect service signal callback
-  | service signal → callback where
-  connectService ∷ callback → Effect (HandlerID service)
+  ServiceConnect service prop props callback
+  | service → props
+  , props prop → callback
+  where
+  connectService
+    ∷ ∀ rt
+    . R.Cons prop callback rt props
+    ⇒ callback
+    → Effect (HandlerID service)
 

src/AGS/Service/App.purs

@@ -1,5 +1,6 @@
 module AGS.Service.App
   ( App
+  , AppSignals
   , disconnectApp
   , addWindow
   , applyCss
@@ -19,9 +20,11 @@ import Prelude
 import AGS.Service (class ServiceConnect, Service)
 import AGS.Widget.Window (Window)
 import Data.Maybe (Maybe)
+import Data.Symbol (class IsSymbol, reflectSymbol)
 import Effect (Effect)
 import Effect.Uncurried (EffectFn2)
 import GObject (HandlerID)
+import Type.Proxy (Proxy(..))
 import Untagged.Union (UndefinedOr, uorToMaybe)
 
 foreign import data App ∷ Service
@@ -37,14 +40,15 @@ foreign import windows ∷ Effect (Array Window)
 
 -- * Signals
 
-foreign import disconnectApp ∷ HandlerID App → Effect Unit
-
-instance ServiceConnect App "config-parsed" (Effect Unit) where
-  connectService = connectApp "config-parsed"
+type AppSignals =
+  ( "config-parsed" ∷ Effect Unit
+  , "window-toggled" ∷ EffectFn2 String Boolean Unit
+  )
 
-instance ServiceConnect App "window-toggled" (EffectFn2 String Boolean Unit) where
-  connectService = connectApp "window-toggled"
+instance IsSymbol prop ⇒ ServiceConnect App prop AppSignals cb where
+  connectService = connectApp (reflectSymbol (Proxy @prop))
 
+foreign import disconnectApp ∷ HandlerID App → Effect Unit
 foreign import connectApp ∷ ∀ f. String → f → Effect (HandlerID App)
 
 -- * Methods

src/AGS/Service/Applications.purs

@@ -5,8 +5,10 @@ import Prelude
 import AGS.Binding (Binding)
 import AGS.Service (class BindServiceProp, Service)
 import Data.Nullable (Nullable)
+import Data.Symbol (class IsSymbol, reflectSymbol)
 import Effect (Effect)
 import Gio.DesktopAppInfo as Gio
+import Type.Proxy (Proxy(..))
 import Unsafe.Coerce (unsafeCoerce)
 
 foreign import data Applications ∷ Service
@@ -20,8 +22,14 @@ foreign import list ∷ Effect (Array Application)
 
 foreign import bindApplications ∷ ∀ a. String → Effect (Binding a)
 
-instance BindServiceProp Applications "list" (Array Application) where
-  bindServiceProp = bindApplications "list"
+type ApplicationsServiceProps =
+  ( list ∷ Array Application
+  )
+
+instance
+  IsSymbol prop ⇒
+  BindServiceProp Applications prop ApplicationsServiceProps ty where
+  bindServiceProp = bindApplications (reflectSymbol (Proxy @prop))
 
 -- * Methods
 

src/AGS/Service/Hyprland.purs

@@ -8,7 +8,11 @@ module AGS.Service.Hyprland
   , Monitor'
   , Client'
   , Hyprland
+  , HyprlandSignals
+  , HyprlandServiceProps
   , HyprlandActive
+  , HyprlandActiveSignals
+  , HyprlandActiveServiceProps
   , disconnectHyprland
   , disconnectHyprlandActive
   , message
@@ -23,11 +27,13 @@ import Prelude
 import AGS.Binding (Binding)
 import AGS.Service (class BindServiceProp, class ServiceConnect, Service)
 import Data.Maybe (Maybe)
+import Data.Symbol (class IsSymbol, reflectSymbol)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Uncurried (EffectFn1, EffectFn2)
 import GObject (HandlerID)
 import Promise.Aff (Promise, toAffE)
+import Type.Proxy (Proxy(..))
 import Untagged.Union (UndefinedOr, uorToMaybe)
 
 foreign import data Hyprland ∷ Service
@@ -127,28 +133,28 @@ type Client' =
   , class ∷ String
   }
 
-instance BindServiceProp Hyprland "active" HyprlandActiveRecord where
-  bindServiceProp = bindHyprland "active"
-
-instance BindServiceProp Hyprland "monitors" (Array Monitor) where
-  bindServiceProp = bindHyprland "monitors"
-
-instance BindServiceProp Hyprland "workspaces" (Array Workspace) where
-  bindServiceProp = bindHyprland "workspaces"
+type HyprlandServiceProps =
+  ( active ∷ HyprlandActiveRecord
+  , monitors ∷ Array Monitor
+  , workspaces ∷ Array Workspace
+  , clients ∷ Array Client
+  )
 
-instance BindServiceProp Hyprland "clients" (Array Client) where
-  bindServiceProp = bindHyprland "clients"
+instance IsSymbol prop ⇒ BindServiceProp Hyprland prop HyprlandServiceProps ty where
+  bindServiceProp = bindHyprland (reflectSymbol (Proxy @prop))
 
 foreign import bindHyprland ∷ ∀ a. String → Effect (Binding a)
 
-instance BindServiceProp HyprlandActive "client" Client' where
-  bindServiceProp = bindHyprlandActive "client"
-
-instance BindServiceProp HyprlandActive "workspace" Workspace' where
-  bindServiceProp = bindHyprlandActive "workspace"
+type HyprlandActiveServiceProps =
+  ( client ∷ Client'
+  , workspace ∷ Workspace'
+  , monitor ∷ Monitor'
+  )
 
-instance BindServiceProp HyprlandActive "monitor" Monitor' where
-  bindServiceProp = bindHyprlandActive "monitor"
+instance
+  IsSymbol prop ⇒
+  BindServiceProp HyprlandActive prop HyprlandActiveServiceProps ty where
+  bindServiceProp = bindHyprlandActive (reflectSymbol (Proxy @prop))
 
 foreign import bindHyprlandActive ∷ ∀ a. String → Effect (Binding a)
 
@@ -157,48 +163,35 @@ foreign import bindHyprlandActive ∷ ∀ a. String → Effect (Binding a)
 foreign import disconnectHyprland ∷ HandlerID Hyprland → Effect Unit
 foreign import disconnectHyprlandActive ∷ HandlerID HyprlandActive → Effect Unit
 
-instance ServiceConnect Hyprland "event" (EffectFn2 String String Unit) where
-  connectService = connectHyprland "event"
-
-instance ServiceConnect Hyprland "urgent-window" (EffectFn1 Int Unit) where
-  connectService = connectHyprland "urgent-window"
-
-instance
-  ServiceConnect Hyprland "keyboard-layout" (EffectFn2 String String Unit) where
-  connectService = connectHyprland "keyboard-layout"
-
-instance ServiceConnect Hyprland "submap" (EffectFn1 String Unit) where
-  connectService = connectHyprland "submap"
-
-instance ServiceConnect Hyprland "monitor-added" (EffectFn1 Int Unit) where
-  connectService = connectHyprland "monitor-added"
-
-instance ServiceConnect Hyprland "monitor-removed" (EffectFn1 Int Unit) where
-  connectService = connectHyprland "monitor-removed"
-
-instance ServiceConnect Hyprland "workspace-added" (EffectFn1 Int Unit) where
-  connectService = connectHyprland "workspace-added"
-
-instance ServiceConnect Hyprland "workspace-removed" (EffectFn1 Int Unit) where
-  connectService = connectHyprland "workspace-removed"
-
-instance ServiceConnect Hyprland "client-added" (EffectFn1 String Unit) where
-  connectService = connectHyprland "client-added"
-
-instance ServiceConnect Hyprland "client-removed" (EffectFn1 String Unit) where
-  connectService = connectHyprland "client-removed"
-
-instance ServiceConnect Hyprland "fullscreen" (EffectFn1 Boolean Unit) where
-  connectService = connectHyprland "fullscreen"
-
-instance ServiceConnect Hyprland "changed" (Effect Unit) where
-  connectService = connectHyprland "changed"
+type HyprlandSignals =
+  ( event ∷ EffectFn2 String String Unit
+  , "urgent-window" ∷ EffectFn1 Int Unit
+  , "keyboard-layout" ∷ EffectFn2 String String Unit
+  , submap ∷ EffectFn1 String Unit
+  , "monitor-added" ∷ EffectFn1 Int Unit
+  , "monitor-removed" ∷ EffectFn1 Int Unit
+  , "workspace-added" ∷ EffectFn1 Int Unit
+  , "workspace-removed" ∷ EffectFn1 Int Unit
+  , "client-added" ∷ EffectFn1 String Unit
+  , "client-removed" ∷ EffectFn1 String Unit
+  , fullscreen ∷ EffectFn1 Boolean Unit
+  , changed ∷ Effect Unit
+  )
+
+instance IsSymbol prop ⇒ ServiceConnect Hyprland prop HyprlandSignals cb where
+  connectService = connectHyprland (reflectSymbol (Proxy @prop))
 
 foreign import connectHyprland
   ∷ ∀ f. String → f → Effect (HandlerID Hyprland)
 
-instance ServiceConnect HyprlandActive "changed" (Effect Unit) where
-  connectService = connectHyprlandActive "changed"
+type HyprlandActiveSignals =
+  ( changed ∷ Effect Unit
+  )
+
+instance
+  IsSymbol prop ⇒
+  ServiceConnect HyprlandActive prop HyprlandActiveSignals cb where
+  connectService = connectHyprlandActive (reflectSymbol (Proxy @prop))
 
 foreign import connectHyprlandActive
   ∷ ∀ f. String → f → Effect (HandlerID HyprlandActive)

src/AGS/Service/Mpris.purs

@@ -1,5 +1,7 @@
 module AGS.Service.Mpris
   ( Mpris
+  , MprisSignals
+  , MprisServiceProps
   , disconnectMpris
   , players
   , matchPlayer
@@ -25,6 +27,7 @@ import AGS.Binding (class BindProp, Binding, unsafeBindProp)
 import AGS.Service (class BindServiceProp, class ServiceConnect, Service)
 import Data.Maybe (Maybe)
 import Data.Nullable (Nullable, toMaybe)
+import Data.Symbol (class IsSymbol, reflectSymbol)
 import Effect (Effect)
 import Effect.Uncurried (EffectFn1, EffectFn2)
 import GObject
@@ -50,34 +53,26 @@ foreign import connectMpris ∷ ∀ f. String → f → Effect (HandlerID Mpris)
 
 foreign import bindMpris ∷ ∀ a. String → Effect (Binding a)
 
-instance BindServiceProp Mpris "players" (Array Player) where
-  bindServiceProp = bindMpris "players"
-
--- * Signals
+type MprisServiceProps =
+  ( players ∷ Array Player
+  )
 
-instance
-  ServiceConnect Mpris
-    "changed"
-    (EffectFn1 { players ∷ Array Player } Unit) where
-  connectService = connectMpris "changed"
+instance IsSymbol prop ⇒ BindServiceProp Mpris prop MprisServiceProps ty where
+  bindServiceProp = bindMpris (reflectSymbol (Proxy @prop))
 
-instance
-  ServiceConnect Mpris
-    "player-changed"
-    (EffectFn2 { players ∷ Array Player } BusName Unit) where
-  connectService = connectMpris "player-changed"
+-- * Signals
 
-instance
-  ServiceConnect Mpris
-    "player-closed"
-    (EffectFn2 { players ∷ Array Player } BusName Unit) where
-  connectService = connectMpris "player-closed"
+type MprisSignals =
+  ( changed ∷ EffectFn1 { players ∷ Array Player } Unit
+  , "player-changed" ∷ EffectFn2 { players ∷ Array Player } BusName Unit
+  , "player-closed" ∷ EffectFn2 { players ∷ Array Player } BusName Unit
+  , "player-added" ∷ EffectFn2 { players ∷ Array Player } BusName Unit
+  )
 
 instance
-  ServiceConnect Mpris
-    "player-added"
-    (EffectFn2 { players ∷ Array Player } BusName Unit) where
-  connectService = connectMpris "player-added"
+  IsSymbol prop ⇒
+  ServiceConnect Mpris prop MprisSignals cb where
+  connectService = connectMpris (reflectSymbol (Proxy @prop))
 
 -- * Methods