diff options
Diffstat (limited to 'test/Xmobar')
| -rw-r--r-- | test/Xmobar/Plugins/Monitors/AlsaSpec.hs | 158 | ||||
| -rw-r--r-- | test/Xmobar/Plugins/Monitors/CommonSpec.hs | 29 | 
2 files changed, 187 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 diff --git a/test/Xmobar/Plugins/Monitors/CommonSpec.hs b/test/Xmobar/Plugins/Monitors/CommonSpec.hs new file mode 100644 index 0000000..84cfbf3 --- /dev/null +++ b/test/Xmobar/Plugins/Monitors/CommonSpec.hs @@ -0,0 +1,29 @@ +module Xmobar.Plugins.Monitors.CommonSpec +  ( main +  , spec +  ) where + +import Test.Hspec +import Xmobar.Plugins.Monitors.Common + +main :: IO () +main = hspec spec + +spec :: Spec +spec = +  describe "Common.padString" $ do +    it "returns given string when called with default values" $ +      do padString 0 0 "" False "" "test" `shouldBe` "test" + +    it "truncates to max width" $ do +      let maxw = 3 +          givenStr = "mylongstr" +          expectedStr = take maxw givenStr +      padString 0 maxw "" False "" givenStr `shouldBe` expectedStr + +    it "truncates to max width and concatenate with ellipsis" $ do +      let maxw = 3 +          givenStr = "mylongstr" +          ellipsis = "..." +          expectedStr = (++ ellipsis) . take 3 $ givenStr +      padString 0 maxw "" False ellipsis givenStr `shouldBe` expectedStr | 
