1{-# OPTIONS_GHC -Wall #-} 2{-# LANGUAGE CPP #-} 3 4module Xmobar.Plugins.Monitors.AlsaSpec 5 ( main 6 , spec 7 ) where 8 9#ifdef ALSA 10import Control.Concurrent 11import Control.Concurrent.Async 12import Control.Monad 13import System.FilePath 14import System.IO 15import System.IO.Temp 16import System.Posix.Files 17import System.Process 18import Test.Hspec 19 20import Xmobar.Plugins.Monitors.Alsa 21 22main :: IO () 23main = hspec spec 24 25spec :: Spec 26spec = do 27 describe "Alsa.getWaitMonitor" $ 28 it "produces the expected timeline (using a fake alsactl)" 29 runFakeAlsactlTest 30 31 describe "Alsa.parseOptsIncludingMonitorArgs" $ do 32 it "works with empty args" $ do 33 opts <- parseOptsIncludingMonitorArgs [] 34 aoAlsaCtlPath opts `shouldBe` Nothing 35 36 it "parses --alsactl=foo" $ do 37 opts <- parseOptsIncludingMonitorArgs ["--", "--alsactl=foo"] 38 aoAlsaCtlPath opts `shouldBe` Just "foo" 39 40 41runFakeAlsactlTest :: Expectation 42runFakeAlsactlTest = 43 withSystemTempDirectory "xmobar-test" $ \tmpDir -> do 44 45 let fifoPath = tmpDir </> "fifo" 46 fakeAlsactlPath = tmpDir </> "fake-alsactl" 47 48 writeFile fakeAlsactlPath $ 49 unlines 50 [ "#!/bin/bash" 51 , "[[ $1 == monitor ]] || exit 99" 52 , "exec cat \"$2\"" 53 ] 54 55 setFileMode fakeAlsactlPath ownerModes 56 57 withFifoWriteHandle fifoPath $ \fifo -> do 58 59 timeline <- newMVar [] :: IO (MVar [TimelineEntry]) 60 runVolumeCompleted <- newEmptyMVar :: IO (MVar Bool) -- True -> quit 61 waiterTaskIsRunning <- newEmptyMVar :: IO (MVar ()) 62 waiterTaskIsWaiting <- newEmptyMVar :: IO (MVar ()) 63 64 let outputCallback msg = fail ("Did not expect the output callback to be invoked (message: "++show msg++")") 65 66 withMonitorWaiter fifoPath (Just fakeAlsactlPath) outputCallback $ \waitFunc -> do 67 68 let addToTimeline e = modifyMVar_ timeline (pure . (e :)) 69 70 emitEvent = do 71 addToTimeline EventEmitted 72 hPutStrLn fifo "#17 (2,0,0,Master Playback Volume,0) VALUE" 73 hFlush fifo 74 75 putNow mv val = do 76 ok <- tryPutMVar mv val 77 unless ok $ expectationFailure "Expected the MVar to be empty" 78 79 simulateRunVolumeCompleted = putNow runVolumeCompleted False 80 81 quitWaiter = putNow runVolumeCompleted True 82 83 waiterTaskMain = do 84 addToTimeline RunVolume 85 putNow waiterTaskIsRunning () 86 q <- takeMVar runVolumeCompleted 87 unless q $ do 88 addToTimeline Waiting 89 putNow waiterTaskIsWaiting () 90 waitFunc 91 92 waiterTaskMain 93 94 delay_ms = threadDelay . (* 1000) 95 96 withAsync waiterTaskMain $ \waiterTask -> do 97 98 takeMVar waiterTaskIsRunning 99 simulateRunVolumeCompleted 100 takeMVar waiterTaskIsWaiting 101 takeMVar waiterTaskIsRunning -- Waiter returns instantly once 102 simulateRunVolumeCompleted 103 takeMVar waiterTaskIsWaiting 104 105 emitEvent 106 takeMVar waiterTaskIsRunning 107 simulateRunVolumeCompleted 108 takeMVar waiterTaskIsWaiting 109 110 let iters = 3 111 burstSize = 5 112 113 replicateM_ iters $ do 114 emitEvent 115 takeMVar waiterTaskIsRunning 116 -- Now more events start to accumulate during runVolume 117 replicateM_ burstSize emitEvent 118 delay_ms 250 -- Give the events time to go through the pipe 119 simulateRunVolumeCompleted 120 -- runVolume completed and should run once more due to 121 -- accumulated events 122 takeMVar waiterTaskIsWaiting 123 takeMVar waiterTaskIsRunning 124 simulateRunVolumeCompleted 125 takeMVar waiterTaskIsWaiting 126 127 emitEvent 128 takeMVar waiterTaskIsRunning 129 quitWaiter 130 131 wait waiterTask 132 133 timelineValue <- reverse <$> readMVar timeline 134 135 timelineValue `shouldBe` 136 [RunVolume, Waiting, RunVolume, Waiting, EventEmitted, RunVolume, Waiting] 137 ++ concat 138 (replicate iters $ 139 [EventEmitted, RunVolume] 140 ++ replicate burstSize EventEmitted 141 ++ [Waiting, RunVolume, Waiting]) 142 ++ [EventEmitted, RunVolume] 143 144data TimelineEntry = EventEmitted | Waiting | RunVolume 145 deriving(Eq) 146 147instance Show TimelineEntry where 148 show x = 149 case x of 150 EventEmitted -> "E" 151 Waiting -> "W" 152 RunVolume -> "R" 153 154 155withFifoWriteHandle :: FilePath -> (Handle -> IO b) -> IO b 156withFifoWriteHandle fifoPath body = do 157 createNamedPipe fifoPath ownerModes 158 -- Can't seem to get the writing to the FIFO to work internally 159 withCreateProcess 160 (proc "bash" ["-c", "cat >> \"$0\"", fifoPath]) {std_in = CreatePipe} 161 $ \(Just h) _ _ _ -> do 162 hSetBuffering h LineBuffering 163 body h 164#else 165-- These No-Op values are required for HSpec's test discovery. 166main :: IO () 167main = return () 168 169spec :: Monad m => m () 170spec = return () 171#endif 172