module Manatee.Extension.Mplayer.DBus where
import DBus.Client hiding (Signal)
import DBus.MatchRule
import DBus.Message (Signal, signalBody)
import Data.Maybe (fromMaybe)
import Data.Text.Lazy (Text, empty)
import Graphics.UI.Gtk.General.General
import Manatee.Core.DBus
import Manatee.Core.TH
import Manatee.Toolkit.General.DBus
import Manatee.Toolkit.General.Misc
import System.Posix.Process
import System.Posix.Types (ProcessID)
import Data.ByteString (ByteString)
data MplayerDaemonMember = Play
| Pause
| Stop
| Forward
| Backward
| VolumeInc
| VolumeDec
deriving (Show, Eq, Ord)
data MplayerDaemonSignalArgs = PlayArgs ByteString ProcessID
| PauseArgs
| StopArgs
| ForwardArgs Int
| BackwardArgs Int
| VolumeIncArgs Int
| VolumeDecArgs Int
deriving (Show, Eq, Ord)
data MplayerClientMember = PlayFinished
| DaemonProcessStartup
deriving (Show, Eq, Ord)
data MplayerClientSignalArgs = PlayFinishedArgs
| DaemonProcessStartupArgs
deriving (Show, Eq, Ord)
mplayerDaemonBusName :: Text
mplayerDaemonBusName = "org.manatee.extension.mplayer.daemon"
mplayerDaemonInterfaceName :: Text
mplayerDaemonInterfaceName = "org.manatee.daemon.interface"
mplayerDaemonPathName :: Text
mplayerDaemonPathName = "/path"
mkFunDec "checkMplayerDaemonSignalArgs" (checkSignalArgs ''MplayerDaemonMember ''MplayerDaemonSignalArgs)
mkFunDec "unpackMplayerDaemonSignalArgs_" (unpackVariantList ''MplayerDaemonMember ''MplayerDaemonSignalArgs)
$(packVariantList "packMplayerDaemonSignalArgs" ''MplayerDaemonSignalArgs)
mkFunDec "checkMplayerClientSignalArgs" (checkSignalArgs ''MplayerClientMember ''MplayerClientSignalArgs)
mkFunDec "unpackMplayerClientSignalArgs_" (unpackVariantList ''MplayerClientMember ''MplayerClientSignalArgs)
$(packVariantList "packMplayerClientSignalArgs" ''MplayerClientSignalArgs)
mkMplayerDaemonSignal :: Client -> MplayerDaemonMember -> MplayerDaemonSignalArgs -> IO ()
mkMplayerDaemonSignal client memberName args
| checkMplayerDaemonSignalArgs memberName args
= emitSignal client signal
| otherwise
= putStrLn $ "mkMplayerDaemonSignal CRITICAL: Invalid argument for dbus daemon member: " ++ show memberName
where signal = mkMessageSignal
mplayerDaemonPathName
(showText memberName)
mplayerDaemonInterfaceName
mplayerDaemonBusName
(packMplayerDaemonSignalArgs args)
mkMplayerDaemonMatchRule :: Client -> (MplayerDaemonMember, MplayerDaemonSignalArgs -> IO ()) -> IO ()
mkMplayerDaemonMatchRule client (member, fun) =
onSignal client matchRule $ \_ signal ->
fun $ pickMplayerDaemonSignalArgs member signal
where matchRule = mkMatchRule
(Just Signal)
empty
mplayerDaemonInterfaceName
(showText member)
mplayerDaemonPathName
mplayerDaemonBusName
[]
mkMplayerDaemonMatchRules :: Client -> [(MplayerDaemonMember, MplayerDaemonSignalArgs -> IO ())] -> IO ()
mkMplayerDaemonMatchRules client = mapM_ (mkMplayerDaemonMatchRule client)
pickMplayerDaemonSignalArgs :: MplayerDaemonMember -> Signal -> MplayerDaemonSignalArgs
pickMplayerDaemonSignalArgs member signal = unpackMplayerDaemonSignalArgs member $ signalBody signal
unpackMplayerDaemonSignalArgs member args =
fromMaybe
(error $ "unpackMplayerDaemonSignalArgs: Miss pattern for " ++ show member)
(unpackMplayerDaemonSignalArgs_ member args)
pickMplayerClientSignalArgs :: MplayerClientMember -> Signal -> MplayerClientSignalArgs
pickMplayerClientSignalArgs member signal = unpackMplayerClientSignalArgs member $ signalBody signal
unpackMplayerClientSignalArgs member args =
fromMaybe
(error $ "unpackMplayerClientSignalArgs: Miss pattern for " ++ show member)
(unpackMplayerClientSignalArgs_ member args)
mkMplayerClientSignal :: Client -> ProcessID -> MplayerClientMember -> MplayerClientSignalArgs -> IO ()
mkMplayerClientSignal client processId memberName args
| checkMplayerClientSignalArgs memberName args
= emitSignal client signal
| otherwise
= putStrLn $ "mkMplayerClientSignal CRITICAL: Invalid argument for dbus render member: " ++ show memberName
where signal = mkMessageSignal
renderPathName
(showText memberName)
renderInterfaceName
(mkRenderClientName processId)
(packMplayerClientSignalArgs args)
mkMplayerClientMatchRule :: Client -> (MplayerClientMember, MplayerClientSignalArgs -> IO ()) -> IO ()
mkMplayerClientMatchRule client (member, fun) = do
processId <- getProcessID
let matchRule = mkMatchRule
(Just Signal)
empty
renderInterfaceName
(showText member)
renderPathName
(mkRenderClientName processId)
[]
onSignal client matchRule $ \_ signal ->
postGUIAsync $ fun $ pickMplayerClientSignalArgs member signal