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

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