manatee-mplayer 0.0.5 → 0.0.6
raw patch · 6 files changed
+89/−144 lines, 6 filesdep ~manatee-core
Dependency ranges changed: manatee-core
Files
- Daemon.hs +34/−10
- Manatee/Extension/Mplayer/DBus.hs +19/−99
- Manatee/Extension/Mplayer/Daemon.hs +15/−19
- Manatee/Extension/Mplayer/PlaylistBuffer.hs +6/−4
- Manatee/Extension/Mplayer/PlaylistView.hs +11/−10
- manatee-mplayer.cabal +4/−2
Daemon.hs view
@@ -38,16 +38,40 @@ status <- mplayerInitStatus -- Build match rule listen dbus message.- client <- mkSessionClientWithName mplayerDaemonBusName- mkMplayerDaemonMatchRules client - [(Play, mplayerPlay status) - ,(Pause, mplayerPause status)- ,(Stop, mplayerStop status)- ,(Forward, mplayerForward status)- ,(Backward, mplayerBackward status)- ,(VolumeInc, mplayerVolumeInc status)- ,(VolumeDec, mplayerVolumeDec status)- ]+ client <- mkSessionClientWithName (packGenericBusName "mplayer")+ mkGenericDaemonMatchRule + client "mplayer"+ (Generic, \ args@(GenericArgs command options) ->+ case command of+ "Play" -> + parseGenericSignalArgs + args + (\ [pathArg, processIdArg] -> + (pathArg, read processIdArg :: ProcessID))+ (mplayerPlay status)+ "Pause" -> mplayerPause status+ "Stop" -> mplayerStop status+ "Forward" -> + parseGenericSignalArgs+ args+ (\ [step] -> read step :: Int)+ (mplayerForward status)+ "Backward" -> + parseGenericSignalArgs+ args+ (\ [step] -> read step :: Int)+ (mplayerBackward status) + "VolumeInc" -> + parseGenericSignalArgs+ args+ (\ [step] -> read step :: Int)+ (mplayerVolumeInc status)+ "VolumeDec" -> + parseGenericSignalArgs+ args+ (\ [step] -> read step :: Int)+ (mplayerVolumeDec status)+ _ -> putStrLn $ "Invalid command : " ++ command) case args of [] -> putStrLn "PlaylistBuffer should call 'manatee-mplayer-daemon processId', and not 'manatee-mplayer-daemon'."
Manatee/Extension/Mplayer/DBus.hs view
@@ -24,34 +24,18 @@ import DBus.Client hiding (Signal) import DBus.MatchRule import DBus.Message (Signal, signalBody)-import Data.Maybe (fromMaybe)-import Data.Text.Lazy (Text, empty)+import Data.Text.Lazy (empty) import Graphics.UI.Gtk.General.General import Manatee.Core.DBus import Manatee.Core.TH+import Manatee.Core.Types import Manatee.Toolkit.General.DBus+import Manatee.Toolkit.General.Maybe 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)+import qualified Control.Exception as Exc data MplayerClientMember = PlayFinished | DaemonProcessStartup@@ -61,95 +45,26 @@ | DaemonProcessStartupArgs deriving (Show, Eq, Ord) --- | Mplayer daemon bus name.-mplayerDaemonBusName :: Text-mplayerDaemonBusName = "org.manatee.extension.mplayer.daemon"--mplayerDaemonInterfaceName :: Text -mplayerDaemonInterfaceName = "org.manatee.daemon.interface"---- | The daemon path name.-mplayerDaemonPathName :: Text -mplayerDaemonPathName = "/path"---- | Check daemon signal argument.--- Return False if mismatch.-mkFunDec "checkMplayerDaemonSignalArgs" (checkSignalArgs ''MplayerDaemonMember ''MplayerDaemonSignalArgs)---- | Unpack daemon signal from Variant list.--- unpackMplayerDaemonSignalArgs_ :: MplayerDaemonMember -> [Variant] -> Maybe MplayerDaemonSignalArgs -mkFunDec "unpackMplayerDaemonSignalArgs_" (unpackVariantList ''MplayerDaemonMember ''MplayerDaemonSignalArgs)---- | Pack daemon signal argument to Variant list.--- packMplayerDaemonSignalArgs :: MplayerDaemonSignalArgs -> [Variant]-$(packVariantList "packMplayerDaemonSignalArgs" ''MplayerDaemonSignalArgs)- -- | Check client signal argument. -- Return False if mismatch. mkFunDec "checkMplayerClientSignalArgs" (checkSignalArgs ''MplayerClientMember ''MplayerClientSignalArgs) -- | Unpack client signal from Variant list.--- unpackMplayerClientSignalArgs_ :: MplayerClientMember -> [Variant] -> Maybe MplayerClientSignalArgs -mkFunDec "unpackMplayerClientSignalArgs_" (unpackVariantList ''MplayerClientMember ''MplayerClientSignalArgs)+-- unpackMplayerClientSignalArgs :: MplayerClientMember -> [Variant] -> Maybe MplayerClientSignalArgs +mkFunDec "unpackMplayerClientSignalArgs" (unpackVariantList ''MplayerClientMember ''MplayerClientSignalArgs) -- | Pack client signal argument to Variant list. -- packMplayerClientSignalArgs :: MplayerClientSignalArgs -> [Variant] $(packVariantList "packMplayerClientSignalArgs" ''MplayerClientSignalArgs) --- | Build daemon signal.--- If signal argument not match daemon member name.-mkMplayerDaemonSignal :: Client -> MplayerDaemonMember -> MplayerDaemonSignalArgs -> IO ()-mkMplayerDaemonSignal client memberName args - | checkMplayerDaemonSignalArgs memberName args -- check signal argument before emit signal.- = 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)---- | Build daemon match rule.-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- []---- | Build daemon match rule list.-mkMplayerDaemonMatchRules :: Client -> [(MplayerDaemonMember, MplayerDaemonSignalArgs -> IO ())] -> IO () -mkMplayerDaemonMatchRules client = mapM_ (mkMplayerDaemonMatchRule client)---- | Pick MplayerDaemonSignalArgs.-pickMplayerDaemonSignalArgs :: MplayerDaemonMember -> Signal -> MplayerDaemonSignalArgs -pickMplayerDaemonSignalArgs member signal = unpackMplayerDaemonSignalArgs member $ signalBody signal---- | Unpack daemon signal from Variant list.--- Report error if mismatch.-unpackMplayerDaemonSignalArgs member args = - fromMaybe - (error $ "unpackMplayerDaemonSignalArgs: Miss pattern for " ++ show member)- (unpackMplayerDaemonSignalArgs_ member args)- -- | Pick MplayerClientSignalArgs.-pickMplayerClientSignalArgs :: MplayerClientMember -> Signal -> MplayerClientSignalArgs -pickMplayerClientSignalArgs member signal = unpackMplayerClientSignalArgs member $ signalBody signal---- | Unpack client signal from Variant list.--- Report error if mismatch.-unpackMplayerClientSignalArgs member args = - fromMaybe - (error $ "unpackMplayerClientSignalArgs: Miss pattern for " ++ show member)- (unpackMplayerClientSignalArgs_ member args)+pickMplayerClientSignalArgs :: MplayerClientMember -> Signal -> IO (Maybe MplayerClientSignalArgs) +pickMplayerClientSignalArgs member signal = + Exc.catch+ (return $ unpackMplayerClientSignalArgs member $ signalBody signal)+ (\ (_ :: Exc.SomeException) -> + printDBusMessageError "pickMplayerClientSignalArgs" (show member)+ >> return Nothing) -- | Build render signal. -- If signal argument not match render member name.@@ -180,4 +95,9 @@ [] -- Use postGUIAsync wrap DBus action to protect gtk+ main thread. onSignal client matchRule $ \_ signal -> - postGUIAsync $ fun $ pickMplayerClientSignalArgs member signal+ pickMplayerClientSignalArgs member signal >?>= (postGUIAsync . fun)++-- | Build daemon signal.+mkMplayerDaemonSignal :: Client -> String -> [String] -> IO ()+mkMplayerDaemonSignal client command options = + mkGenericDaemonSignal client "mplayer" Generic (GenericArgs command options)
Manatee/Extension/Mplayer/Daemon.hs view
@@ -34,7 +34,6 @@ import System.IO import System.Posix.Types (ProcessID) import System.Process-import Data.ByteString.UTF8 type MplayerHandle = (Handle, Handle, Handle, ProcessHandle) @@ -63,19 +62,17 @@ <*> newTVarIO Nothing -- | Play current select candidate.-mplayerPlay :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()+mplayerPlay :: MplayerStatus -> (String, ProcessID) -> IO () mplayerPlay status@(MplayerStatus {mplayerHandle = handle ,mplayerPlayStatus = playStatus ,mplayerStopByCommand = byCommand ,mplayerProcessId = processId}) - (PlayArgs filepath pid) = do+ (filepath, pid) = do -- Stop play first. mplayerStopInternal status - -- putStrLn $ "### Test : " ++ toString filepath- -- No buffer with handle, transform immediately.- newHandle@(inp, oup, err, ph) <- runInteractiveCommand $ "mplayer -slave \"" ++ toString filepath ++ "\""+ newHandle@(inp, oup, err, ph) <- runInteractiveCommand $ "mplayer -slave \"" ++ filepath ++ "\"" hSetBuffering inp NoBuffering hSetBuffering oup NoBuffering hSetBuffering err NoBuffering@@ -127,9 +124,8 @@ mkMplayerClientSignal client pid PlayFinished PlayFinishedArgs -- | Pause or continue play.-mplayerPause :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()-mplayerPause status@(MplayerStatus {mplayerPlayStatus = playStatus}) - PauseArgs = do+mplayerPause :: MplayerStatus -> IO ()+mplayerPause status@(MplayerStatus {mplayerPlayStatus = playStatus}) = do -- Send pause command to mplayer process. mplayerSendCommand status "pause" False @@ -140,9 +136,9 @@ _ -> PlayStatus) -- | Stop play.-mplayerStop :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()+mplayerStop :: MplayerStatus -> IO () mplayerStop status@(MplayerStatus {mplayerHandle = handle - ,mplayerPlayStatus = playStatus}) StopArgs = do+ ,mplayerPlayStatus = playStatus}) = do -- Stop mplayer process. mplayerStopInternal status @@ -167,23 +163,23 @@ whenM (mplayerProcessIsActivated handle) $ hPutStrLn inp "quit" -- | Forward current track.-mplayerForward :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()-mplayerForward status (ForwardArgs step) = +mplayerForward :: MplayerStatus -> Int -> IO ()+mplayerForward status step = mplayerSendCommand status ("seek " ++ show step) True -- | Backward current track.-mplayerBackward :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()-mplayerBackward status (BackwardArgs step) = +mplayerBackward :: MplayerStatus -> Int -> IO ()+mplayerBackward status step = mplayerSendCommand status ("seek -" ++ show step) True -- | Increase volume.-mplayerVolumeInc :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()-mplayerVolumeInc status (VolumeIncArgs step) = +mplayerVolumeInc :: MplayerStatus -> Int -> IO ()+mplayerVolumeInc status step = mplayerSendCommand status ("volume " ++ show step) True -- | Decrease volume.-mplayerVolumeDec :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()-mplayerVolumeDec status (VolumeDecArgs step) = +mplayerVolumeDec :: MplayerStatus -> Int -> IO ()+mplayerVolumeDec status step = mplayerSendCommand status ("volume -" ++ show step) True -- | Check whether mplayer process is activated.
Manatee/Extension/Mplayer/PlaylistBuffer.hs view
@@ -16,6 +16,7 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} module Manatee.Extension.Mplayer.PlaylistBuffer where @@ -31,6 +32,7 @@ import Data.Typeable import Graphics.UI.Gtk.General.Enums import Graphics.UI.Gtk.ModelView.TreeSortable+import Manatee.Core.DBus import Manatee.Core.Types import Manatee.Extension.Mplayer.PageMode import Manatee.Extension.Mplayer.DBus@@ -165,9 +167,9 @@ -- Play first music ... sweet ... :) let sendPlaySignal = unless (null infos) $ do- let filepath = miFilePath $ head infos - processId <- getProcessID- mkMplayerDaemonSignal client Play (PlayArgs filepath processId)+ let filepath = toString $ miFilePath $ head infos + processId <- fmap show getProcessID+ mkMplayerDaemonSignal client "Play" [filepath, processId] -- Build DBus match rule. mkMplayerClientMatchRule client@@ -175,7 +177,7 @@ \ DaemonProcessStartupArgs -> sendPlaySignal) -- Check whether daemon process has startup.- ifM (isBusNameExist mplayerDaemonBusName) + ifM (isBusNameExist $ packGenericBusName "mplayer") -- Send play signal if daemon process has startup. sendPlaySignal -- Otherwise startup daemon process, send join signal after daemon process startup complete.
Manatee/Extension/Mplayer/PlaylistView.hs view
@@ -23,6 +23,7 @@ import Control.Applicative import Control.Concurrent.STM import Control.Monad+import Data.ByteString.UTF8 import Data.Map (Map) import Data.Text.Lazy (Text) import Data.Typeable@@ -403,8 +404,8 @@ playlistViewPlayInternal :: PlaylistView -> TreePath -> IO () playlistViewPlayInternal view path = do -- Get file path and update play path status.- filePath <- liftM miFilePath $ listStoreGetValue (playlistViewListStore view) (head path)- let displayPath = filepathGetDisplayName filePath+ filepath <- liftM miFilePath $ listStoreGetValue (playlistViewListStore view) (head path)+ let displayPath = filepathGetDisplayName filepath writeTVarIO (playlistViewCurrentPlayPath view) path -- Update play mode status.@@ -415,38 +416,38 @@ pageViewUpdateInfoStatus view "Playing" (" Playing : " ++ displayPath) -- Send daemon signal to play.- processId <- getProcessID- mkMplayerDaemonSignal (pageViewClient view) Play (PlayArgs filePath processId)+ processId <- fmap show getProcessID+ mkMplayerDaemonSignal (pageViewClient view) "Play" [toString filepath, processId] -- | Stop play. playlistViewStop :: PlaylistView -> IO () playlistViewStop view = - mkMplayerDaemonSignal (pageViewClient view) Stop StopArgs+ mkMplayerDaemonSignal (pageViewClient view) "Stop" [] -- | Pause or continue play. playlistViewPause :: PlaylistView -> IO () playlistViewPause view = - mkMplayerDaemonSignal (pageViewClient view) Pause PauseArgs+ mkMplayerDaemonSignal (pageViewClient view) "Pause" [] -- | Forward current track. playlistViewForward :: PlaylistView -> IO () playlistViewForward view =- mkMplayerDaemonSignal (pageViewClient view) Forward (ForwardArgs 10)+ mkMplayerDaemonSignal (pageViewClient view) "Forward" ["10"] -- | Backward current track. playlistViewBackward :: PlaylistView -> IO () playlistViewBackward view =- mkMplayerDaemonSignal (pageViewClient view) Backward (BackwardArgs 10)+ mkMplayerDaemonSignal (pageViewClient view) "Backward" ["10"] -- | Increase volume. playlistViewVolumeInc :: PlaylistView -> IO () playlistViewVolumeInc view =- mkMplayerDaemonSignal (pageViewClient view) VolumeInc (VolumeIncArgs 10)+ mkMplayerDaemonSignal (pageViewClient view) "VolumeInc" ["10"] -- | Decrease volume. playlistViewVolumeDec :: PlaylistView -> IO () playlistViewVolumeDec view =- mkMplayerDaemonSignal (pageViewClient view) VolumeDec (VolumeDecArgs 10)+ mkMplayerDaemonSignal (pageViewClient view) "VolumeDec" ["10"] -- | Begin. playlistViewScrollToTop :: PlaylistView -> IO ()
manatee-mplayer.cabal view
@@ -1,5 +1,5 @@ name: manatee-mplayer-version: 0.0.5+version: 0.0.6 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE@@ -7,6 +7,8 @@ synopsis: Mplayer client extension for Manatee. description: manatee-mplayer is mplayer client extension for Manatee (Haskell/Gtk+ Integrated Live Environment) .+ Video at (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html>+ . Screenshots at : <http://goo.gl/MkVw> . Manual at : <http://haskell.org/haskellwiki/Manatee>@@ -28,7 +30,7 @@ location: http://patch-tag.com/r/AndyStewart/manatee-mplayer Library- build-depends: base >= 4 && < 5, manatee-core >= 0.0.5, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0,+ build-depends: base >= 4 && < 5, manatee-core >= 0.0.6, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, containers >= 0.3.0.0, gtk-serialized-event >= 0.12.0, gtk >= 0.12.0, text >= 0.7.1.0, bytestring >= 0.9.1.5, libtagc >= 0.12.0, regex-tdfa >= 1.1.2, filepath >= 1.1.0.3, utf8-string >= 0.3.4, time, dbus-core, gio >= 0.12.0,