about summary refs log tree commit diff
path: root/src/Xanthous/App.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-11-29T19·33-0500
committerGriffin Smith <root@gws.fyi>2019-11-29T19·33-0500
commitf37d0f75c0b4a77c8e35192c24c6fdb6f2bc4619 (patch)
tree0af3e636f1a2dcb0a0e179895e4a41f2fab45f69 /src/Xanthous/App.hs
parent2f2e5a0b684f886a7585161d30e8cda962c7eefb (diff)
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.
Diffstat (limited to 'src/Xanthous/App.hs')
-rw-r--r--src/Xanthous/App.hs16
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 ]