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.
		
			
				
	
	
		
			40 lines
		
	
	
	
		
			1.5 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			40 lines
		
	
	
	
		
			1.5 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-# LANGUAGE ApplicativeDo #-}
 | |
| --------------------------------------------------------------------------------
 | |
| module Xanthous.Data.EntityMapSpec where
 | |
| --------------------------------------------------------------------------------
 | |
| import           Test.Prelude
 | |
| --------------------------------------------------------------------------------
 | |
| import qualified Data.Aeson as JSON
 | |
| --------------------------------------------------------------------------------
 | |
| import           Xanthous.Data.EntityMap
 | |
| --------------------------------------------------------------------------------
 | |
| 
 | |
| main :: IO ()
 | |
| main = defaultMain test
 | |
| 
 | |
| test :: TestTree
 | |
| test = localOption (QuickCheckTests 20)
 | |
|   $ testGroup "Xanthous.Data.EntityMap"
 | |
|   [ testBatch $ monoid @(EntityMap Int) mempty
 | |
|   , testGroup "Deduplicate"
 | |
|     [ testGroup "Semigroup laws"
 | |
|       [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c ->
 | |
|           a <> (b <> c) === (a <> b) <> c
 | |
|       ]
 | |
|     ]
 | |
|   , testGroup "Eq laws"
 | |
|     [ testProperty "reflexivity" $ \(em :: EntityMap Int) ->
 | |
|         em == em
 | |
|     , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ ->
 | |
|         (em₁ == em₂) == (em₂ == em₁)
 | |
|     , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ ->
 | |
|         if (em₁ == em₂ && em₂ == em₃)
 | |
|         then (em₁ == em₃)
 | |
|         else True
 | |
|     ]
 | |
|   , testGroup "JSON encoding/decoding"
 | |
|     [ testProperty "Preserves IDs" $ \(em :: EntityMap Int) ->
 | |
|         let Just em' = JSON.decode $ JSON.encode em
 | |
|         in toEIDsAndPositioned em' === toEIDsAndPositioned em
 | |
|     ]
 | |
|   ]
 |