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
				
			
		
							
								
								
									
										28
									
								
								src/Xanthous/Util/QuickCheck.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										28
									
								
								src/Xanthous/Util/QuickCheck.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,28 @@ | |||
| module Xanthous.Util.QuickCheck | ||||
|   ( FunctionShow(..) | ||||
|   , functionJSON | ||||
|   , FunctionJSON(..) | ||||
|   ) where | ||||
| -------------------------------------------------------------------------------- | ||||
| import Xanthous.Prelude | ||||
| import Test.QuickCheck | ||||
| import Test.QuickCheck.Function | ||||
| import Test.QuickCheck.Instances.ByteString () | ||||
| import Data.Aeson | ||||
| import Data.Coerce | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| newtype FunctionShow a = FunctionShow a | ||||
|   deriving newtype (Show, Read) | ||||
| 
 | ||||
| instance (Show a, Read a) => Function (FunctionShow a) where | ||||
|   function = functionShow | ||||
| 
 | ||||
| functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c | ||||
| functionJSON = functionMap encode (headEx . decode) | ||||
| 
 | ||||
| newtype FunctionJSON a = FunctionJSON a | ||||
|   deriving newtype (ToJSON, FromJSON) | ||||
| 
 | ||||
| instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where | ||||
|   function = functionJSON | ||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue