datepicker

 1{-# LANGUAGE OverloadedStrings #-}
 2
 3module Util where
 4
 5import Control.Monad (void)
 6import Control.Monad.IO.Class (liftIO)
 7import Control.Monad.Reader (MonadIO, MonadReader)
 8import Control.Monad.State.Class (MonadState)
 9import Data.ByteString qualified as B
10import Data.List (find, isSuffixOf)
11import Data.Maybe (fromJust)
12import Data.String (fromString)
13import Test.Tasty.HUnit (assertBool)
14import Test.Tasty.Tmux
15
16-- Timezone used for the tests, set explicitly to ensure that test results
17-- are deterministic, independent of the value of the TZ environment variable.
18timezone :: String
19timezone = "CET"
20
21-- Header written by datepicker, used to detect application startup.
22--
23-- Note: This is only a substring of the header so that it works with -m.
24header :: B.ByteString
25header = "Tu We Th Fr Sa"
26
27startApplication ::
28  (HasTmuxSession a, MonadReader a m, MonadIO m) =>
29  [String] ->
30  String ->
31  m ()
32startApplication args dateInput = do
33  -- Larger window size is needed for test using the '-y' or '-3' option.
34  _ <-
35    sendLine
36      "tmux resize-window -x 512 -y 512"
37      Unconditional
38
39  let cmd = "datepicker " ++ unwords args ++ " " ++ dateInput
40  _ <-
41    sendLine
42      ("env TZ=" ++ timezone ++ " " ++ cmd)
43      (Substring header)
44  pure ()
45
46captureDate :: (HasTmuxSession a, MonadReader a m, MonadState Capture m, MonadIO m) => m String
47captureDate = do
48  _ <-
49    waitForCondition
50      (Substring $ fromString timezone)
51      defaultRetries
52      defaultBackoff
53
54  out <- captureString <$> (snapshot >> capture)
55  pure $ fromJust $ find (isSuffixOf timezone) (reverse $ lines out)
56
57assertDate :: (MonadIO m) => String -> String -> m ()
58assertDate expected actual = do
59  liftIO $
60    assertBool
61      ( "Date does not match: "
62          ++ expected
63          ++ " <-> "
64          ++ actual
65      )
66      (expected == actual)
67
68sendKeys_ ::
69  (HasTmuxSession a, MonadReader a m, MonadIO m) =>
70  String -> Condition -> m ()
71sendKeys_ s c = void (sendKeys s c)