{-# LANGUAGE OverloadedStrings #-}
module Xmobar.Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where
import Xmobar.Plugins.Monitors.Common
import Text.Printf (printf)
import DBus
import qualified DBus.Client as DC
import Control.Arrow ((***))
import Data.Maybe ( fromJust )
import Data.Int ( Int32, Int64 )
import Data.Word ( Word32, Word64 )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Exception (try)
class MprisVersion a where
getMethodCall :: a -> String -> MethodCall
getMetadataReply :: a -> DC.Client -> String -> IO [Variant]
getMetadataReply a
mv Client
c String
p = (MethodReturn -> [Variant]) -> IO MethodReturn -> IO [Variant]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MethodReturn -> [Variant]
methodReturnBody (Client -> MethodCall -> IO MethodReturn
DC.call_ Client
c (MethodCall -> IO MethodReturn) -> MethodCall -> IO MethodReturn
forall a b. (a -> b) -> a -> b
$ a -> String -> MethodCall
forall a. MprisVersion a => a -> String -> MethodCall
getMethodCall a
mv String
p)
fieldsList :: a -> [String]
data MprisVersion1 = MprisVersion1
instance MprisVersion MprisVersion1 where
getMethodCall :: MprisVersion1 -> String -> MethodCall
getMethodCall MprisVersion1
MprisVersion1 String
p = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
objectPath InterfaceName
interfaceName MemberName
memberName)
{ methodCallDestination = Just busName
}
where
busName :: BusName
busName = String -> BusName
busName_ (String -> BusName) -> String -> BusName
forall a b. (a -> b) -> a -> b
$ String
"org.mpris." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p
objectPath :: ObjectPath
objectPath = String -> ObjectPath
objectPath_ String
"/Player"
interfaceName :: InterfaceName
interfaceName = String -> InterfaceName
interfaceName_ String
"org.freedesktop.MediaPlayer"
memberName :: MemberName
memberName = String -> MemberName
memberName_ String
"GetMetadata"
fieldsList :: MprisVersion1 -> [String]
fieldsList MprisVersion1
MprisVersion1 = [ String
"album", String
"artist", String
"arturl", String
"mtime", String
"title"
, String
"tracknumber" ]
data MprisVersion2 = MprisVersion2
instance MprisVersion MprisVersion2 where
getMethodCall :: MprisVersion2 -> String -> MethodCall
getMethodCall MprisVersion2
MprisVersion2 String
p = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
objectPath InterfaceName
interfaceName MemberName
memberName)
{ methodCallDestination = Just busName
, methodCallBody = arguments
}
where
busName :: BusName
busName = String -> BusName
busName_ (String -> BusName) -> String -> BusName
forall a b. (a -> b) -> a -> b
$ String
"org.mpris.MediaPlayer2." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p
objectPath :: ObjectPath
objectPath = String -> ObjectPath
objectPath_ String
"/org/mpris/MediaPlayer2"
interfaceName :: InterfaceName
interfaceName = String -> InterfaceName
interfaceName_ String
"org.freedesktop.DBus.Properties"
memberName :: MemberName
memberName = String -> MemberName
memberName_ String
"Get"
arguments :: [Variant]
arguments = (String -> Variant) -> [String] -> [Variant]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Variant
forall a. IsVariant a => a -> Variant
toVariant::String -> Variant)
[String
"org.mpris.MediaPlayer2.Player", String
"Metadata"]
fieldsList :: MprisVersion2 -> [String]
fieldsList MprisVersion2
MprisVersion2 = [ String
"xesam:album", String
"xesam:artist", String
"mpris:artUrl"
, String
"mpris:length", String
"xesam:title",
String
"xesam:trackNumber", String
"xesam:composer",
String
"xesam:genre"
]
mprisConfig :: IO MConfig
mprisConfig :: IO MConfig
mprisConfig = String -> [String] -> IO MConfig
mkMConfig String
"<artist> - <title>"
[ String
"album", String
"artist", String
"arturl", String
"length"
, String
"title", String
"tracknumber" , String
"composer", String
"genre"
]
{-# NOINLINE dbusClient #-}
dbusClient :: DC.Client
dbusClient :: Client
dbusClient = IO Client -> Client
forall a. IO a -> a
unsafePerformIO IO Client
DC.connectSession
runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String
runMPRIS :: forall a.
MprisVersion a =>
a -> String -> [String] -> Monitor String
runMPRIS a
version String
playerName [String]
_ = do
metadata <- IO [(String, Variant)] -> Monitor [(String, Variant)]
forall a. IO a -> Monitor a
io (IO [(String, Variant)] -> Monitor [(String, Variant)])
-> IO [(String, Variant)] -> Monitor [(String, Variant)]
forall a b. (a -> b) -> a -> b
$ a -> Client -> String -> IO [(String, Variant)]
forall a.
MprisVersion a =>
a -> Client -> String -> IO [(String, Variant)]
getMetadata a
version Client
dbusClient String
playerName
if null metadata then
getConfigValue naString
else mapM showWithPadding (makeList version metadata) >>= parseTemplate
runMPRIS1 :: String -> [String] -> Monitor String
runMPRIS1 :: String -> [String] -> Monitor String
runMPRIS1 = MprisVersion1 -> String -> [String] -> Monitor String
forall a.
MprisVersion a =>
a -> String -> [String] -> Monitor String
runMPRIS MprisVersion1
MprisVersion1
runMPRIS2 :: String -> [String] -> Monitor String
runMPRIS2 :: String -> [String] -> Monitor String
runMPRIS2 = MprisVersion2 -> String -> [String] -> Monitor String
forall a.
MprisVersion a =>
a -> String -> [String] -> Monitor String
runMPRIS MprisVersion2
MprisVersion2
fromVar :: (IsVariant a) => Variant -> a
fromVar :: forall a. IsVariant a => Variant -> a
fromVar = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Variant -> Maybe a) -> Variant -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe a
forall a. IsVariant a => Variant -> Maybe a
fromVariant
unpackMetadata :: [Variant] -> [(String, Variant)]
unpackMetadata :: [Variant] -> [(String, Variant)]
unpackMetadata [] = []
unpackMetadata [Variant]
xs =
(((Variant, Variant) -> (String, Variant))
-> [(Variant, Variant)] -> [(String, Variant)]
forall a b. (a -> b) -> [a] -> [b]
map (Variant -> String
forall a. IsVariant a => Variant -> a
fromVar (Variant -> String)
-> (Variant -> Variant) -> (Variant, Variant) -> (String, Variant)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Variant -> Variant
forall a. IsVariant a => Variant -> a
fromVar) ([(Variant, Variant)] -> [(String, Variant)])
-> ([Variant] -> [(Variant, Variant)])
-> [Variant]
-> [(String, Variant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> [(Variant, Variant)]
unpack (Variant -> [(Variant, Variant)])
-> ([Variant] -> Variant) -> [Variant] -> [(Variant, Variant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Variant] -> Variant
forall a. HasCallStack => [a] -> a
head) [Variant]
xs where
unpack :: Variant -> [(Variant, Variant)]
unpack Variant
v = case Variant -> Type
variantType Variant
v of
TypeDictionary Type
_ Type
_ -> Dictionary -> [(Variant, Variant)]
dictionaryItems (Dictionary -> [(Variant, Variant)])
-> Dictionary -> [(Variant, Variant)]
forall a b. (a -> b) -> a -> b
$ Variant -> Dictionary
forall a. IsVariant a => Variant -> a
fromVar Variant
v
Type
TypeVariant -> Variant -> [(Variant, Variant)]
unpack (Variant -> [(Variant, Variant)])
-> Variant -> [(Variant, Variant)]
forall a b. (a -> b) -> a -> b
$ Variant -> Variant
forall a. IsVariant a => Variant -> a
fromVar Variant
v
TypeStructure [Type]
_ ->
let x :: [Variant]
x = Structure -> [Variant]
structureItems (Variant -> Structure
forall a. IsVariant a => Variant -> a
fromVar Variant
v) in
if [Variant] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Variant]
x then [] else Variant -> [(Variant, Variant)]
unpack ([Variant] -> Variant
forall a. HasCallStack => [a] -> a
head [Variant]
x)
Type
_ -> []
getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)]
getMetadata :: forall a.
MprisVersion a =>
a -> Client -> String -> IO [(String, Variant)]
getMetadata a
version Client
client String
player = do
reply <- IO [Variant] -> IO (Either ClientError [Variant])
forall e a. Exception e => IO a -> IO (Either e a)
try (a -> Client -> String -> IO [Variant]
forall a. MprisVersion a => a -> Client -> String -> IO [Variant]
getMetadataReply a
version Client
client String
player) ::
IO (Either DC.ClientError [Variant])
return $ case reply of
Right [Variant]
metadata -> [Variant] -> [(String, Variant)]
unpackMetadata [Variant]
metadata;
Left ClientError
_ -> []
makeList :: (MprisVersion a) => a -> [(String, Variant)] -> [String]
makeList :: forall a. MprisVersion a => a -> [(String, Variant)] -> [String]
makeList a
version [(String, Variant)]
md = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
getStr (a -> [String]
forall a. MprisVersion a => a -> [String]
fieldsList a
version) where
formatTime :: t -> t
formatTime t
n = (if t
hh t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then String -> t -> t -> t
forall r. PrintfType r => String -> r
printf String
"%02d:%02d"
else String -> t -> t -> t -> t
forall r. PrintfType r => String -> r
printf String
"%d:%02d:%02d" t
hh) t
mm t
ss
where hh :: t
hh = (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
60) t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
60
mm :: t
mm = (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
60) t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
60
ss :: t
ss = t
n t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
60
pInt :: a -> Variant -> String
pInt a
str Variant
v = let num :: Int32
num = Variant -> Int32
forall a. IsVariant a => Variant -> a
fromVar Variant
v in
case a
str of
a
"mtime" -> Int32 -> String
forall {t} {t}. (PrintfArg t, PrintfType t, Integral t) => t -> t
formatTime (Int32
num Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` Int32
1000)
a
"tracknumber" -> String -> Int32 -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int32
num
a
"mpris:length" -> Int32 -> String
forall {t} {t}. (PrintfArg t, PrintfType t, Integral t) => t -> t
formatTime (Int32
num Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` Int32
1000000)
a
"xesam:trackNumber" -> String -> Int32 -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int32
num
a
_ -> (Int32 -> String
forall a. Show a => a -> String
show::Int32 -> String) Int32
num
pw32 :: Variant -> t
pw32 Variant
v = String -> Word32 -> t
forall r. PrintfType r => String -> r
printf String
"%02d" (Variant -> Word32
forall a. IsVariant a => Variant -> a
fromVar Variant
v::Word32)
plen :: a -> a -> String
plen a
str a
num = case a
str of
a
"mpris:length" -> a -> String
forall {t} {t}. (PrintfArg t, PrintfType t, Integral t) => t -> t
formatTime (a
num a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1000000)
a
_ -> a -> String
forall a. Show a => a -> String
show a
num
getStr :: String -> String
getStr String
str = case String -> [(String, Variant)] -> Maybe Variant
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
str [(String, Variant)]
md of
Maybe Variant
Nothing -> String
""
Just Variant
v -> case Variant -> Type
variantType Variant
v of
Type
TypeString -> Variant -> String
forall a. IsVariant a => Variant -> a
fromVar Variant
v
Type
TypeInt32 -> String -> Variant -> String
forall {a}. (Eq a, IsString a) => a -> Variant -> String
pInt String
str Variant
v
Type
TypeWord32 -> Variant -> String
forall {t}. PrintfType t => Variant -> t
pw32 Variant
v
Type
TypeWord64 -> String -> Word64 -> String
forall {a} {a}.
(IsString a, PrintfArg a, Integral a, Show a, Eq a) =>
a -> a -> String
plen String
str (Variant -> Word64
forall a. IsVariant a => Variant -> a
fromVar Variant
v :: Word64)
Type
TypeInt64 -> String -> Int64 -> String
forall {a} {a}.
(IsString a, PrintfArg a, Integral a, Show a, Eq a) =>
a -> a -> String
plen String
str (Variant -> Int64
forall a. IsVariant a => Variant -> a
fromVar Variant
v :: Int64)
TypeArray Type
TypeString ->
let x :: [Variant]
x = Array -> [Variant]
arrayItems (Variant -> Array
forall a. IsVariant a => Variant -> a
fromVar Variant
v) in
if [Variant] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Variant]
x then String
"" else Variant -> String
forall a. IsVariant a => Variant -> a
fromVar ([Variant] -> Variant
forall a. HasCallStack => [a] -> a
head [Variant]
x)
Type
_ -> String
""