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.

1 files changed, 18 insertions, 7 deletions

diff --git a/test/Xanthous/OrphansSpec.hs b/test/Xanthous/OrphansSpec.hs
index 3fe79ee56313..3740945877ef 100644
--- a/test/Xanthous/OrphansSpec.hs
+++ b/test/Xanthous/OrphansSpec.hs
@@ -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
     ]
   ]