about summary refs log tree commit diff
path: root/users/grfn/xanthous/test/Xanthous/CommandSpec.hs
blob: 13f69a808d02143599bc399100a265f891c9692a (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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
  ]