{-# 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 String
"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 -> 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 =
      do
        let loadDefault :: Int32 -> IO Pixbuf
loadDefault Int32
size = Int32 -> String -> IO (Either String Pixbuf)
loadIcon Int32
size String
"play.svg"
                IO (Either String Pixbuf)
-> (Either String Pixbuf -> IO Pixbuf) -> IO Pixbuf
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Pixbuf)
-> (Pixbuf -> IO Pixbuf) -> Either String Pixbuf -> IO Pixbuf
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Pixbuf
failure Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return
              where failure :: String -> IO Pixbuf
failure String
err =
                      Priority -> String -> String -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
mprisLog Priority
WARNING String
"Failed to load default image: %s" String
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 Word32
0
            logErrorAndLoadDefault :: Int32 -> String -> IO Pixbuf
logErrorAndLoadDefault Int32
size String
err =
              Priority -> String -> String -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
mprisLog Priority
WARNING String
"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 String
"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 String
errorString 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 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 String
"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 String
"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
      [(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
        Maybe MPRIS2PlayerWidget
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 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 String
"System.Taffybar.Widget.MPRIS2"
                          Priority
DEBUG String
"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 Int
20 Int
30 NowPlaying
nowPlaying
                if String
status String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 [NowPlaying]
nowPlayings [(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 [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 Signal
_ String
_ Map String Variant
_ [String]
_ = IO ()
doUpdate
    propMatcher :: MatchRule
propMatcher = MatchRule
matchAny { matchPath :: Maybe ObjectPath
matchPath = ObjectPath -> Maybe ObjectPath
forall a. a -> Maybe a
Just ObjectPath
"/org/mpris/MediaPlayer2" }

    handleNameOwnerChanged :: Signal -> String -> String -> String -> IO ()
handleNameOwnerChanged Signal
_ String
name String
_ String
_ = do
      [String]
busNames <- ((BusName, MPRIS2PlayerWidget) -> String)
-> [(BusName, MPRIS2PlayerWidget)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (BusName -> String
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 Int
artistMax 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 (-Int64
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
           String
"%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
"," [String]
artists)
           (Int -> String -> String
truncateString Int
songMax String
title)