    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Information.MPRIS2
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -----------------------------------------------------------------------------

    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)