maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(grfn/xanthous): Load keybindings from a data file

Browse source 
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
This commit is contained in:
Griffin Smith 2022-04-10 11:06:53 -04:00 • committed by clbot
parent 4be5aaa001
commit 79aceaec17
6 changed files with 154 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

4
users/grfn/xanthous/test/Spec.hs
View file

@ -1,6 +1,7 @@
--------------------------------------------------------------------------------
import Test.Prelude
--------------------------------------------------------------------------------
import qualified Xanthous.CommandSpec
import qualified Xanthous.Data.EntitiesSpec
import qualified Xanthous.Data.EntityCharSpec
import qualified Xanthous.Data.EntityMap.GraphicsSpec
@ -32,7 +33,8 @@ main = defaultMainWithRerun test
test :: TestTree
test = testGroup "Xanthous"
[ Xanthous.Data.EntitiesSpec.test
[ Xanthous.CommandSpec.test
, Xanthous.Data.EntitiesSpec.test
, Xanthous.Data.EntityMap.GraphicsSpec.test
, Xanthous.Data.EntityMapSpec.test
, Xanthous.Data.LevelsSpec.test

40
users/grfn/xanthous/test/Xanthous/CommandSpec.hs Normal file
View 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
]