Implement saving+loading the game
Implement ToJSON and FromJSON for all of the various pieces of the game state, and add a pair of functions saveGame/loadGame implementing a prism to save the game as zlib-compressed JSON. To test this, there's now Arbitrary, CoArbitrary, and Function instances for all the parts of the game state - to get around circular imports with the concrete entities this unfortunately is happening via orphan instances, plus an hs-boot file to break a circular import that was just a little too hard to remove by moving things around. Ugh.
This commit is contained in:
		
							parent
							
								
									2f2e5a0b68
								
							
						
					
					
						commit
						f37d0f75c0
					
				
					 30 changed files with 620 additions and 97 deletions
				
			
		| 
						 | 
				
			
			@ -42,9 +42,13 @@ import Xanthous.Orphans ()
 | 
			
		|||
import Xanthous.Util (EqEqProp(..))
 | 
			
		||||
--------------------------------------------------------------------------------
 | 
			
		||||
import Data.Monoid (Endo(..))
 | 
			
		||||
import Test.QuickCheck (Arbitrary(..))
 | 
			
		||||
import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function)
 | 
			
		||||
import Test.QuickCheck.Checkers (EqProp)
 | 
			
		||||
import Test.QuickCheck.Instances.UnorderedContainers ()
 | 
			
		||||
import Test.QuickCheck.Instances.Vector ()
 | 
			
		||||
import Data.Aeson
 | 
			
		||||
--------------------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
type EntityID = Word32
 | 
			
		||||
type NonNullVector a = NonNull (Vector a)
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -55,9 +59,16 @@ data EntityMap a where
 | 
			
		|||
    , _lastID     :: EntityID
 | 
			
		||||
    } -> EntityMap a
 | 
			
		||||
  deriving stock (Functor, Foldable, Traversable, Generic)
 | 
			
		||||
  deriving anyclass (NFData, CoArbitrary, Function)
 | 
			
		||||
deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a)
 | 
			
		||||
makeLenses ''EntityMap
 | 
			
		||||
 | 
			
		||||
instance ToJSON a => ToJSON (EntityMap a) where
 | 
			
		||||
  toJSON = toJSON . toEIDsAndPositioned
 | 
			
		||||
 | 
			
		||||
instance FromJSON a => FromJSON (EntityMap a) where
 | 
			
		||||
  parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON
 | 
			
		||||
 | 
			
		||||
byIDInvariantError :: forall a. a
 | 
			
		||||
byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition "
 | 
			
		||||
  <> "must point to entityIDs in byID"
 | 
			
		||||
| 
						 | 
				
			
			@ -180,7 +191,7 @@ atPositionWithIDs pos em =
 | 
			
		|||
  in (id &&& Positioned pos . getEIDAssume em) <$> eids
 | 
			
		||||
 | 
			
		||||
fromEIDsAndPositioned
 | 
			
		||||
  :: (MonoFoldable mono, Element mono ~ (EntityID, Positioned a))
 | 
			
		||||
  :: forall mono a. (MonoFoldable mono, Element mono ~ (EntityID, Positioned a))
 | 
			
		||||
  => mono
 | 
			
		||||
  -> EntityMap a
 | 
			
		||||
fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue