about summary refs log tree commit diff
path: root/test/Xanthous
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-29T14·54-0400
committerGriffin Smith <root@gws.fyi>2019-09-29T14·54-0400
commit05da490185e970b2cfdf6c61f69932fa373993f6 (patch)
tree0fa9be2182e1359ce39d600089f6937bfdccd3aa /test/Xanthous
parentec39dc0a5bed58e0b0b48eeac98e0fd0ceaa65db (diff)
Gormlaks attack back
When gormlaks see the character, they step towards them and attack
dealing 1 damage when adjacent. Characters have hitpoints now, displayed
at the bottom of the game screen, and when the game is over they die.
Diffstat (limited to 'test/Xanthous')
-rw-r--r--test/Xanthous/DataSpec.hs14
1 files changed, 14 insertions, 0 deletions
diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs
index 2c9f9dd3f9b1..6b94e6a0582a 100644
--- a/test/Xanthous/DataSpec.hs
+++ b/test/Xanthous/DataSpec.hs
@@ -15,12 +15,26 @@ test = testGroup "Xanthous.Data"
     [ testBatch $ monoid @Position mempty
     , testProperty "group laws" $ \(pos :: Position) ->
         pos <> invert pos == mempty && invert pos <> pos == mempty
+    , testGroup "stepTowards laws"
+      [ testProperty "takes only one step" $ \src tgt ->
+          src /= tgt ==>
+            isUnit (src `diffPositions` (src `stepTowards` tgt))
+      -- , testProperty "moves in the right direction" $ \src tgt ->
+      --     stepTowards src tgt == move (directionOf src tgt) src
+      ]
+    , testProperty "directionOf laws" $ \pos dir ->
+        directionOf pos (move dir pos) == dir
+    , testProperty "diffPositions is add inverse" $ \pos₁ pos₂ ->
+        diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂)
+
     ]
   , testGroup "Direction"
     [ testProperty "opposite is involutive" $ \(dir :: Direction) ->
         opposite (opposite dir) == dir
     , testProperty "opposite provides inverse" $ \dir ->
         invert (asPosition dir) == asPosition (opposite dir)
+    , testProperty "asPosition isUnit" $ \dir ->
+        dir /= Here ==> isUnit (asPosition dir)
     , testGroup "Move"
       [ testCase "Up"        $ move Up mempty        @?= Position 0 (-1)
       , testCase "Down"      $ move Down mempty      @?= Position 0 1