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

@ -64,14 +64,15 @@ module Xanthous.Data
, Hitpoints(..)
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude hiding (Left, Down, Right)
import Xanthous.Prelude hiding (Left, Down, Right, (.=))
import Test.QuickCheck (Arbitrary, CoArbitrary, Function)
import Test.QuickCheck.Arbitrary.Generic
import Data.Group
import Brick (Location(Location), Edges(..))
import Data.Monoid (Product(..), Sum(..))
import Data.Aeson.Generic.DerivingVia
import Data.Aeson (ToJSON, FromJSON)
import Data.Aeson
( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject)
--------------------------------------------------------------------------------
import Xanthous.Util (EqEqProp(..), EqProp)
import Xanthous.Orphans ()
@ -116,6 +117,7 @@ instance Arbitrary a => Arbitrary (Position' a) where
arbitrary = genericArbitrary
shrink = genericShrink
instance Num a => Semigroup (Position' a) where
(Position x y) <> (Position x y) = Position (x + x) (y + y)
@ -134,7 +136,7 @@ instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where
data Positioned a where
Positioned :: Position -> a -> Positioned a
deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
deriving anyclass (CoArbitrary, Function)
deriving anyclass (NFData, CoArbitrary, Function)
type role Positioned representational
_Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b)
@ -146,6 +148,16 @@ _Positioned = iso hither yon
instance Arbitrary a => Arbitrary (Positioned a) where
arbitrary = Positioned <$> arbitrary <*> arbitrary
instance ToJSON a => ToJSON (Positioned a) where
toJSON (Positioned pos val) = object
[ "position" .= pos
, "data" .= val
]
instance FromJSON a => FromJSON (Positioned a) where
parseJSON = withObject "Positioned" $ \obj ->
Positioned <$> obj .: "position" <*> obj .: "data"
position :: Lens' (Positioned a) Position
position = lens
(\(Positioned pos _) -> pos)