module System.Taffybar.Information.MPRIS2 where
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import qualified DBus
import qualified DBus.Client as DBus
import qualified DBus.Internal.Types as DBus
import qualified DBus.TH as DBus
import Data.Coerce
import Data.List
import qualified Data.Map as M
import Data.Maybe
import System.Log.Logger
import System.Taffybar.DBus.Client.MPRIS2
import Text.Printf
data NowPlaying = NowPlaying
{ npTitle :: String
, npArtists :: [String]
, npStatus :: String
, npBusName :: DBus.BusName
} deriving (Show, Eq)
eitherToMaybeWithLog :: (MonadIO m, Show a1) => Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog (Right v) = return $ Just v
eitherToMaybeWithLog (Left e) = liftIO $ do
logM "System.Taffybar.Information.MPRIS2" WARNING $
printf "Got error: %s" $ show e
return Nothing
getNowPlayingInfo :: MonadIO m => DBus.Client -> m [NowPlaying]
getNowPlayingInfo client =
fmap (fromMaybe []) $ eitherToMaybeWithLog =<< liftIO (runExceptT $ do
allBusNames <- ExceptT $ DBus.listNames client
let mediaPlayerBusNames =
filter (isPrefixOf "org.mpris.MediaPlayer2.") allBusNames
getSongData _busName = runMaybeT $
do
let busName = coerce _busName
metadataMap <-
MaybeT $ getMetadata client busName >>= eitherToMaybeWithLog
(title, artists) <- MaybeT $ return $ getSongInfo metadataMap
status <- MaybeT $ getPlaybackStatus client busName >>=
eitherToMaybeWithLog
return NowPlaying { npTitle = title
, npArtists = artists
, npStatus = status
, npBusName = busName
}
lift $ catMaybes <$> mapM getSongData mediaPlayerBusNames)
getSongInfo :: M.Map String DBus.Variant -> Maybe (String, [String])
getSongInfo songData = do
let lookupVariant k = M.lookup k songData >>= DBus.fromVariant
artists <- lookupVariant "xesam:artist"
title <- lookupVariant "xesam:title"
return (title, artists)