summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Alsa.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-21 23:51:41 +0000
committerjao <jao@gnu.org>2018-11-21 23:51:41 +0000
commit50134d5b5c4baabdfb35c0aeb8bf53d29f009c4d (patch)
treea710ee9a8e9ea9e46951d371af29081e1c72f502 /src/Xmobar/Plugins/Monitors/Alsa.hs
parent7674145b878fd315999558075edcfc5e09bdd91c (diff)
downloadxmobar-50134d5b5c4baabdfb35c0aeb8bf53d29f009c4d.tar.gz
xmobar-50134d5b5c4baabdfb35c0aeb8bf53d29f009c4d.tar.bz2
All sources moved inside src
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Alsa.hs')
-rw-r--r--src/Xmobar/Plugins/Monitors/Alsa.hs146
1 files changed, 0 insertions, 146 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs
deleted file mode 100644
index 21a2786..0000000
--- a/src/Xmobar/Plugins/Monitors/Alsa.hs
+++ /dev/null
@@ -1,146 +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 Xmobar.Plugins.Monitors.Alsa
- ( startAlsaPlugin
- , withMonitorWaiter
- , parseOptsIncludingMonitorArgs
- , AlsaOpts(aoAlsaCtlPath)
- ) where
-
-import Control.Concurrent
-import Control.Concurrent.Async
-import Control.Exception
-import Control.Monad
-import Xmobar.Plugins.Monitors.Common
-import qualified Xmobar.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 :: Volume.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
- Volume.runVolumeWith (aoVolumeOpts opts2) mixerName controlName
-
- withMonitorWaiter mixerName (aoAlsaCtlPath opts) $ \wait_ ->
- runMB args Volume.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