diff options
| author | Griffin Smith <root@gws.fyi> | 2019-12-23T19·12-0500 |
|---|---|---|
| committer | Griffin Smith <root@gws.fyi> | 2019-12-23T22·22-0500 |
| commit | f701a0be40598585cc1aec1ecf34e3fdd5690e81 (patch) | |
| tree | 687ec8f9bc1cb6c4ad25271b289f19ae70639499 /test | |
| parent | 052bc8455a99e7f1a90b6c9354e54cff10de02cc (diff) | |
Preserve entityIDs in atPosition's setter
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.
Diffstat (limited to 'test')
| -rw-r--r-- | test/Xanthous/Data/EntityMapSpec.hs | 22 |
1 files changed, 19 insertions, 3 deletions
diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 8317f5f51f8b..7c5cad019616 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -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) ] ] |