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