summaryrefslogtreecommitdiffhomepage
path: root/test/Plugins/Monitors/VolumeSpec.hs
blob: d724c214478ab4ca9e403cf8eb78f89b57140d1f (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
{-# 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