diff options
Diffstat (limited to 'src/Plugins/Monitors')
-rw-r--r-- | src/Plugins/Monitors/Alsa.hs | 147 |
1 files changed, 0 insertions, 147 deletions
diff --git a/src/Plugins/Monitors/Alsa.hs b/src/Plugins/Monitors/Alsa.hs deleted file mode 100644 index 729042c..0000000 --- a/src/Plugins/Monitors/Alsa.hs +++ /dev/null @@ -1,147 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Alsa --- Copyright : (c) 2018 Daniel Schüssler --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- Event-based variant of the Volume plugin. --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Alsa - ( startAlsaPlugin - , withMonitorWaiter - , parseOptsIncludingMonitorArgs - , AlsaOpts(aoAlsaCtlPath) - ) where - -import Control.Concurrent -import Control.Concurrent.Async -import Control.Exception -import Control.Monad -import Plugins.Monitors.Common -import Plugins.Monitors.Volume(volumeConfig, VolumeOpts, runVolumeWith) -import qualified Plugins.Monitors.Volume as Volume; -import System.Console.GetOpt -import System.Directory -import System.Exit -import System.IO -import System.Process - -data AlsaOpts = AlsaOpts - { aoVolumeOpts :: VolumeOpts - , aoAlsaCtlPath :: Maybe FilePath - } - -defaultOpts :: AlsaOpts -defaultOpts = AlsaOpts Volume.defaultOpts Nothing - -alsaCtlOptionName :: String -alsaCtlOptionName = "alsactl" - -options :: [OptDescr (AlsaOpts -> AlsaOpts)] -options = - Option "" [alsaCtlOptionName] (ReqArg (\x o -> - o { aoAlsaCtlPath = Just x }) "") "" - : fmap (fmap modifyVolumeOpts) Volume.options - where - modifyVolumeOpts f o = o { aoVolumeOpts = f (aoVolumeOpts o) } - -parseOpts :: [String] -> IO AlsaOpts -parseOpts argv = - case getOpt Permute options argv of - (o, _, []) -> return $ foldr id defaultOpts o - (_, _, errs) -> ioError . userError $ concat errs - -parseOptsIncludingMonitorArgs :: [String] -> IO AlsaOpts -parseOptsIncludingMonitorArgs args = - -- Drop generic Monitor args first - case getOpt Permute [] args of - (_, args', _) -> parseOpts args' - -startAlsaPlugin :: String -> String -> [String] -> (String -> IO ()) -> IO () -startAlsaPlugin mixerName controlName args cb = do - opts <- parseOptsIncludingMonitorArgs args - - let run args2 = do - -- Replicating the reparsing logic used by other plugins for now, - -- but it seems the option parsing could be floated out (actually, - -- GHC could in principle do it already since getOpt is pure, but - -- it would have to inline 'runMBD', 'doArgs' and 'parseOpts' to see - -- it, which probably isn't going to happen with the default - -- optimization settings). - opts2 <- io $ parseOpts args2 - runVolumeWith (aoVolumeOpts opts2) mixerName controlName - - withMonitorWaiter mixerName (aoAlsaCtlPath opts) $ \wait_ -> - runMB args volumeConfig run wait_ cb - -withMonitorWaiter :: String -> Maybe FilePath -> (IO () -> IO a) -> IO a -withMonitorWaiter mixerName alsaCtlPath cont = do - mvar <- newMVar () - - path <- determineAlsaCtlPath - - bracket (async $ readerThread mvar path) cancel $ \a -> do - - -- Throw on this thread if there's an exception - -- on the reader thread. - link a - - cont $ takeMVar mvar - - where - - readerThread mvar path = - let createProc = (proc "stdbuf" ["-oL", path, "monitor", mixerName]) - {std_out = CreatePipe} - in - withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do - hSetBuffering alsaOut LineBuffering - - forever $ do - c <- hGetChar alsaOut - 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 () - - 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 --" ++ - alsaCtlOptionName ++ "=/path/to/alsactl" - - --- 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 |