datepicker

An fzf-like tool to interactively select a date in a provided format

git clone https://git.8pit.net/datepicker.git

  1{-# LANGUAGE OverloadedStrings #-}
  2
  3module Tmux (tmuxTests) where
  4
  5import Control.Monad (replicateM_)
  6import Data.String (fromString)
  7import Test.Tasty
  8import Test.Tasty.Tmux
  9import Util
 10
 11selectDateSpatially :: TestCase sharedEnv
 12selectDateSpatially =
 13  withTmuxSession' "select date using spatial movement" $ \_ -> do
 14    startApplication ["--date-only"] "dec 2024"
 15
 16    -- selection: 2024-12-01
 17    sendKeys_ "Up" Unconditional
 18    sendKeys_ "Left" Unconditional
 19    -- selection: 2024-12-01
 20    sendKeys_ "Down" Unconditional
 21    -- selection: 2024-12-08
 22    sendKeys_ "Right" Unconditional
 23    -- selection: 2024-12-09
 24    sendKeys_ "Right" Unconditional
 25    -- selection: 2024-12-10
 26    sendKeys_ "Down" Unconditional
 27    -- selection: 2024-12-17
 28    sendKeys_ "Down" Unconditional
 29    -- selection: 2024-12-24
 30    sendKeys_ "Left" Unconditional
 31    -- selection: 2024-12-23
 32
 33    sendKeys_ "Enter" Unconditional
 34    captureDate >>= assertDate "Mon, 23 Dec 2024 00:00:00 UTC"
 35
 36selectDateLogically :: TestCase sharedEnv
 37selectDateLogically =
 38  withTmuxSession' "select date using logical movement" $ \_ -> do
 39    startApplication ["--date-only", "--logical-move"] "02 2020"
 40
 41    -- 2020-02-01 is a Saturday, so moving right, in logical mode, will
 42    -- directly go to the next week. Hence moving up after should do nothing.
 43    sendKeys_ "Right" Unconditional
 44    -- selection: 2020-02-02
 45    sendKeys_ "Up" Unconditional
 46    -- selection: 2020-02-02
 47    sendKeys_ "Down" Unconditional
 48    -- selection: 2020-02-09
 49    sendKeys_ "Left" Unconditional
 50    -- selection: 2020-02-08
 51
 52    sendKeys_ "Enter" Unconditional
 53    captureDate >>= assertDate "Sat, 08 Feb 2020 00:00:00 UTC"
 54
 55selectDateWithCustomFormat :: TestCase sharedEnv
 56selectDateWithCustomFormat =
 57  withTmuxSession' "custom date format" $ \_ -> do
 58    startApplication ["--date-only", "--format", "'%0Y%m%d %Z'"] "July 1998"
 59
 60    sendKeys_ "Enter" Unconditional
 61    captureDate >>= assertDate "19980701 UTC"
 62
 63selectDateMondayWeekstart :: TestCase sharedEnv
 64selectDateMondayWeekstart =
 65  withTmuxSession' "--monday option" $ \_ -> do
 66    startApplication ["--date-only", "--monday"] "Jan 2025"
 67
 68    sendKeys_ "Down" Unconditional
 69    -- selection: 2025-08-01
 70    sendKeys_ "Left" Unconditional
 71    -- selection: 2025-07-01
 72    sendKeys_ "Left" Unconditional
 73    sendKeys_ "Left" Unconditional
 74    sendKeys_ "Left" Unconditional
 75    sendKeys_ "Left" Unconditional
 76    -- selection: 2025-06-01
 77
 78    sendKeys_ "Enter" Unconditional
 79    captureDate >>= assertDate "Mon, 06 Jan 2025 00:00:00 UTC"
 80
 81selectDateTwelveMonths :: TestCase sharedEnv
 82selectDateTwelveMonths =
 83  withTmuxSession' "--twelve option" $ \_ -> do
 84    startApplication ["--date-only", "--twelve"] "sep 2025"
 85
 86    replicateM_ 17 (sendKeys_ "Down" Unconditional)
 87    -- selection: 2025-09-15
 88    replicateM_ 15 (sendKeys_ "Right" Unconditional)
 89    -- selection: 2025-08-11
 90
 91    sendKeys_ "Enter" Unconditional
 92    captureDate >>= assertDate "Tue, 11 Aug 2026 00:00:00 UTC"
 93
 94selectTime :: TestCase sharedEnv
 95selectTime =
 96  withTmuxSession' "select date and time" $ \_ -> do
 97    startApplication [] "03 1900"
 98
 99    sendKeys_ "Enter" Unconditional
100    sendKeys_ "2342" Unconditional
101    sendKeys_ "Enter" Unconditional
102
103    captureDate >>= assertDate "Thu, 01 Mar 1900 23:42:00 UTC"
104
105selectTimeAndOverflow :: TestCase sharedEnv
106selectTimeAndOverflow =
107  withTmuxSession' "select time, delete, and re-enter" $ \_ -> do
108    startApplication [] "03 1900"
109
110    sendKeys_ "Enter" (Substring "March")
111    sendKeys_ "1111 2222" Unconditional
112
113    sendKeys_ "Enter" Unconditional
114    captureDate >>= assertDate "Thu, 01 Mar 1900 22:22:00 UTC"
115
116selectTimeBackspace :: TestCase sharedEnv
117selectTimeBackspace =
118  withTmuxSession' "select time, delete, and re-enter" $ \_ -> do
119    startApplication [] "03 1900"
120
121    sendKeys_ "Enter" (Substring "March")
122    sendKeys_ "1 2 3 4" Unconditional
123    sendKeys_ "c-h" Unconditional
124    sendKeys_ "5" Unconditional
125    sendKeys_ "c-h" Unconditional
126    sendKeys_ "c-h" Unconditional
127    sendKeys_ "c-h" Unconditional
128    sendKeys_ "4" Unconditional
129
130    sendKeys_ "Enter" Unconditional
131    captureDate >>= assertDate "Thu, 01 Mar 1900 14:35:00 UTC"
132
133moveSpatiallyVertAcrossMonths :: TestCase sharedEnv
134moveSpatiallyVertAcrossMonths =
135  withTmuxSession' "move spatially across month boundary" $ \_ -> do
136    startApplication ["-d", "-3"] "Jan 2030"
137
138    -- selection: 2030-01-01
139    sendKeys_ "Left" (Substring "January")
140    -- selection: 2029-12-01
141    sendKeys_ "Down" Unconditional
142    sendKeys_ "Down" Unconditional
143    sendKeys_ "Down" Unconditional
144    sendKeys_ "Down" Unconditional
145    -- selection: 2029-12-29
146    sendKeys_ "Right" Unconditional
147    -- selection: 2030-01-27
148
149    sendKeys_ "Enter" Unconditional
150    captureDate >>= assertDate "Sun, 27 Jan 2030 00:00:00 UTC"
151
152moveSpatiallyVertBoundary :: TestCase sharedEnv
153moveSpatiallyVertBoundary =
154  withTmuxSession' "move spatially across month boundary" $ \_ -> do
155    startApplication ["-d", "--three"] "nov 2029"
156
157    -- selection: 2029-11-01
158    sendKeys_ "Down" (Substring "November")
159    -- selection: 2029-11-08
160    replicateM_ 3 (sendKeys_ "Right" Unconditional)
161    -- selection: 2029-12-02
162    replicateM_ 4 (sendKeys_ "Down" Unconditional)
163    -- selection: 2029-12-30
164    replicateM_ 4 (sendKeys_ "Left" Unconditional)
165    replicateM_ 4 (sendKeys_ "Down" Unconditional)
166    replicateM_ 4 (sendKeys_ "Down" Unconditional)
167    replicateM_ 4 (sendKeys_ "Right" Unconditional)
168    replicateM_ 4 (sendKeys_ "Right" Unconditional)
169    -- selection: 2029-12-31
170
171    sendKeys_ "Enter" Unconditional
172    captureDate >>= assertDate "Mon, 31 Dec 2029 00:00:00 UTC"
173
174moveSpatiallyHorizAcrossMonths :: TestCase sharedEnv
175moveSpatiallyHorizAcrossMonths =
176  withTmuxSession' "move horizontally across months" $ \_ -> do
177    startApplication ["-d", "-y"] "jun 2065"
178
179    -- selection: 2065-06-01
180    sendKeys_ "Up" (Substring "December")
181    -- selection: 2065-03-30
182    sendKeys_ "Up" Unconditional
183    -- selection: 2065-03-23
184    sendKeys_ "Left" Unconditional
185    sendKeys_ "Left" Unconditional
186    -- selection: 2065-02-28
187    replicateM_ 14 (sendKeys_ "Down" Unconditional)
188    -- selection: 2065-11-28
189
190    sendKeys_ "Enter" Unconditional
191    captureDate >>= assertDate "Sat, 28 Nov 2065 00:00:00 UTC"
192
193changeInitialDateSelection :: TestCase sharedEnv
194changeInitialDateSelection =
195  withTmuxSession' "select a different initial date" $ \_ -> do
196    startApplication ["-d", "-s", "\"Fri, 19 Jun 2065 00:00:00 UTC\""] "jun 2065"
197
198    sendKeys_ "Enter" Unconditional
199    captureDate >>= assertDate "Fri, 19 Jun 2065 00:00:00 UTC"
200
201changeInitialTimeSelection :: TestCase sharedEnv
202changeInitialTimeSelection =
203  withTmuxSession' "select a different initial date" $ \_ -> do
204    startApplication ["-s", "\"Fri, 19 Jun 2065 23:42:00 UTC\""] "jun 2065"
205
206    sendKeys_ "Enter" (Substring "June")
207    sendKeys_ "Enter" Unconditional
208
209    captureDate >>= assertDate "Fri, 19 Jun 2065 23:42:00 UTC"
210
211invalidInitialDateSelection :: TestCase sharedEnv
212invalidInitialDateSelection =
213  withTmuxSession' "select date outside of range" $ \_ -> do
214    _ <-
215      sendLine
216        "datepicker -s \"Fri, 15 May 2065 00:00:00 UTC\" jun 2065"
217        (Substring $ fromString "user error")
218
219    captured <- snapshot >> capture
220    assertCondition
221      (Substring $ fromString "specified date (2065-05-15) is not in displayed range")
222      captured
223
224tmuxTests :: TestTree
225tmuxTests =
226  testTmux'
227    [ selectDateSpatially,
228      selectDateLogically,
229      selectDateWithCustomFormat,
230      selectDateMondayWeekstart,
231      selectDateTwelveMonths,
232      selectTime,
233      selectTimeAndOverflow,
234      selectTimeBackspace,
235      moveSpatiallyVertAcrossMonths,
236      moveSpatiallyVertBoundary,
237      moveSpatiallyHorizAcrossMonths,
238      changeInitialDateSelection,
239      changeInitialTimeSelection,
240      invalidInitialDateSelection
241    ]