diff options
Diffstat (limited to 'src/Plugins/Monitors/Mpris.hs')
| -rw-r--r-- | src/Plugins/Monitors/Mpris.hs | 148 |
1 files changed, 0 insertions, 148 deletions
diff --git a/src/Plugins/Monitors/Mpris.hs b/src/Plugins/Monitors/Mpris.hs deleted file mode 100644 index ed76dc9..0000000 --- a/src/Plugins/Monitors/Mpris.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# 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 Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where - --- TODO: listen to signals - -import 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 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 [] == 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 - getStr str = case lookup str md of - Nothing -> "" - Just v -> case variantType v of - TypeString -> fromVar v - TypeInt32 -> 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 - TypeInt64 -> let num = fromVar v in - case str of - "mpris:length" -> formatTime (num `div` 1000000) - _ -> (show::Int64 -> String) num - TypeArray TypeString -> - let x = arrayItems (fromVar v) in - if null x then "" else fromVar (head x) - _ -> "" |