    {-# LANGUAGE OverloadedStrings #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Widget.MPRIS2
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- This is a "Now Playing" widget that listens for MPRIS2 events on DBus. You
    -- can find the MPRIS2 specification here at
    -- (<https://specifications.freedesktop.org/mpris-spec/latest/>).
    -----------------------------------------------------------------------------
    module System.Taffybar.Widget.MPRIS2 ( mpris2New ) where

    import           Control.Arrow
    import qualified Control.Concurrent.MVar as MV
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Except
    import           Control.Monad.Trans.Reader
    import           DBus
    import           DBus.Client
    import           DBus.Internal.Types
    import qualified DBus.TH as DBus
    import           Data.Coerce
    import           Data.List
    import qualified Data.Text as T
    import qualified GI.Gtk as Gtk
    import qualified GI.GLib as G
    import           System.Log.Logger
    import           System.Taffybar.Context
    import           System.Taffybar.DBus.Client.MPRIS2
    import           System.Taffybar.Information.MPRIS2
    import           System.Environment.XDG.DesktopEntry
    import           System.Taffybar.Util
    import           System.Taffybar.Widget.Generic.AutoSizeImage
    import           System.Taffybar.Widget.Util
    import           System.Taffybar.WindowIcon
    import           Text.Printf

    mprisLog :: (MonadIO m, Show t) => Priority -> String -> t -> m ()
    mprisLog :: Priority -> String -> t -> m ()
    mprisLog = String -> Priority -> String -> t -> m ()
    forall (m :: * -> *) t.
    (MonadIO m, Show t) =>
    String -> Priority -> String -> t -> m ()
    logPrintF "System.Taffybar.Widget.MPRIS2"

    data MPRIS2PlayerWidget = MPRIS2PlayerWidget
      { MPRIS2PlayerWidget -> Label
    playerLabel :: Gtk.Label
      , MPRIS2PlayerWidget -> Grid
    playerGrid :: Gtk.Grid
      }

    mpris2New :: TaffyIO Gtk.Widget
    mpris2New :: TaffyIO Widget
    mpris2New = (Context -> Client) -> ReaderT Context IO Client
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> Client
    sessionDBusClient ReaderT Context IO Client
    -> (Client -> TaffyIO Widget) -> TaffyIO Widget
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \client :: Client
    client -> IO Widget -> TaffyIO Widget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Widget -> TaffyIO Widget) -> IO Widget -> TaffyIO Widget
    forall a b. (a -> b) -> a -> b
    $ do
      Grid
    grid <- IO Grid
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Grid
    Gtk.gridNew
      Grid -> IO ()
    forall o (m :: * -> *). (IsWidget o, MonadIO m) => o -> m ()
    vFillCenter Grid
    grid
      MVar [(BusName, MPRIS2PlayerWidget)]
    playerWidgetsVar <- [(BusName, MPRIS2PlayerWidget)]
    -> IO (MVar [(BusName, MPRIS2PlayerWidget)])
    forall a. a -> IO (MVar a)
    MV.newMVar []
      let
        newPlayerWidget :: BusName -> IO MPRIS2PlayerWidget
        newPlayerWidget :: BusName -> IO MPRIS2PlayerWidget
    newPlayerWidget busName :: BusName
    busName =
          do
            let loadDefault :: Int32 -> IO Pixbuf
    loadDefault size :: Int32
    size = IO Pixbuf -> IO (Either GError Pixbuf)
    forall a. IO a -> IO (Either GError a)
    catchGErrorsAsLeft (Int32 -> String -> IO Pixbuf
    loadIcon Int32
    size "play.svg")
                    IO (Either GError Pixbuf)
    -> (Either GError Pixbuf -> IO Pixbuf) -> IO Pixbuf
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (GError -> IO Pixbuf)
    -> (Pixbuf -> IO Pixbuf) -> Either GError Pixbuf -> IO Pixbuf
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either GError -> IO Pixbuf
    failure Pixbuf -> IO Pixbuf
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                  where failure :: GError -> IO Pixbuf
    failure err :: GError
    err =
                          Priority -> String -> GError -> IO ()
    forall (m :: * -> *) t.
    (MonadIO m, Show t) =>
    Priority -> String -> t -> m ()
    mprisLog Priority
    WARNING "Failed to load default image: %s" GError
    err IO () -> IO Pixbuf -> IO Pixbuf
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                          Int32 -> Word32 -> IO Pixbuf
    forall (m :: * -> *). MonadIO m => Int32 -> Word32 -> m Pixbuf
    pixBufFromColor Int32
    size 0
                logErrorAndLoadDefault :: Int32 -> String -> IO Pixbuf
    logErrorAndLoadDefault size :: Int32
    size err :: String
    err =
                  Priority -> String -> String -> IO ()
    forall (m :: * -> *) t.
    (MonadIO m, Show t) =>
    Priority -> String -> t -> m ()
    mprisLog Priority
    WARNING "Failed to get MPRIS icon: %s" String
    err IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                  Priority -> String -> BusName -> IO ()
    forall (m :: * -> *) t.
    (MonadIO m, Show t) =>
    Priority -> String -> t -> m ()
    mprisLog Priority
    WARNING "MPRIS failure for: %s" BusName
    busName IO () -> IO Pixbuf -> IO Pixbuf
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                  Int32 -> IO Pixbuf
    loadDefault Int32
    size
                makeExcept ::
                  String -> (a -> IO (Maybe b)) -> a -> ExceptT String IO b
                makeExcept :: String -> (a -> IO (Maybe b)) -> a -> ExceptT String IO b
    makeExcept errorString :: String
    errorString actionBuilder :: a -> IO (Maybe b)
    actionBuilder =
                  IO (Either String b) -> ExceptT String IO b
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either String b) -> ExceptT String IO b)
    -> (a -> IO (Either String b)) -> a -> ExceptT String IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe b -> Either String b)
    -> IO (Maybe b) -> IO (Either String b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> Maybe b -> Either String b
    forall b a. b -> Maybe a -> Either b a
    maybeToEither String
    errorString) (IO (Maybe b) -> IO (Either String b))
    -> (a -> IO (Maybe b)) -> a -> IO (Either String b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IO (Maybe b)
    actionBuilder
                loadIconAtSize :: Int32 -> IO Pixbuf
    loadIconAtSize size :: Int32
    size =
                  (String -> IO Pixbuf)
    -> (Pixbuf -> IO Pixbuf) -> Either String Pixbuf -> IO Pixbuf
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Int32 -> String -> IO Pixbuf
    logErrorAndLoadDefault Int32
    size) Pixbuf -> IO Pixbuf
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Pixbuf -> IO Pixbuf)
    -> IO (Either String Pixbuf) -> IO Pixbuf
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT String IO Pixbuf -> IO (Either String Pixbuf)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT
                  (   IO (Either String String) -> ExceptT String IO String
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT ((MethodError -> String)
    -> Either MethodError String -> Either String String
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left MethodError -> String
    forall a. Show a => a -> String
    show (Either MethodError String -> Either String String)
    -> IO (Either MethodError String) -> IO (Either String String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Client -> BusName -> IO (Either MethodError String)
    getDesktopEntry Client
    client BusName
    busName)
                  ExceptT String IO String
    -> (String -> ExceptT String IO DesktopEntry)
    -> ExceptT String IO DesktopEntry
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String
    -> (String -> IO (Maybe DesktopEntry))
    -> String
    -> ExceptT String IO DesktopEntry
    forall a b.
    String -> (a -> IO (Maybe b)) -> a -> ExceptT String IO b
    makeExcept "Failed to get desktop entry"
                      String -> IO (Maybe DesktopEntry)
    getDirectoryEntryDefault
                  ExceptT String IO DesktopEntry
    -> (DesktopEntry -> ExceptT String IO Pixbuf)
    -> ExceptT String IO Pixbuf
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String
    -> (DesktopEntry -> IO (Maybe Pixbuf))
    -> DesktopEntry
    -> ExceptT String IO Pixbuf
    forall a b.
    String -> (a -> IO (Maybe b)) -> a -> ExceptT String IO b
    makeExcept "Failed to get image"
                        (Int32 -> DesktopEntry -> IO (Maybe Pixbuf)
    getImageForDesktopEntry Int32
    size)
                  )

            Image
    image <- (Int32 -> IO Pixbuf) -> Orientation -> IO Image
    forall (m :: * -> *).
    MonadIO m =>
    (Int32 -> IO Pixbuf) -> Orientation -> m Image
    autoSizeImageNew Int32 -> IO Pixbuf
    loadIconAtSize Orientation
    Gtk.OrientationHorizontal
            Grid
    playerBox <- IO Grid
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Grid
    Gtk.gridNew
            Label
    label <- Maybe Text -> IO Label
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Label
    Gtk.labelNew Maybe Text
    forall a. Maybe a
    Nothing

            Grid -> Image -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Grid
    playerBox Image
    image
            Grid -> Label -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Grid
    playerBox Label
    label
            Grid -> IO ()
    forall o (m :: * -> *). (IsWidget o, MonadIO m) => o -> m ()
    vFillCenter Grid
    playerBox

            Grid -> Grid -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Grid
    grid Grid
    playerBox
            Grid -> Bool -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Bool -> m ()
    Gtk.widgetSetVexpand Grid
    playerBox Bool
    True
            Grid -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetHide Grid
    playerBox
            MPRIS2PlayerWidget -> IO MPRIS2PlayerWidget
    forall (m :: * -> *) a. Monad m => a -> m a
    return MPRIS2PlayerWidget :: Label -> Grid -> MPRIS2PlayerWidget
    MPRIS2PlayerWidget {playerLabel :: Label
    playerLabel = Label
    label, playerGrid :: Grid
    playerGrid = Grid
    playerBox}

        updatePlayerWidget :: [(BusName, MPRIS2PlayerWidget)]
    -> NowPlaying -> IO [(BusName, MPRIS2PlayerWidget)]
    updatePlayerWidget
          children :: [(BusName, MPRIS2PlayerWidget)]
    children
          nowPlaying :: NowPlaying
    nowPlaying@NowPlaying
                      { npBusName :: NowPlaying -> BusName
    npBusName = BusName
    busName
                      , npStatus :: NowPlaying -> String
    npStatus = String
    status
                      } =
          case BusName
    -> [(BusName, MPRIS2PlayerWidget)] -> Maybe MPRIS2PlayerWidget
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup BusName
    busName [(BusName, MPRIS2PlayerWidget)]
    children of
            Nothing -> do
              MPRIS2PlayerWidget
    playerWidget <- BusName -> IO MPRIS2PlayerWidget
    newPlayerWidget BusName
    busName
              MPRIS2PlayerWidget -> IO ()
    setNowPlaying MPRIS2PlayerWidget
    playerWidget
              [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(BusName, MPRIS2PlayerWidget)]
     -> IO [(BusName, MPRIS2PlayerWidget)])
    -> [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall a b. (a -> b) -> a -> b
    $ (BusName
    busName, MPRIS2PlayerWidget
    playerWidget)(BusName, MPRIS2PlayerWidget)
    -> [(BusName, MPRIS2PlayerWidget)]
    -> [(BusName, MPRIS2PlayerWidget)]
    forall a. a -> [a] -> [a]
    :[(BusName, MPRIS2PlayerWidget)]
    children
            Just playerWidget :: MPRIS2PlayerWidget
    playerWidget -> MPRIS2PlayerWidget -> IO ()
    setNowPlaying MPRIS2PlayerWidget
    playerWidget IO ()
    -> IO [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(BusName, MPRIS2PlayerWidget)]
    children
          where setNowPlaying :: MPRIS2PlayerWidget -> IO ()
    setNowPlaying
                  MPRIS2PlayerWidget
                  { playerLabel :: MPRIS2PlayerWidget -> Label
    playerLabel = Label
    label
                  , playerGrid :: MPRIS2PlayerWidget -> Grid
    playerGrid = Grid
    playerBox
                  } = do
                    String -> Priority -> String -> NowPlaying -> IO ()
    forall (m :: * -> *) t.
    (MonadIO m, Show t) =>
    String -> Priority -> String -> t -> m ()
    logPrintF "System.Taffybar.Widget.MPRIS2"
                              Priority
    DEBUG "Setting state %s" NowPlaying
    nowPlaying
                    Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Text -> m ()
    Gtk.labelSetMarkup Label
    label (Text -> IO ()) -> IO Text -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Int -> NowPlaying -> IO Text
    forall (m :: * -> *).
    MonadIO m =>
    Int -> Int -> NowPlaying -> m Text
    playingText 20 30 NowPlaying
    nowPlaying
                    if String
    status String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "Playing"
                    then Grid -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShowAll Grid
    playerBox
                    else Grid -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetHide Grid
    playerBox

        updatePlayerWidgets :: [NowPlaying]
    -> [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    updatePlayerWidgets nowPlayings :: [NowPlaying]
    nowPlayings playerWidgets :: [(BusName, MPRIS2PlayerWidget)]
    playerWidgets = do
          [(BusName, MPRIS2PlayerWidget)]
    newWidgets <- ([(BusName, MPRIS2PlayerWidget)]
     -> NowPlaying -> IO [(BusName, MPRIS2PlayerWidget)])
    -> [(BusName, MPRIS2PlayerWidget)]
    -> [NowPlaying]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM [(BusName, MPRIS2PlayerWidget)]
    -> NowPlaying -> IO [(BusName, MPRIS2PlayerWidget)]
    updatePlayerWidget [(BusName, MPRIS2PlayerWidget)]
    playerWidgets [NowPlaying]
    nowPlayings
          let existingBusNames :: [BusName]
    existingBusNames = (NowPlaying -> BusName) -> [NowPlaying] -> [BusName]
    forall a b. (a -> b) -> [a] -> [b]
    map NowPlaying -> BusName
    npBusName [NowPlaying]
    nowPlayings
              noInfoPlayerWidgets :: [(BusName, MPRIS2PlayerWidget)]
    noInfoPlayerWidgets =
                ((BusName, MPRIS2PlayerWidget) -> Bool)
    -> [(BusName, MPRIS2PlayerWidget)]
    -> [(BusName, MPRIS2PlayerWidget)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((BusName -> [BusName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [BusName]
    existingBusNames) (BusName -> Bool)
    -> ((BusName, MPRIS2PlayerWidget) -> BusName)
    -> (BusName, MPRIS2PlayerWidget)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BusName, MPRIS2PlayerWidget) -> BusName
    forall a b. (a, b) -> a
    fst) [(BusName, MPRIS2PlayerWidget)]
    newWidgets
          ((BusName, MPRIS2PlayerWidget) -> IO ())
    -> [(BusName, MPRIS2PlayerWidget)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Grid -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetHide (Grid -> IO ())
    -> ((BusName, MPRIS2PlayerWidget) -> Grid)
    -> (BusName, MPRIS2PlayerWidget)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MPRIS2PlayerWidget -> Grid
    playerGrid (MPRIS2PlayerWidget -> Grid)
    -> ((BusName, MPRIS2PlayerWidget) -> MPRIS2PlayerWidget)
    -> (BusName, MPRIS2PlayerWidget)
    -> Grid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BusName, MPRIS2PlayerWidget) -> MPRIS2PlayerWidget
    forall a b. (a, b) -> b
    snd) [(BusName, MPRIS2PlayerWidget)]
    noInfoPlayerWidgets
          [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(BusName, MPRIS2PlayerWidget)]
    newWidgets

        updatePlayerWidgetsVar :: [NowPlaying] -> IO ()
    updatePlayerWidgetsVar nowPlayings :: [NowPlaying]
    nowPlayings = IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          MVar [(BusName, MPRIS2PlayerWidget)]
    -> ([(BusName, MPRIS2PlayerWidget)]
        -> IO [(BusName, MPRIS2PlayerWidget)])
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar [(BusName, MPRIS2PlayerWidget)]
    playerWidgetsVar (([(BusName, MPRIS2PlayerWidget)]
      -> IO [(BusName, MPRIS2PlayerWidget)])
     -> IO ())
    -> ([(BusName, MPRIS2PlayerWidget)]
        -> IO [(BusName, MPRIS2PlayerWidget)])
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [NowPlaying]
    -> [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    updatePlayerWidgets [NowPlaying]
    nowPlayings

        doUpdate :: IO ()
    doUpdate = Client -> IO [NowPlaying]
    forall (m :: * -> *). MonadIO m => Client -> m [NowPlaying]
    getNowPlayingInfo Client
    client IO [NowPlaying] -> ([NowPlaying] -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [NowPlaying] -> IO ()
    updatePlayerWidgetsVar
        signalCallback :: Signal -> String -> Map String Variant -> [String] -> IO ()
    signalCallback _ _ _ _ = IO ()
    doUpdate
        propMatcher :: MatchRule
    propMatcher = MatchRule
    matchAny { matchPath :: Maybe ObjectPath
    matchPath = ObjectPath -> Maybe ObjectPath
    forall a. a -> Maybe a
    Just "/org/mpris/MediaPlayer2" }

        handleNameOwnerChanged :: Signal -> String -> String -> String -> IO ()
    handleNameOwnerChanged _ name :: String
    name _ _ = do
          [String]
    busNames <- ((BusName, MPRIS2PlayerWidget) -> String)
    -> [(BusName, MPRIS2PlayerWidget)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (BusName -> String
    forall a b. Coercible a b => a -> b
    coerce (BusName -> String)
    -> ((BusName, MPRIS2PlayerWidget) -> BusName)
    -> (BusName, MPRIS2PlayerWidget)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BusName, MPRIS2PlayerWidget) -> BusName
    forall a b. (a, b) -> a
    fst) ([(BusName, MPRIS2PlayerWidget)] -> [String])
    -> IO [(BusName, MPRIS2PlayerWidget)] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar [(BusName, MPRIS2PlayerWidget)]
    -> IO [(BusName, MPRIS2PlayerWidget)]
    forall a. MVar a -> IO a
    MV.readMVar MVar [(BusName, MPRIS2PlayerWidget)]
    playerWidgetsVar
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    name String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    busNames) IO ()
    doUpdate

      SignalHandlerId
    _ <- Grid -> IO () -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> IO () -> m SignalHandlerId
    Gtk.onWidgetRealize Grid
    grid (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ do
        SignalHandler
    updateHandler <-
          Client
    -> MatchRule
    -> (Signal -> String -> Map String Variant -> [String] -> IO ())
    -> IO SignalHandler
    DBus.registerForPropertiesChanged Client
    client MatchRule
    propMatcher Signal -> String -> Map String Variant -> [String] -> IO ()
    signalCallback
        SignalHandler
    nameHandler <-
          Client
    -> MatchRule
    -> (Signal -> String -> String -> String -> IO ())
    -> IO SignalHandler
    DBus.registerForNameOwnerChanged Client
    client MatchRule
    matchAny Signal -> String -> String -> String -> IO ()
    handleNameOwnerChanged
        IO ()
    doUpdate
        IO SignalHandlerId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Grid -> IO () -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> IO () -> m SignalHandlerId
    Gtk.onWidgetUnrealize Grid
    grid (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $
             Client -> SignalHandler -> IO ()
    removeMatch Client
    client SignalHandler
    updateHandler IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Client -> SignalHandler -> IO ()
    removeMatch Client
    client SignalHandler
    nameHandler
      Grid -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShow Grid
    grid
      Grid -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget Grid
    grid

    playingText :: MonadIO m => Int -> Int -> NowPlaying -> m T.Text
    playingText :: Int -> Int -> NowPlaying -> m Text
    playingText artistMax :: Int
    artistMax songMax :: Int
    songMax NowPlaying {npArtists :: NowPlaying -> [String]
    npArtists = [String]
    artists, npTitle :: NowPlaying -> String
    npTitle = String
    title} =
      Text -> Int64 -> m Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    G.markupEscapeText Text
    formattedText (-1)
      where formattedText :: Text
    formattedText = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf
               "%s - %s"
               (Int -> String -> String
    truncateString Int
    artistMax (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," [String]
    artists)
               (Int -> String -> String
    truncateString Int
    songMax String
    title)