about summary refs log tree commit diff
path: root/src/Xanthous/Game.hs
blob: a8d096f02fc0472867513079965ab81500d90ca8 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
module Xanthous.Game
  ( GameState(..)
  , levels
  , entities
  , revealedPositions
  , messageHistory
  , randomGen
  , promptState
  , GamePromptState(..)

  , getInitialState
  , initialStateFromSeed

  , positionedCharacter
  , character
  , characterPosition
  , updateCharacterVision
  , characterVisiblePositions

    -- * Messages
  , MessageHistory(..)
  , HasMessages(..)
  , HasTurn(..)
  , HasDisplayedTurn(..)
  , pushMessage
  , previousMessage
  , nextTurn

    -- * Collisions
  , Collision(..)
  , collisionAt

    -- * App monad
  , AppT(..)

    -- * Saving the game
  , saveGame
  , loadGame
  , saved

    -- * Debug State
  , DebugState(..)
  , debugState
  , allRevealed
  ) where
--------------------------------------------------------------------------------
import qualified Codec.Compression.Zlib as Zlib
import           Codec.Compression.Zlib.Internal (DecompressError)
import qualified Data.Aeson as JSON
import           System.IO.Unsafe
--------------------------------------------------------------------------------
import           Xanthous.Prelude
import           Xanthous.Game.State
import           Xanthous.Game.Lenses
import           Xanthous.Game.Arbitrary ()
import           Xanthous.Entities.Entities ()
--------------------------------------------------------------------------------

saveGame :: GameState -> LByteString
saveGame = Zlib.compress . JSON.encode

loadGame :: LByteString -> Maybe GameState
loadGame = JSON.decode <=< decompressZlibMay
  where
    decompressZlibMay bs
      = unsafeDupablePerformIO
      $ (let r = Zlib.decompress bs in r `seq` pure (Just r))
      `catch` \(_ :: DecompressError) -> pure Nothing

saved :: Prism' LByteString GameState
saved = prism' saveGame loadGame