about summary refs log tree commit diff
path: root/src/Xanthous/Game/State.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-11-30T20·00-0500
committerGriffin Smith <root@gws.fyi>2019-11-30T20·00-0500
commit97a5c61f28ba98728bab390e0ea745edfbea7103 (patch)
tree25304c30990cffb5756f44c79542edf9dd2e5ac6 /src/Xanthous/Game/State.hs
parent310ea90985adcb6d9efe2ab05c67a235c2fb0ea2 (diff)
Fix an injectivity issue with saving the game
Fix an injectivity issue with JSON-encoding the entity map that was
causing the game saving to not properly round-trip. As part of this,
there's a refactor to the internals of the entity map to use sets
instead of vectors, which should also get us a nice perf boost.
Diffstat (limited to 'src/Xanthous/Game/State.hs')
-rw-r--r--src/Xanthous/Game/State.hs9
1 files changed, 7 insertions, 2 deletions
diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 16d93c61bae6..028688542a25 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -70,7 +70,6 @@ import           Data.Aeson.Generic.DerivingVia
 import           Data.Generics.Product.Fields
 import qualified Graphics.Vty.Attributes as Vty
 import qualified Graphics.Vty.Image as Vty
-import           Control.Comonad
 --------------------------------------------------------------------------------
 import           Xanthous.Data
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
@@ -282,7 +281,7 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain)
 
 --------------------------------------------------------------------------------
 
-class ( Show a, Eq a, NFData a
+class ( Show a, Eq a, Ord a, NFData a
       , ToJSON a, FromJSON a
       , Draw a, Brain a
       ) => Entity a where
@@ -301,6 +300,12 @@ instance Eq SomeEntity where
     Just Refl -> a == b
     _ -> False
 
+instance Ord SomeEntity where
+  compare (SomeEntity (a :: ea)) (SomeEntity (b :: eb)) = case eqT @ea @eb of
+    Just Refl -> compare a b
+    _ -> compare (typeRep $ Proxy @ea) (typeRep $ Proxy @eb)
+
+
 instance NFData SomeEntity where
   rnf (SomeEntity ent) = ent `deepseq` ()