{-# LANGUAGE OverloadedStrings #-}

----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Mpris
-- Copyright   :  (c) Artem Tarasov
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Artem Tarasov <lomereiter@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
--   MPRIS song info
--
----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where

-- TODO: listen to signals

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
""