diff options
Diffstat (limited to 'src/Plugins/Monitors/Volume.hs')
| -rw-r--r-- | src/Plugins/Monitors/Volume.hs | 121 |
1 files changed, 10 insertions, 111 deletions
diff --git a/src/Plugins/Monitors/Volume.hs b/src/Plugins/Monitors/Volume.hs index 4974e5b..5702137 100644 --- a/src/Plugins/Monitors/Volume.hs +++ b/src/Plugins/Monitors/Volume.hs @@ -13,29 +13,21 @@ ----------------------------------------------------------------------------- module Plugins.Monitors.Volume - ( startVolume - , runVolume + ( runVolume + , runVolumeWith , volumeConfig - , getMonitorWaiter - , parseOptsIncludingMonitorArgs - , VolumeOpts(refreshMode) - , RefreshMode(..) + , options + , defaultOpts + , VolumeOpts ) where -import Commands (tenthSeconds) import Control.Applicative ((<$>)) -import Control.Concurrent -import Control.Exception -import Control.Monad ( forever, liftM2, liftM3, mplus, void, when, unless ) +import Control.Monad ( liftM2, liftM3, mplus ) import Data.Traversable (sequenceA) import Plugins.Monitors.Common import Sound.ALSA.Mixer import qualified Sound.ALSA.Exception as AE import System.Console.GetOpt -import System.Directory -import System.Exit -import System.IO -import System.Process volumeConfig :: IO MConfig volumeConfig = mkMConfig "Vol: <volume>% <status>" @@ -50,13 +42,8 @@ data VolumeOpts = VolumeOpts , highDbThresh :: Float , lowDbThresh :: Float , volumeIconPattern :: Maybe IconPattern - , refreshMode :: RefreshMode } -data RefreshMode = RefreshModePoll - | RefreshModeMonitor (Maybe FilePath) -- alsactl path - deriving(Eq,Show) - defaultOpts :: VolumeOpts defaultOpts = VolumeOpts { onString = "[on] " @@ -66,12 +53,8 @@ defaultOpts = VolumeOpts , highDbThresh = -5.0 , lowDbThresh = -30.0 , volumeIconPattern = Nothing - , refreshMode = RefreshModePoll } -monitorOptionName :: String -monitorOptionName = "monitor" - options :: [OptDescr (VolumeOpts -> VolumeOpts)] options = [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" @@ -82,8 +65,6 @@ options = , Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") "" , Option "" ["volume-icon-pattern"] (ReqArg (\x o -> o { volumeIconPattern = Just $ parseIconPattern x }) "") "" - , Option "" [monitorOptionName] (OptArg (\x o -> - o { refreshMode = RefreshModeMonitor x }) "") "" ] parseOpts :: [String] -> IO VolumeOpts @@ -148,6 +129,10 @@ formatDb opts dbi = do runVolume :: String -> String -> [String] -> Monitor String runVolume mixerName controlName argv = do opts <- io $ parseOpts argv + runVolumeWith opts mixerName controlName + +runVolumeWith :: VolumeOpts -> String -> String -> Monitor String +runVolumeWith opts mixerName controlName = do (lo, hi, val, db, sw) <- io readMixer p <- liftMonitor $ liftM3 formatVol lo hi val b <- liftMonitor $ liftM3 formatVolBar lo hi val @@ -209,89 +194,3 @@ runVolume mixerName controlName argv = do getFormatSwitch opts (Just sw) = formatSwitch opts sw unavailable = getConfigValue naString - -parseOptsIncludingMonitorArgs :: [String] -> IO VolumeOpts -parseOptsIncludingMonitorArgs args = - -- Drop generic Monitor args first - case getOpt Permute [] args of - (_, args', _) -> parseOpts args' - -startVolume :: String -> String -> [String] -> Int -> (String -> IO ()) -> IO () -startVolume mixerName controlName args rate cb = do - opts <- parseOptsIncludingMonitorArgs args - - waitFunction <- - case refreshMode opts of - RefreshModePoll -> pure $ tenthSeconds rate - RefreshModeMonitor alsaCtlPath -> getMonitorWaiter mixerName alsaCtlPath - - runMB args volumeConfig (runVolume mixerName controlName) waitFunction cb - - -getMonitorWaiter :: String -> Maybe FilePath -> IO (IO ()) -getMonitorWaiter mixerName alsaCtlPath = do - mvar <- newMVar Nothing :: IO (MVar (Maybe SomeException)) - - forkFinally (readerThread mvar) (putMVar mvar . either Just (const Nothing)) - - pure $ do - ei <- takeMVar mvar - case ei of - -- Propagate exceptions from reader thread - Just (SomeException ex) -> throwIO ex - Nothing -> pure () - - where - - readerThread mvar = do - path <- determineAlsaCtlPath - withCreateProcess - (proc "stdbuf" ["-oL", path, "monitor", mixerName]) {std_out = CreatePipe} - run - - where - - defaultPath = "/usr/sbin/alsactl" - - determineAlsaCtlPath = - case alsaCtlPath of - Just path -> do - found <- doesFileExist path - if found - then pure path - else throwIO . ErrorCall $ - "Specified alsactl file " ++ path ++ " does not exist" - - Nothing -> do - (ec, path, err) <- readProcessWithExitCode "which" ["alsactl"] "" - unless (null err) $ hPutStrLn stderr err - case ec of - ExitSuccess -> pure $ trimTrailingNewline path - ExitFailure _ -> do - found <- doesFileExist defaultPath - if found - then pure defaultPath - else throwIO . ErrorCall $ - "alsactl not found in PATH or at " ++ - show defaultPath ++ - "; please specify with --" ++ - monitorOptionName ++ "=/path/to/alsactl" - - - run _ ~(Just out) _ _ = do - hSetBuffering out LineBuffering - forever $ do - c <- hGetChar out - when (c == '\n') $ - -- This uses 'tryPutMVar' because 'putMVar' would make 'runVolume' run - -- once for each event. But we want it to run only once after a burst - -- of events. - void $ tryPutMVar mvar Nothing - --- This is necessarily very inefficient on 'String's -trimTrailingNewline :: String -> String -trimTrailingNewline x = - case reverse x of - '\n' : '\r' : y -> reverse y - '\n' : y -> reverse y - _ -> x |