Test namespaces inside Xmobar

1 files changed, 158 insertions, 0 deletions

diff --git a/test/Xmobar/Plugins/Monitors/AlsaSpec.hs b/test/Xmobar/Plugins/Monitors/AlsaSpec.hs
new file mode 100644
index 0000000..53c720f
--- /dev/null
+++ b/test/Xmobar/Plugins/Monitors/AlsaSpec.hs
@@ -0,0 +1,158 @@
+{-# OPTIONS_GHC -Wall #-}
+module Xmobar.Plugins.Monitors.AlsaSpec
+  ( main
+  , spec
+  ) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Monad
+import System.FilePath
+import System.IO
+import System.IO.Temp
+import System.Posix.Files
+import System.Process
+import Test.Hspec
+
+import Xmobar.Plugins.Monitors.Alsa
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+  describe "Alsa.getWaitMonitor" $
+    it "produces the expected timeline (using a fake alsactl)"
+       runFakeAlsactlTest
+
+  describe "Alsa.parseOptsIncludingMonitorArgs" $ do
+    it "works with empty args" $ do
+      opts <- parseOptsIncludingMonitorArgs []
+      aoAlsaCtlPath opts `shouldBe` Nothing
+
+    it "parses --alsactl=foo" $ do
+      opts <- parseOptsIncludingMonitorArgs ["--", "--alsactl=foo"]
+      aoAlsaCtlPath opts `shouldBe` 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 ())
+
+            withMonitorWaiter fifoPath (Just fakeAlsactlPath) $ \waitFunc -> do
+
+              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