Implement overrides for signals

This enables `GObjectSignal` instances to map input callbacks to callbacks consumed by the GJS runtime.

Author: postsolar

src/AGS/Service/Mpris.purs

@@ -5,12 +5,14 @@ module AGS.Service.Mpris
   , disconnectMpris
   , players
   , matchPlayer
-  , BusName
   , Player
   , PlayerProps
   , PlayerSignals
+  , PlayerSignalsOverrides 
+  , PlayerPosition(..)
   , PlayerRecord
   , PlayerRecordR
+  , BusName(..)
   , MprisMetadata
   , MprisMetadataF
   , fromPlayer
@@ -28,10 +30,12 @@ import Prelude
 import AGS.Binding (class BindProp, Binding)
 import AGS.Service (class BindServiceProp, class ServiceConnect, Service)
 import Data.Maybe (Maybe)
+import Data.Newtype (class Newtype)
 import Data.Nullable (Nullable, toMaybe)
 import Data.Symbol (class IsSymbol, reflectSymbol)
+import Data.Variant as V
 import Effect (Effect)
-import Effect.Uncurried (EffectFn1, EffectFn2)
+import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2)
 import GObject (class GObjectSignal, HandlerID, unsafeCopyGObjectProps)
 import Record as R
 import Record.Studio.MapKind (mapRecordKind)
@@ -83,35 +87,52 @@ foreign import matchPlayerImpl ∷ String → Effect (Nullable Player)
 
 -- *** Player
 
+foreign import data Player ∷ Type
+
 newtype BusName = BusName String
 
+derive instance Newtype BusName _
+instance Show BusName where
+  show (BusName bn) = "(BusName " <> bn <> ")"
+
+derive newtype instance Eq BusName
+
+newtype PlayerPosition = PlayerPosition Number
+
+derive instance Newtype PlayerPosition _
+
+instance Show PlayerPosition where
+  show (PlayerPosition pos) = "(PlayerPosition " <> show pos <> ")"
+
+derive newtype instance Eq PlayerPosition
+derive newtype instance Ord PlayerPosition
+derive newtype instance Semiring PlayerPosition
+
 type PlayerRecord = Record PlayerRecordR
 
 type PlayerRecordR =
-  ( "bus-name" ∷ String
+  ( "bus-name" ∷ BusName
   , "can-go-next" ∷ Boolean
   , "can-go-prev" ∷ Boolean
   , "can-play" ∷ Boolean
   , "cover-path" ∷ Maybe String
   , entry ∷ String
   , identity ∷ String
-  , length ∷ Int
+  , length ∷ Number
   , "loop-status" ∷ Maybe Boolean
   , metadata ∷ MprisMetadata
   , name ∷ String
   , "play-back-status" ∷ String
-  , position ∷ Int
+  , position ∷ PlayerPosition
   , "shuffle-status" ∷ Maybe Boolean
   , "track-artists" ∷ Array String
   , "track-cover-url" ∷ String
   , "track-title" ∷ String
   , "track-album" ∷ String
   , trackid ∷ String
-  , volume ∷ Int
+  , volume ∷ Number
   )
 
-foreign import data Player ∷ Type
-
 type MprisMetadata = MprisMetadataF Maybe
 
 type MprisMetadataF f =
@@ -156,7 +177,7 @@ fromPlayer = unsafeCopyGObjectProps @PlayerRecordR
 
 type PlayerProps =
   -- the dbus name that starts with org.mpris.MediaPlayer2
-  ( "bus-name" ∷ String
+  ( "bus-name" ∷ BusName
   -- stripped from busName like spotify or firefox
   , name ∷ String
   -- name of the player like Spotify or Mozilla Firefox
@@ -189,11 +210,17 @@ instance BindProp Player PlayerProps
 -- * Signals
 
 type PlayerSignals =
-  ( position ∷ EffectFn2 Player Number Unit
+  ( position ∷ Player → PlayerPosition → Effect Unit
+  , closed ∷ Player → Effect Unit
+  )
+
+type PlayerSignalsOverrides =
+  ( position ∷ EffectFn2 Player PlayerPosition Unit
   , closed ∷ EffectFn1 Player Unit
   )
 
-instance GObjectSignal Player PlayerSignals
+instance GObjectSignal Player PlayerSignals PlayerSignalsOverrides where
+  overrides = V.over { position: mkEffectFn2, closed: mkEffectFn1 }
 
 -- * Methods
 

src/AGS/Service/Notifications.purs

@@ -41,9 +41,10 @@ import Data.Nullable (Nullable, toMaybe)
 import Data.Show.Generic (genericShow)
 import Data.Symbol (class IsSymbol, reflectSymbol)
 import Data.Time.Duration (Milliseconds(..))
+import Data.Variant as V
 import Effect (Effect)
-import Effect.Aff.Compat (runEffectFn1)
-import Effect.Uncurried (EffectFn2)
+import Effect.Aff.Compat (mkEffectFn1, runEffectFn1)
+import Effect.Uncurried (EffectFn2, mkEffectFn2)
 import GObject (class GObjectSignal, HandlerID, unsafeCopyGObjectProps)
 import Partial.Unsafe (unsafePartial)
 import Record as Record
@@ -144,12 +145,21 @@ fromNotification =
 -- * Signals
 
 type NotificationSignals =
+  ( dismissed ∷ Notification → Effect Unit
+  , closed ∷ Notification → Effect Unit
+  , invoked ∷ Notification → ActionID → Effect Unit
+  )
+
+type NotificationSignalsOverrides =
   ( dismissed ∷ EffectFn1 Notification Unit
   , closed ∷ EffectFn1 Notification Unit
   , invoked ∷ EffectFn2 Notification ActionID Unit
   )
 
-instance GObjectSignal Notification NotificationSignals
+instance
+  GObjectSignal Notification NotificationSignals NotificationSignalsOverrides where
+  overrides = V.over
+    { dismissed: mkEffectFn1, closed: mkEffectFn1, invoked: mkEffectFn2 }
 
 -- * Bindings and props
 

src/AGS/Variable.purs

@@ -1,6 +1,7 @@
 module AGS.Variable
   ( Variable
   , VariableSignals
+  , VariableSignalsOverrides
   , get
   , set
   , bindValue
@@ -14,17 +15,25 @@ import Prelude
 
 import AGS.Binding (class BindProp, Binding, bindProp)
 import Data.Time.Duration (Milliseconds)
+import Data.Variant as V
 import Effect (Effect)
-import Effect.Uncurried (EffectFn1)
+import Effect.Uncurried (EffectFn1, mkEffectFn1)
 import GObject (class GObjectSignal)
 
 foreign import data Variable ∷ Type → Type
 
 type VariableSignals a =
+  ( changed ∷ Variable a → Effect Unit
+  )
+
+type VariableSignalsOverrides a =
   ( changed ∷ EffectFn1 (Variable a) Unit
   )
 
-instance GObjectSignal (Variable a) (VariableSignals a)
+instance
+  GObjectSignal (Variable a) (VariableSignals a) (VariableSignalsOverrides a)
+  where
+  overrides = V.over { changed: mkEffectFn1 }
 
 -- | Get the value of a variable.
 foreign import get ∷ ∀ a. Variable a → Effect a

src/GObject.purs

@@ -1,39 +1,90 @@
 module GObject
   ( HandlerID
   , class GObjectSignal
+  , overrides
   , connect
   , disconnect
   , unsafeCopyGObjectProps
   ) where
 
 import Prelude
 
+import Data.Maybe (Maybe(..))
 import Data.Symbol (class IsSymbol, reflectSymbol)
+import Data.Variant (Variant)
+import Data.Variant as V
 import Effect (Effect)
 import Effect.Uncurried (EffectFn2, EffectFn3, runEffectFn2, runEffectFn3)
+import Partial.Unsafe (unsafeCrashWith)
 import Prim.Row as R
 import Record.Studio.Keys (class Keys, keys)
 import Type.Proxy (Proxy(..))
 
 foreign import data HandlerID ∷ ∀ k. k → Type
 
-class GObjectSignal ∷ Type → Row Type → Constraint
-class GObjectSignal object signals | object → signals
+-- | This class establishes how different GObjects should connect to signals.
+-- | The first type parameter lays out the user-facing callback types, and
+-- | the second type parameter lays out the types used by GJS runtime.
+-- | An instance could look as follows:
+-- |
+-- | ```purescript
+-- | foreign import data Object1 ∷ Type -- the GObject
+-- | type Signals = ( changed ∷ EffectFn2 Object1 Int Unit )
+-- | -- don't apply any overrides
+-- | instance GObjectSignal Object1 Signals Signals where
+-- |   overrides = V.over {}
+-- |
+-- | -- now the same, but with overrides
+-- | foreign import data Object2 ∷ Type
+-- | type Signals = ( changed ∷ Effect Unit )
+-- | type SignalOverrides = ( changed ∷ EffectFn2 Object2 String Unit )
+-- | instance GObjectSignal Object2 Signals SignalOverrides where
+-- |   overrides = V.over { changed: \cb → mkEffectFn2 \_ _ → cb }
+-- | ```
+-- |
+-- | *Note*: for an instance to be found, a type alias used in the
+-- | instance head must be exported.
+class GObjectSignal ∷ Type → Row Type → Row Type → Constraint
+class
+  GObjectSignal object signals overrides
+  | object → signals overrides
+  where
+  overrides ∷ Variant signals → Variant overrides
 
+-- | Connect a GObject to a signal.
+-- | Example:
+-- |
+-- | ```purescript
+-- | connect @"changed" myObject \_obj info → log info
+-- | ```
 connect
-  ∷ ∀ @sig @obj cb rt os
+  ∷ ∀ @sig @obj cb pcb rt os ovs
   . R.Cons sig cb rt os
-  ⇒ GObjectSignal obj os
+  -- This constraint aids the compiler find the type of
+  -- the processed callback to project the variant's value.
+  -- It shouldn't be removed.
+  ⇒ R.Cons sig pcb rt ovs
+  ⇒ GObjectSignal obj os ovs
   ⇒ IsSymbol sig
   ⇒ obj
   → cb
   → Effect (HandlerID obj)
-connect = runEffectFn3 connectImpl (reflectSymbol (Proxy @sig))
+connect o cb' =
+  V.inj label cb'
+    # overrides @obj @os
+    # V.prj label
+    # case _ of
+        Just cb → runEffectFn3 connectImpl (reflectSymbol label) o cb
+        Nothing → unsafeCrashWith "connect: impossible"
+
+  where
+  label = Proxy @sig
 
 foreign import connectImpl ∷ ∀ f o. EffectFn3 String o f (HandlerID o)
 
 -- | Disconnect a GObject given its HandlerID.
-disconnect ∷ ∀ @obj os. GObjectSignal obj os ⇒ obj → HandlerID obj → Effect Unit
+disconnect
+  ∷ ∀ @obj os ovs. GObjectSignal obj os ovs ⇒ obj → HandlerID obj → Effect Unit
 disconnect = runEffectFn2 disconnectImpl
 
 foreign import disconnectImpl ∷ ∀ o. EffectFn2 o (HandlerID o) Unit

src/Gio/FileMonitor.purs

@@ -1,6 +1,7 @@
 module Gio.FileMonitor
   ( GioFileMonitor
   , FileMonitorSignals
+  , FileMonitorSignalsOverrides
   , monitor
   , monitorFile
   , monitorDirectory
@@ -11,31 +12,50 @@ module Gio.FileMonitor
 
 import Prelude
 
+import Data.Enum (toEnum)
+import Data.Maybe (fromJust)
 import Data.Nullable (Nullable)
+import Data.Variant as V
 import Effect (Effect)
 import Effect.Uncurried
   ( EffectFn1
   , EffectFn2
   , EffectFn4
+  , mkEffectFn1
+  , mkEffectFn4
   , runEffectFn1
   , runEffectFn2
   )
 import GObject (class GObjectSignal)
 import Gio.File (GioFile)
 import Gio.FileMonitorEvent (GioFileMonitorEvent)
 import Gio.FileMonitorFlags (GioFileMonitorFlags)
+import Partial.Unsafe (unsafePartial)
 import Unsafe.Coerce (unsafeCoerce)
 
 foreign import data GioFileMonitor ∷ Type
 
 -- * Signals
 
 type FileMonitorSignals =
-  ( changed ∷ EffectFn4 GioFileMonitor GioFile GioFile GioFileMonitorEvent Unit
+  ( changed ∷
+      GioFileMonitor → GioFile → GioFile → GioFileMonitorEvent → Effect Unit
+  , "notify::cancelled" ∷ GioFileMonitor → Effect Unit
+  )
+
+type FileMonitorSignalsOverrides =
+  ( changed ∷ EffectFn4 GioFileMonitor GioFile GioFile Int Unit
   , "notify::cancelled" ∷ EffectFn1 GioFileMonitor Unit
   )
 
-instance GObjectSignal GioFileMonitor FileMonitorSignals
+instance
+  GObjectSignal GioFileMonitor FileMonitorSignals FileMonitorSignalsOverrides
+  where
+  overrides = V.over
+    { changed: \cb → mkEffectFn4 \a b c int →
+        cb a b c (unsafePartial $ fromJust $ toEnum int)
+    , "notify::cancelled": mkEffectFn1
+    }
 
 -- * Methods