summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Mpris.hs
blob: ee30ad30765801e2bd1e560e448f213a56f757f1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
{-# 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 )
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 mv c p = fmap methodReturnBody (DC.call_ c $ getMethodCall mv p)
    fieldsList :: a -> [String]

data MprisVersion1 = MprisVersion1
instance MprisVersion MprisVersion1 where
    getMethodCall MprisVersion1 p = (methodCall objectPath interfaceName memberName)
        { methodCallDestination = Just busName
        }
        where
        busName       = busName_     $ "org.mpris." ++ p
        objectPath    = objectPath_    "/Player"
        interfaceName = interfaceName_ "org.freedesktop.MediaPlayer"
        memberName    = memberName_    "GetMetadata"

    fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title"
                               , "tracknumber" ]

data MprisVersion2 = MprisVersion2
instance MprisVersion MprisVersion2 where
    getMethodCall MprisVersion2 p = (methodCall objectPath interfaceName memberName)
        { methodCallDestination = Just busName
        , methodCallBody = arguments
        }
        where
        busName       = busName_     $ "org.mpris.MediaPlayer2." ++ p
        objectPath    = objectPath_    "/org/mpris/MediaPlayer2"
        interfaceName = interfaceName_ "org.freedesktop.DBus.Properties"
        memberName    = memberName_    "Get"
        arguments     = map (toVariant::String -> Variant)
                            ["org.mpris.MediaPlayer2.Player", "Metadata"]

    fieldsList MprisVersion2 = [ "xesam:album", "xesam:artist", "mpris:artUrl"
                               , "mpris:length", "xesam:title",
                                 "xesam:trackNumber", "xesam:composer",
                                 "xesam:genre"
                               ]

mprisConfig :: IO MConfig
mprisConfig = mkMConfig "<artist> - <title>"
                [ "album", "artist", "arturl", "length"
                , "title", "tracknumber" , "composer", "genre"
                ]

{-# NOINLINE dbusClient #-}
dbusClient :: DC.Client
dbusClient = unsafePerformIO DC.connectSession

runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String
runMPRIS version playerName _ = do
    metadata <- io $ getMetadata version dbusClient playerName
    if null metadata then
      getConfigValue naString
      else mapM showWithPadding (makeList version metadata) >>= parseTemplate

runMPRIS1 :: String -> [String] -> Monitor String
runMPRIS1 = runMPRIS MprisVersion1

runMPRIS2 :: String -> [String] -> Monitor String
runMPRIS2 = runMPRIS MprisVersion2

---------------------------------------------------------------------------

fromVar :: (IsVariant a) => Variant -> a
fromVar = fromJust . fromVariant

unpackMetadata :: [Variant] -> [(String, Variant)]
unpackMetadata [] = []
unpackMetadata xs =
  (map (fromVar *** fromVar) . unpack . head) xs where
    unpack v = case variantType v of
                 TypeDictionary _ _ -> dictionaryItems $ fromVar v
                 TypeVariant -> unpack $ fromVar v
                 TypeStructure _ ->
                   let x = structureItems (fromVar v) in
                     if null x then [] else unpack (head x)
                 _ -> []

getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)]
getMetadata version client player = do
    reply <- try (getMetadataReply version client player) ::
                            IO (Either DC.ClientError [Variant])
    return $ case reply of
                  Right metadata -> unpackMetadata metadata;
                  Left _ -> []

makeList :: (MprisVersion a) => a -> [(String, Variant)] -> [String]
makeList version md = map getStr (fieldsList version) where
            formatTime n = (if hh == 0 then printf "%02d:%02d"
                                       else printf "%d:%02d:%02d" hh) mm ss
                           where hh = (n `div` 60) `div` 60
                                 mm = (n `div` 60) `mod` 60
                                 ss = n `mod` 60
            pInt str v = let num = fromVar v in
                           case str of
                             "mtime" -> formatTime (num `div` 1000)
                             "tracknumber" -> printf "%02d" num
                             "mpris:length" -> formatTime (num `div` 1000000)
                             "xesam:trackNumber" -> printf "%02d" num
                             _ -> (show::Int32 -> String) num
            pw32 v = printf "%02d" (fromVar v::Word32)
            plen str v = let num = fromVar v in
                           case str of
                             "mpris:length" -> formatTime (num `div` 1000000)
                             _ -> (show::Int64 -> String) num
            getStr str = case lookup str md of
                Nothing -> ""
                Just v -> case variantType v of
                            TypeString -> fromVar v
                            TypeInt32 -> pInt str v
                            TypeWord32 -> pw32 v
                            TypeInt64 -> plen str v
                            TypeArray TypeString ->
                              let x = arrayItems (fromVar v) in
                                if null x then "" else fromVar (head x)
                            _ -> ""