{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- 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.Applicative
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
  { NowPlaying -> String
npTitle :: String
  , NowPlaying -> [String]
npArtists :: [String]
  , NowPlaying -> String
npStatus :: String
  , NowPlaying -> BusName
npBusName :: DBus.BusName
  } deriving (Int -> NowPlaying -> ShowS
[NowPlaying] -> ShowS
NowPlaying -> String
(Int -> NowPlaying -> ShowS)
-> (NowPlaying -> String)
-> ([NowPlaying] -> ShowS)
-> Show NowPlaying
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NowPlaying -> ShowS
showsPrec :: Int -> NowPlaying -> ShowS
$cshow :: NowPlaying -> String
show :: NowPlaying -> String
$cshowList :: [NowPlaying] -> ShowS
showList :: [NowPlaying] -> ShowS
Show, NowPlaying -> NowPlaying -> Bool
(NowPlaying -> NowPlaying -> Bool)
-> (NowPlaying -> NowPlaying -> Bool) -> Eq NowPlaying
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NowPlaying -> NowPlaying -> Bool
== :: NowPlaying -> NowPlaying -> Bool
$c/= :: NowPlaying -> NowPlaying -> Bool
/= :: NowPlaying -> NowPlaying -> Bool
Eq)

eitherToMaybeWithLog :: (MonadIO m, Show a1) => Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog :: forall (m :: * -> *) a1 a2.
(MonadIO m, Show a1) =>
Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog (Right a2
v) = Maybe a2 -> m (Maybe a2)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a2 -> m (Maybe a2)) -> Maybe a2 -> m (Maybe a2)
forall a b. (a -> b) -> a -> b
$ a2 -> Maybe a2
forall a. a -> Maybe a
Just a2
v
eitherToMaybeWithLog (Left a1
e) = IO (Maybe a2) -> m (Maybe a2)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a2) -> m (Maybe a2)) -> IO (Maybe a2) -> m (Maybe a2)
forall a b. (a -> b) -> a -> b
$ do
  String -> Priority -> String -> IO ()
logM String
"System.Taffybar.Information.MPRIS2" Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Got error: %s" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a1 -> String
forall a. Show a => a -> String
show a1
e
  Maybe a2 -> IO (Maybe a2)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a2
forall a. Maybe a
Nothing

getNowPlayingInfo :: MonadIO m => DBus.Client -> m [NowPlaying]
getNowPlayingInfo :: forall (m :: * -> *). MonadIO m => Client -> m [NowPlaying]
getNowPlayingInfo Client
client =
  (Maybe [NowPlaying] -> [NowPlaying])
-> m (Maybe [NowPlaying]) -> m [NowPlaying]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([NowPlaying] -> Maybe [NowPlaying] -> [NowPlaying]
forall a. a -> Maybe a -> a
fromMaybe []) (m (Maybe [NowPlaying]) -> m [NowPlaying])
-> m (Maybe [NowPlaying]) -> m [NowPlaying]
forall a b. (a -> b) -> a -> b
$ Either MethodError [NowPlaying] -> m (Maybe [NowPlaying])
forall (m :: * -> *) a1 a2.
(MonadIO m, Show a1) =>
Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog (Either MethodError [NowPlaying] -> m (Maybe [NowPlaying]))
-> m (Either MethodError [NowPlaying]) -> m (Maybe [NowPlaying])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either MethodError [NowPlaying])
-> m (Either MethodError [NowPlaying])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT MethodError IO [NowPlaying]
-> IO (Either MethodError [NowPlaying])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MethodError IO [NowPlaying]
 -> IO (Either MethodError [NowPlaying]))
-> ExceptT MethodError IO [NowPlaying]
-> IO (Either MethodError [NowPlaying])
forall a b. (a -> b) -> a -> b
$ do
    allBusNames <- IO (Either MethodError [String]) -> ExceptT MethodError IO [String]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either MethodError [String])
 -> ExceptT MethodError IO [String])
-> IO (Either MethodError [String])
-> ExceptT MethodError IO [String]
forall a b. (a -> b) -> a -> b
$ Client -> IO (Either MethodError [String])
DBus.listNames Client
client
    let mediaPlayerBusNames =
          (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"org.mpris.MediaPlayer2.") [String]
allBusNames
        getSongData p
_busName = MaybeT IO NowPlaying -> IO (Maybe NowPlaying)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO NowPlaying -> IO (Maybe NowPlaying))
-> MaybeT IO NowPlaying -> IO (Maybe NowPlaying)
forall a b. (a -> b) -> a -> b
$
          do
            let busName :: BusName
busName = p -> BusName
forall a b. Coercible a b => a -> b
coerce p
_busName
            metadataMap <-
              IO (Maybe (Map String Variant)) -> MaybeT IO (Map String Variant)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Map String Variant)) -> MaybeT IO (Map String Variant))
-> IO (Maybe (Map String Variant))
-> MaybeT IO (Map String Variant)
forall a b. (a -> b) -> a -> b
$ Client -> BusName -> IO (Either MethodError (Map String Variant))
getMetadata Client
client BusName
busName IO (Either MethodError (Map String Variant))
-> (Either MethodError (Map String Variant)
    -> IO (Maybe (Map String Variant)))
-> IO (Maybe (Map String Variant))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either MethodError (Map String Variant)
-> IO (Maybe (Map String Variant))
forall (m :: * -> *) a1 a2.
(MonadIO m, Show a1) =>
Either a1 a2 -> m (Maybe a2)
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 :: Map String Variant -> Maybe (String, [String])
getSongInfo Map String Variant
songData = do
  let lookupVariant :: String -> Maybe b
lookupVariant String
k = String -> Map String Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String Variant
songData Maybe Variant -> (Variant -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variant -> Maybe b
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant
  artists <- String -> Maybe [String]
forall {b}. IsVariant b => String -> Maybe b
lookupVariant String
"xesam:artist" Maybe [String] -> Maybe [String] -> Maybe [String]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [String] -> Maybe [String]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  title <- lookupVariant "xesam:title"
  return (title, artists)