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:
Griffin Smith 2019-11-29 14:33:52 -05:00
parent 2f2e5a0b68
commit f37d0f75c0
30 changed files with 620 additions and 97 deletions

View file

@ -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
]
]