From 058d3831ffeffcf8acc82eb96095c614101c5d0a Mon Sep 17 00:00:00 2001
From: Daniel Schüssler <933504+DanielSchuessler@users.noreply.github.com>
Date: Sat, 19 Jan 2019 15:30:07 +0100
Subject: Alsa plugin: Refactor (move readerThread to toplevel)
---
src/Xmobar/Plugins/Monitors/Alsa.hs | 73 +++++++++++++++++++------------------
1 file changed, 37 insertions(+), 36 deletions(-)
diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs
index 4efc808..00f7353 100644
--- a/src/Xmobar/Plugins/Monitors/Alsa.hs
+++ b/src/Xmobar/Plugins/Monitors/Alsa.hs
@@ -87,12 +87,12 @@ startAlsaPlugin mixerName controlName args cb = do
runMB args Volume.volumeConfig run wait_ cb
withMonitorWaiter :: String -> Maybe FilePath -> (String -> IO ()) -> (IO () -> IO a) -> IO a
-withMonitorWaiter mixerName alsaCtlPath outputCallback cont = do
+withMonitorWaiter mixerName alsaCtlPathOverride outputCallback cont = do
mvar <- newMVar ()
- path <- determineAlsaCtlPath
+ effectivePath <- determineAlsaCtlPath
- bracket (async $ readerThread mvar path) cancel $ \a -> do
+ bracket (async $ alsaReaderThread mixerName effectivePath outputCallback mvar) cancel $ \a -> do
-- Throw on this thread if there's an exception
-- on the reader thread.
@@ -101,42 +101,10 @@ withMonitorWaiter mixerName alsaCtlPath outputCallback cont = do
cont $ takeMVar mvar
where
-
- readerThread mvar path =
- let createProc = (proc "stdbuf" ["-oL", path, "monitor", mixerName])
- {std_out = CreatePipe}
-
- runAlsaOnce =
- withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do
- hSetBuffering alsaOut LineBuffering
-
- tryPutMVar mvar () -- Refresh immediately after restarting alsactl
-
- 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 ()
- in do
- limiter <- createRateLimiter alsaCtlRestartRateLimit
-
- forever $ do
- limiter
-
- catchJust
- (guard . isEOFError)
- runAlsaOnce
- pure
-
- outputCallback "Restarting alsactl..."
-
-
defaultPath = "/usr/sbin/alsactl"
determineAlsaCtlPath =
- case alsaCtlPath of
+ case alsaCtlPathOverride of
Just path -> do
found <- doesFileExist path
if found
@@ -160,6 +128,39 @@ withMonitorWaiter mixerName alsaCtlPath outputCallback cont = do
alsaCtlOptionName ++ "=/path/to/alsactl"
+alsaReaderThread :: String -> String -> (String -> IO a) -> MVar () -> IO b
+alsaReaderThread mixerName alsaCtlPath outputCallback mvar =
+ let createProc = (proc "stdbuf" ["-oL", alsaCtlPath, "monitor", mixerName])
+ {std_out = CreatePipe}
+
+ runAlsaOnce =
+ withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do
+ hSetBuffering alsaOut LineBuffering
+
+ tryPutMVar mvar () -- Refresh immediately after restarting alsactl
+
+ 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 ()
+ in do
+ limiter <- createRateLimiter alsaCtlRestartRateLimit
+
+ forever $ do
+ limiter
+
+ catchJust
+ (guard . isEOFError)
+ runAlsaOnce
+ pure
+
+ outputCallback "Restarting alsactl..."
+
+
+
-- This is necessarily very inefficient on 'String's
trimTrailingNewline :: String -> String
trimTrailingNewline x =
--
cgit v1.2.3