chore(users): grfn -> aspen
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
parent
0ba476a426
commit
82ecd61f5c
478 changed files with 75 additions and 77 deletions
40
users/aspen/xanthous/test/Xanthous/CommandSpec.hs
Normal file
40
users/aspen/xanthous/test/Xanthous/CommandSpec.hs
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Xanthous.CommandSpec (main, test) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Prelude
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Command
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Aeson (fromJSON, Value(String))
|
||||
import qualified Data.Aeson as A
|
||||
import Graphics.Vty.Input (Key(..), Modifier(..))
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain test
|
||||
|
||||
test :: TestTree
|
||||
test = testGroup "Xanthous.CommandSpec"
|
||||
[ testGroup "keybindings"
|
||||
[ testCase "all are valid" $ keybindings `deepseq` pure ()
|
||||
, testProperty "all non-move commands are bound" $ \cmd ->
|
||||
let isn'tMove = case cmd of
|
||||
Move _ -> False
|
||||
StartAutoMove _ -> False
|
||||
_ -> True
|
||||
in isn'tMove ==> member cmd commands
|
||||
]
|
||||
, testGroup "instance FromJSON Keybinding" $
|
||||
[ ("q", Keybinding (KChar 'q') [])
|
||||
, ("<up>", Keybinding KUp [])
|
||||
, ("<left>", Keybinding KLeft [])
|
||||
, ("<right>", Keybinding KRight [])
|
||||
, ("<down>", Keybinding KDown [])
|
||||
, ("S-q", Keybinding (KChar 'q') [MShift])
|
||||
, ("C-S-q", Keybinding (KChar 'q') [MCtrl, MShift])
|
||||
, ("m-<UP>", Keybinding KUp [MMeta])
|
||||
, ("S", Keybinding (KChar 'S') [])
|
||||
] <&> \(s, kb) ->
|
||||
testCase (fromString $ unpack s <> " -> " <> show kb)
|
||||
$ fromJSON (String s) @?= A.Success kb
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue