79aceaec17
Change-Id: I62ac54543da5c855c86d39956e611fd44515e9a9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/5443 Autosubmit: grfn <grfn@gws.fyi> Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
40 lines
1.6 KiB
Haskell
40 lines
1.6 KiB
Haskell
--------------------------------------------------------------------------------
|
|
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
|
|
]
|