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
|
|
@ -1,12 +1,16 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.OrphansSpec where
|
||||
|
||||
import Test.Prelude
|
||||
import Xanthous.Orphans
|
||||
import Text.Mustache
|
||||
import Text.Megaparsec (errorBundlePretty)
|
||||
|
||||
import Xanthous.Orphans ()
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Prelude
|
||||
--------------------------------------------------------------------------------
|
||||
import Text.Mustache
|
||||
import Text.Megaparsec (errorBundlePretty)
|
||||
import Graphics.Vty.Attributes
|
||||
import qualified Data.Aeson as JSON
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Orphans
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain test
|
||||
|
|
@ -27,5 +31,12 @@ test = testGroup "Xanthous.Orphans"
|
|||
$ Right expected === do
|
||||
(Template actual cache) <- res
|
||||
maybe (Left "Template not found") Right $ cache ^? at actual
|
||||
, testProperty "JSON round trip" $ \(tpl :: Template) ->
|
||||
counterexample (unpack $ ppTemplate tpl)
|
||||
$ JSON.decode (JSON.encode tpl) === Just tpl
|
||||
]
|
||||
, testGroup "Attr"
|
||||
[ testProperty "JSON round trip" $ \(attr :: Attr) ->
|
||||
JSON.decode (JSON.encode attr) === Just attr
|
||||
]
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue