Add event-based refreshing for Volume plugin (--monitor option)

This uses alsactl monitor for push/event-based updating instead of
polling.

1 files changed, 161 insertions, 0 deletions

diff --git a/test/Plugins/Monitors/VolumeSpec.hs b/test/Plugins/Monitors/VolumeSpec.hs
new file mode 100644
index 0000000..d724c21
--- /dev/null
+++ b/test/Plugins/Monitors/VolumeSpec.hs
@@ -0,0 +1,161 @@
+{-# OPTIONS_GHC -Wall #-}
+module Plugins.Monitors.VolumeSpec
+  ( main
+  , spec
+  ) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Monad
+import Plugins.Monitors.Volume
+import System.FilePath
+import System.IO
+import System.IO.Temp
+import System.Posix.Files
+import System.Process
+import Test.Hspec
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+  describe "Volume.getWaitMonitor" $
+    it "produces the expected timeline (using a fake alsactl)" $
+      runFakeAlsactlTest
+
+  describe "Volume.parseOptsIncludingMonitorArgs" $ do
+    it "works with empty args" $ do
+      opts <- parseOptsIncludingMonitorArgs []
+      refreshMode opts `shouldBe` RefreshModePoll
+
+    it "parses --monitor" $ do
+      opts <- parseOptsIncludingMonitorArgs ["--", "--monitor"]
+      refreshMode opts `shouldBe` RefreshModeMonitor Nothing
+
+    it "parses --monitor=foo" $ do
+      opts <- parseOptsIncludingMonitorArgs ["--", "--monitor=foo"]
+      refreshMode opts `shouldBe` RefreshModeMonitor (Just "foo")
+
+
+runFakeAlsactlTest :: Expectation
+runFakeAlsactlTest =
+      withSystemTempDirectory "xmobar-test" $ \tmpDir -> do
+
+        let fifoPath = tmpDir </> "fifo"
+            fakeAlsactlPath = tmpDir </> "fake-alsactl"
+
+        writeFile fakeAlsactlPath $
+          unlines
+            [ "#!/bin/bash"
+            , "[[ $1 == monitor ]] || exit 99"
+            , "exec cat \"$2\""
+            ]
+
+        setFileMode fakeAlsactlPath ownerModes
+
+        withFifoWriteHandle fifoPath $ \fifo -> do
+
+            timeline <- newMVar [] :: IO (MVar [TimelineEntry])
+            runVolumeCompleted <- newEmptyMVar :: IO (MVar Bool) -- True -> quit
+            waiterTaskIsRunning <- newEmptyMVar :: IO (MVar ())
+            waiterTaskIsWaiting <- newEmptyMVar :: IO (MVar ())
+
+            waitFunc <- getMonitorWaiter fifoPath (Just fakeAlsactlPath)
+
+            let addToTimeline e =  modifyMVar_ timeline (pure . (e :))
+
+                emitEvent = do
+                  addToTimeline EventEmitted
+                  hPutStrLn fifo "#17 (2,0,0,Master Playback Volume,0) VALUE"
+                  hFlush fifo
+
+                putNow mv val = do
+                  ok <- tryPutMVar mv val
+                  unless ok $ expectationFailure "Expected the MVar to be empty"
+
+                simulateRunVolumeCompleted = putNow runVolumeCompleted False
+
+                quitWaiter = putNow runVolumeCompleted True
+
+                waiterTaskMain = do
+                  addToTimeline RunVolume
+                  putNow waiterTaskIsRunning ()
+                  q <- takeMVar runVolumeCompleted
+                  unless q $ do
+                    addToTimeline Waiting
+                    putNow waiterTaskIsWaiting ()
+                    waitFunc
+
+                    waiterTaskMain
+
+                delay_ms = threadDelay . (* 1000)
+
+            withAsync waiterTaskMain $ \waiterTask -> do
+
+              takeMVar waiterTaskIsRunning
+              simulateRunVolumeCompleted
+              takeMVar waiterTaskIsWaiting
+              takeMVar waiterTaskIsRunning -- Waiter returns instantly once
+              simulateRunVolumeCompleted
+              takeMVar waiterTaskIsWaiting
+
+              emitEvent
+              takeMVar waiterTaskIsRunning
+              simulateRunVolumeCompleted
+              takeMVar waiterTaskIsWaiting
+
+              let iters = 3
+                  burstSize = 5
+
+              replicateM_ iters $ do
+                emitEvent
+                takeMVar waiterTaskIsRunning
+                -- Now more events start to accumulate during runVolume
+                replicateM_ burstSize emitEvent
+                delay_ms 250 -- Give the events time to go through the pipe
+                simulateRunVolumeCompleted
+                -- runVolume completed and should run once more due to
+                -- accumulated events
+                takeMVar waiterTaskIsWaiting
+                takeMVar waiterTaskIsRunning
+                simulateRunVolumeCompleted
+                takeMVar waiterTaskIsWaiting
+
+              emitEvent
+              takeMVar waiterTaskIsRunning
+              quitWaiter
+
+              wait waiterTask
+
+              timelineValue <- reverse <$> readMVar timeline
+
+              timelineValue `shouldBe`
+                [RunVolume, Waiting, RunVolume, Waiting, EventEmitted, RunVolume, Waiting]
+                ++ concat
+                    (replicate iters $
+                      [EventEmitted, RunVolume]
+                      ++ replicate burstSize EventEmitted
+                      ++ [Waiting, RunVolume, Waiting])
+                ++ [EventEmitted, RunVolume]
+
+data TimelineEntry = EventEmitted | Waiting | RunVolume
+              deriving(Eq)
+
+instance Show TimelineEntry where
+  show x =
+    case x of
+      EventEmitted -> "E"
+      Waiting -> "W"
+      RunVolume -> "R"
+
+
+withFifoWriteHandle :: FilePath -> (Handle -> IO b) -> IO b
+withFifoWriteHandle fifoPath body = do
+    createNamedPipe fifoPath ownerModes
+    -- Can't seem to get the writing to the FIFO to work internally
+    withCreateProcess
+      (proc "bash" ["-c", "cat >> \"$0\"", fifoPath]) {std_in = CreatePipe}
+      $ \(Just h) _ _ _ -> do
+        hSetBuffering h LineBuffering
+        body h
\ No newline at end of file