summaryrefslogtreecommitdiffhomepage
path: root/test/Xmobar/Plugins/Monitors/AlsaSpec.hs
blob: 70beda19c513f066e4612e9329f51d9f1c44e743 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP #-}

module Xmobar.Plugins.Monitors.AlsaSpec
  ( main
  , spec
  ) where

#ifdef ALSA
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 ())

            let outputCallback msg = fail ("Did not expect the output callback to be invoked (message: "++show msg++")")

            withMonitorWaiter fifoPath (Just fakeAlsactlPath) outputCallback $ \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
#else
-- These No-Op values are required for HSpec's test discovery.
main :: IO ()
main = return ()

spec :: Monad m => m ()
spec = return ()
#endif