mute-unmute 0.1.1 → 0.2.0.0
raw patch · 2 files changed
+52/−20 lines, 2 filesdep +hsloggerdep +hslogger-templatedep +mtldep −monads-fd
Dependencies added: hslogger, hslogger-template, mtl
Dependencies removed: monads-fd
Files
- mute-unmute.cabal +13/−4
- mute-unmute.hs +39/−16
mute-unmute.cabal view
@@ -1,7 +1,9 @@ Name: mute-unmute-Version: 0.1.1+Version: 0.2.0.0 Synopsis: Watches your screensaver and (un)mutes music when you (un)lock the screen.-Description: This simple program will watch for the activation of screensaver (in Gnome) via it's DBus API. It's quite straitforward and extending it for KDE etc. should be simple. It also depends on ALSA (usage of alsactl command), but this should also be simple to fix if needed. It could also serve as a base for more complex programs that use DBus.+Description: This simple program will watch for the activation of screensaver in via it's DBus API. Current version works for Gnome (tested on: 2.30.0) and KDE (tested on: 4.5.0). Additionally it will only work for ALSA (usage of alsactl command), but this be simple to fix if needed.++ It could also serve as an example of simple program that works with DBus in Haskell. License: GPL-3 License-file: LICENSE Author: Krzysztof Skrzętnicki@@ -9,11 +11,18 @@ Category: System Build-type: Simple Cabal-version: >=1.6+Homepage: http://github.com/Tener/mute-unmute Executable mute-unmute Main-is: mute-unmute.hs Build-depends: base >= 4 && < 5, process == 1.0.1.*,- monads-fd == 0.1.0.*,+ mtl == 1.1.0.*, network-dbus == 0.0, filepath == 1.1.0.*,- directory == 1.0.1.*+ directory == 1.0.1.*,+ hslogger == 1.1.0,+ hslogger-template == 1.1.0++source-repository head+ type: git+ location: git://github.com/Tener/mute-unmute.git
mute-unmute.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, ViewPatterns #-}+{-# LANGUAGE OverloadedStrings, ViewPatterns, TemplateHaskell #-} module Main where @@ -23,6 +23,12 @@ import Data.String +import System.Log.Logger.TH+import qualified System.Log.Logger as HSL++deriveNamedLoggers "mute-unmute" "HSL" [HSL.DEBUG, HSL.INFO, HSL.ERROR, HSL.WARNING]+-- deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO, HSL.ERROR, HSL.WARNING]+ instance IsString DString where fromString str = runIdentity (mkDString str) @@ -87,16 +93,17 @@ -- | message handling handleMessage :: Message -> ConfigM ()-handleMessage msg@(mBody -> [var]) = case fromVariant var of- Nothing -> liftIO (putStrLn "Something went wrong, bad type:" >> print msg)+handleMessage msg@(mBody -> [var]) = debugM (show msg) >>+ case fromVariant var of+ Nothing -> errorM ("Something went wrong, bad type:" ++ show msg) Just True -> handleLock Just False -> handleUnlock -handleMessage msg = liftIO (putStrLn "Something went wrong, wrong number of elements in mBody:" >> print msg)+handleMessage msg = errorM ("Wrong number of elements in mBody: " ++ show msg) handleLock, handleUnlock :: ConfigM ()-handleLock = alsactl "restore" . mute =<< ask-handleUnlock = alsactl "restore" . unmute =<< ask+handleLock = ask >>= alsactl "restore" . mute >> infoM "Lock screen"+handleUnlock = ask >>= alsactl "restore" . unmute >> infoM "Unlock screen" storeMute, storeUnmute :: ConfigM () storeUnmute = alsactl "store" . unmute =<< ask@@ -116,7 +123,7 @@ app <- appPath <$> ask appExist <- liftIO $ doesDirectoryExist app when (not appExist) . liftIO $ do- putStrLn "Creating config directory..."+ infoM "Creating config directory..." createDirectory app checkConfig :: ConfigM ()@@ -126,31 +133,46 @@ mu <- mute <$> ask muExist <- liftIO $ doesFileExist mu when (not muExist) $ do- liftIO $ putStrLn "Mute config is missing..."+ infoM "Mute config is missing..." askMute un <- unmute <$> ask unExist <- liftIO $ doesFileExist un when (not unExist) $ do- liftIO $ putStrLn "Unmute config is missing..."+ infoM "Unmute config is missing..." askUnmute daemon :: ConfigM () daemon = do checkConfig- path <- mkObjectPath "/org/gnome/ScreenSaver"- let clauses = [ MatchType Signal++ -- Gnome+ pathG <- mkObjectPath "/org/gnome/ScreenSaver"+ let clausesG = [ MatchType Signal , MatchInterface "org.gnome.ScreenSaver" , MatchMember "ActiveChanged"- , MatchPath path]+ , MatchPath pathG] + -- KDE+ pathK <- mkObjectPath "/ScreenSaver"+ let clausesK = [ MatchType Signal+ , MatchInterface "org.freedesktop.ScreenSaver"+ , MatchMember "ActiveChanged"+ , MatchPath pathK]+++ session <- fromJust <$> liftIO getSessionBusAddress+ debugM ("Session: " ++ show session)+ conn <- liftIO $ connectToBus session+ debugM "Connected"+ conf <- ask- liftIO $ do- session <- fromJust <$> getSessionBusAddress- conn <- connectToBus session+ liftIO $ forM_ [clausesG, clausesK] $ \ clauses -> do addHandler conn (Just $ clauses) (\m -> runReaderT (handleMessage m) conf)- forever (threadDelay (10^6))+ debugM ("Handler added: " ++ show clauses) + liftIO $ forever (threadDelay (10^6))+ programOpt :: [OptDescr RunMode] programOpt = [ Option [] ["store"] (NoArg StoreAll) "ask for mute and unmute configurations" , Option [] ["store-mute"] (NoArg StoreMute) "ask for mute configuration"@@ -168,6 +190,7 @@ main :: IO () main = do+ HSL.updateGlobalLogger programName (HSL.setLevel HSL.DEBUG) applicationPath <- getAppUserDataDirectory programName m <- parseOptions =<< getArgs