diff --git a/src/AGS/Service.purs b/src/AGS/Service.purs index 00da1d0..3d4510e 100644 --- a/src/AGS/Service.purs +++ b/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) diff --git a/src/AGS/Service/App.purs b/src/AGS/Service/App.purs index 54b952e..612846f 100644 --- a/src/AGS/Service/App.purs +++ b/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 diff --git a/src/AGS/Service/Applications.purs b/src/AGS/Service/Applications.purs index 5bb1d62..9239142 100644 --- a/src/AGS/Service/Applications.purs +++ b/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 diff --git a/src/AGS/Service/Hyprland.purs b/src/AGS/Service/Hyprland.purs index 8aec124..ff37512 100644 --- a/src/AGS/Service/Hyprland.purs +++ b/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) diff --git a/src/AGS/Service/Mpris.purs b/src/AGS/Service/Mpris.purs index 664893c..96b2915 100644 --- a/src/AGS/Service/Mpris.purs +++ b/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 diff --git a/src/AGS/Service/Notifications.purs b/src/AGS/Service/Notifications.purs index 0285ac1..773d266 100644 --- a/src/AGS/Service/Notifications.purs +++ b/src/AGS/Service/Notifications.purs @@ -1,10 +1,12 @@ module AGS.Service.Notifications ( Notifications + , NotificationsSignals , Notification , NotificationID(..) , NotificationsOptions , NotificationRecord , NotificationPropsF + , NotificationsServiceProps , Action , ActionID(..) , ActionLabel(..) @@ -36,6 +38,7 @@ import Data.Maybe (Maybe, fromJust) import Data.Newtype (class Newtype) import Data.Nullable (Nullable, toMaybe) import Data.Show.Generic (genericShow) +import Data.Symbol (class IsSymbol, reflectSymbol) import Data.Time.Duration (Milliseconds(..)) import Effect (Effect) import Effect.Aff.Compat (runEffectFn1) @@ -59,25 +62,18 @@ foreign import data Notifications ∷ Service -- * Signals -instance - ServiceConnect Notifications "changed" (Effect Unit) - where - connectService = connectNotifications "changed" - -instance - ServiceConnect Notifications "dismissed" (EffectFn1 NotificationID Unit) - where - connectService = connectNotifications "dismissed" - -instance - ServiceConnect Notifications "notified" (EffectFn1 NotificationID Unit) - where - connectService = connectNotifications "notified" +type NotificationsSignals = + ( changed ∷ Effect Unit + , dismissed ∷ EffectFn1 NotificationID Unit + , notified ∷ EffectFn1 NotificationID Unit + , closed ∷ EffectFn1 NotificationID Unit + ) instance - ServiceConnect Notifications "closed" (EffectFn1 NotificationID Unit) + IsSymbol prop ⇒ + ServiceConnect Notifications prop NotificationsSignals cb where - connectService = connectNotifications "closed" + connectService = connectNotifications (reflectSymbol (Proxy @prop)) foreign import disconnectNotifications ∷ HandlerID Notifications → Effect Unit @@ -90,14 +86,16 @@ foreign import connectNotifications foreign import notifications ∷ Effect (Array Notification) foreign import popups ∷ Effect (Array Notification) -instance BindServiceProp Notifications "popups" (Array Notification) where - bindServiceProp = bindNotifications "popups" - -instance BindServiceProp Notifications "notifications" (Array Notification) where - bindServiceProp = bindNotifications "notifications" +type NotificationsServiceProps = + ( popups ∷ Array Notification + , notifications ∷ Array Notification + , dnd ∷ Boolean + ) -instance BindServiceProp Notifications "doNotDisturb" Boolean where - bindServiceProp = bindNotifications "dnd" +instance + IsSymbol prop ⇒ + BindServiceProp Notifications prop NotificationsServiceProps ty where + bindServiceProp = bindNotifications (reflectSymbol (Proxy @prop)) foreign import bindNotifications ∷ ∀ a. String → Effect (Binding a)