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, 14 insertions, 2 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 2f27948cdee5..71bf40c427e8 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -8,12 +8,13 @@ import qualified Brick
 import           Brick.Widgets.Edit (handleEditorEvent)
 import           Graphics.Vty.Attributes (defAttr)
 import           Graphics.Vty.Input.Events (Event(EvKey), Key(..))
-import           Control.Monad.State (get, MonadState)
+import           Control.Monad.State (get, gets, MonadState)
 import           Control.Monad.Random (MonadRandom)
 import           Control.Monad.State.Class (modify)
 import           Data.Aeson (object, ToJSON)
 import qualified Data.Aeson as A
 import qualified Data.Vector as V
+import qualified Data.Yaml as Yaml
 import           System.Exit
 --------------------------------------------------------------------------------
 import           Xanthous.Command
@@ -23,7 +24,6 @@ import           Xanthous.Data
                  , positioned
                  , Position
                  , Ticks
-                 , Position'(Position)
                  , (|*|)
                  )
 import           Xanthous.Data.EntityMap (EntityMap)
@@ -192,6 +192,18 @@ handleCommand Eat = do
   stepGame -- TODO
   continue
 
+handleCommand Save = do
+  -- TODO default save locations / config file?
+  prompt_ @'StringPrompt ["save", "location"] Cancellable
+    $ \(StringResult filename) -> do
+      src <- gets saveGame
+      lift . liftIO $ do
+        writeFile (unpack filename) $ toStrict src
+        exitSuccess
+
+  continue
+
+
 handleCommand ToggleRevealAll = do
   val <- debugState . allRevealed <%= not
   say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ]