From 31fa44e9aa4ba4d3db8688d785b766fd5e7cf8f1 Mon Sep 17 00:00:00 2001
From: Daniel Schüssler <933504+DanielSchuessler@users.noreply.github.com>
Date: Sun, 26 Aug 2018 17:29:43 +0200
Subject: Turn the --monitor option to `Volume` into a new plugin `Alsa`
 instead

See #360.
---
 src/Plugins/Monitors/Volume.hs | 121 ++++-------------------------------------
 1 file changed, 10 insertions(+), 111 deletions(-)

(limited to 'src/Plugins/Monitors/Volume.hs')

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
-- 
cgit v1.2.3