{-# 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.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
showList :: [NowPlaying] -> ShowS
$cshowList :: [NowPlaying] -> ShowS
show :: NowPlaying -> String
$cshow :: NowPlaying -> String
showsPrec :: Int -> NowPlaying -> ShowS
$cshowsPrec :: Int -> NowPlaying -> ShowS
Show, NowPlaying -> NowPlaying -> Bool
(NowPlaying -> NowPlaying -> Bool)
-> (NowPlaying -> NowPlaying -> Bool) -> Eq NowPlaying
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NowPlaying -> NowPlaying -> Bool
$c/= :: NowPlaying -> NowPlaying -> Bool
== :: NowPlaying -> NowPlaying -> Bool
$c== :: NowPlaying -> NowPlaying -> Bool
Eq)

eitherToMaybeWithLog :: (MonadIO m, Show a1) => Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog :: Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog (Right a2
v) = Maybe a2 -> m (Maybe a2)
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe a2
forall a. Maybe a
Nothing

getNowPlayingInfo :: MonadIO m => DBus.Client -> m [NowPlaying]
getNowPlayingInfo :: Client -> m [NowPlaying]
getNowPlayingInfo Client
client =
  (Maybe [NowPlaying] -> [NowPlaying])
-> m (Maybe [NowPlaying]) -> m [NowPlaying]
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 (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
    [String]
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]
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 -> IO (Maybe NowPlaying)
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
coerce p
_busName
            Map String Variant
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 (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
            (String
title, [String]
artists) <- IO (Maybe (String, [String])) -> MaybeT IO (String, [String])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (String, [String])) -> MaybeT IO (String, [String]))
-> IO (Maybe (String, [String])) -> MaybeT IO (String, [String])
forall a b. (a -> b) -> a -> b
$ Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, [String]) -> IO (Maybe (String, [String])))
-> Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a b. (a -> b) -> a -> b
$ Map String Variant -> Maybe (String, [String])
getSongInfo Map String Variant
metadataMap
            String
status <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ Client -> BusName -> IO (Either MethodError String)
getPlaybackStatus Client
client BusName
busName IO (Either MethodError String)
-> (Either MethodError String -> IO (Maybe String))
-> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                               Either MethodError String -> IO (Maybe String)
forall (m :: * -> *) a1 a2.
(MonadIO m, Show a1) =>
Either a1 a2 -> m (Maybe a2)
eitherToMaybeWithLog
            NowPlaying -> MaybeT IO NowPlaying
forall (m :: * -> *) a. Monad m => a -> m a
return NowPlaying :: String -> [String] -> String -> BusName -> NowPlaying
NowPlaying { npTitle :: String
npTitle = String
title
                              , npArtists :: [String]
npArtists = [String]
artists
                              , npStatus :: String
npStatus = String
status
                              , npBusName :: BusName
npBusName = BusName
busName
                              }
    IO [NowPlaying] -> ExceptT MethodError IO [NowPlaying]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [NowPlaying] -> ExceptT MethodError IO [NowPlaying])
-> IO [NowPlaying] -> ExceptT MethodError IO [NowPlaying]
forall a b. (a -> b) -> a -> b
$ [Maybe NowPlaying] -> [NowPlaying]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe NowPlaying] -> [NowPlaying])
-> IO [Maybe NowPlaying] -> IO [NowPlaying]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe NowPlaying))
-> [String] -> IO [Maybe NowPlaying]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe NowPlaying)
forall p. Coercible p String => p -> IO (Maybe NowPlaying)
getSongData [String]
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variant -> Maybe b
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant
  [String]
artists <- String -> Maybe [String]
forall b. IsVariant b => String -> Maybe b
lookupVariant String
"xesam:artist"
  String
title <- String -> Maybe String
forall b. IsVariant b => String -> Maybe b
lookupVariant String
"xesam:title"
  (String, [String]) -> Maybe (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
title, [String]
artists)