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

Preserve entityIDs in atPosition's setter

Browse source 
Make the setter for the atPosition lens preserve entityIDs for
already-existing entities at the position, so that when we plop
something in the same tile as the character the character's entity ID
doesn't disappear.
This commit is contained in:
Griffin Smith 2019-12-23 14:12:32 -05:00
parent 052bc8455a
commit f701a0be40
2 changed files with 50 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

22
test/Xanthous/Data/EntityMapSpec.hs
View file

@ -3,11 +3,11 @@
module Xanthous.Data.EntityMapSpec where
--------------------------------------------------------------------------------
import Test.Prelude
import Control.Lens.Properties
--------------------------------------------------------------------------------
import qualified Data.Aeson as JSON
--------------------------------------------------------------------------------
import Xanthous.Data.EntityMap
import Xanthous.Data (Positioned(..))
--------------------------------------------------------------------------------
main :: IO ()
@ -47,7 +47,23 @@ test = localOption (QuickCheckTests 20)
in toEIDsAndPositioned em' === toEIDsAndPositioned em
]
, testGroup "atPosition"
[ testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos
, localOption (QuickCheckTests 50)
$ testGroup "atPosition"
[ testProperty "setget" $ \pos (em :: EntityMap Int) es ->
view (atPosition pos) (set (atPosition pos) es em) === es
, testProperty "getset" $ \pos (em :: EntityMap Int) ->
set (atPosition pos) (view (atPosition pos) em) em === em
, testProperty "setset" $ \pos (em :: EntityMap Int) es ->
(set (atPosition pos) es . set (atPosition pos) es) em
===
set (atPosition pos) es em
-- testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos
, testProperty "preserves IDs" $ \(em :: EntityMap Int) e1 e2 p ->
let (eid, em') = insertAtReturningID p e1 em
em'' = em' & atPosition p %~ (e2 <|)
in
counterexample ("em': " <> show em')
. counterexample ("em'': " <> show em'')
$ em'' ^. at eid === Just (Positioned p e1)
]
]