Use JSON as save format

This commit is contained in:
2022-07-25 23:24:09 +01:00
parent b8e8413daa
commit 0d479cba87
7 changed files with 27 additions and 19 deletions
+1 -1
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
+2 -2
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.WorldEffect where
+19 -10
View File
@@ -7,8 +7,10 @@ module Dodge.Save
, readSaveSlot
) where
import Dodge.Data
import Text.Read (readMaybe)
import Data.Aeson
import qualified Data.Aeson.Encode.Pretty as AEP
import qualified Data.ByteString.Lazy as BS
--import Text.Read (readMaybe)
import qualified Data.Map.Strict as M
--import Data.Maybe
import Control.Lens
@@ -18,24 +20,31 @@ import System.Directory
writeSaveSlot :: SaveSlot -> Universe -> IO ()
writeSaveSlot ss u = do
createDirectoryIfMissing True "saveSlot"
writeFile (saveSlotPath ss) (show $ u ^. uvWorld . cWorld)
saveSlotPath :: SaveSlot -> String
saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i
saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
saveSlotPath LevelStartSlot = "saveSlot/LevelStartSave"
BS.writeFile (saveSlotPath ss)
$ AEP.encodePretty'
(AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
(u ^. uvWorld . cWorld)
--writeFile (saveSlotPath ss) (show $ u ^. uvWorld . cWorld)
readSaveSlot :: SaveSlot -> Universe -> IO Universe
readSaveSlot ss uv = do
fExists <- doesFileExist $ saveSlotPath ss
if fExists
then do
cwstr <- readFile $ saveSlotPath ss
case readMaybe cwstr of
--cwstr <- readFile $ saveSlotPath ss
--case readMaybe cwstr of
cwstr <- decodeFileStrict $ saveSlotPath ss
case cwstr of
Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return uv
Just cw -> return $ uv & uvWorld . cWorld .~ cw
else putStrLn "loadSaveSlot failed to find saved file" >> return uv
saveSlotPath :: SaveSlot -> String
saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i
saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
saveSlotPath LevelStartSlot = "saveSlot/LevelStartSave"
saveWorldInEmptySlot :: SaveSlot -> Universe -> Universe
saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of
Nothing -> w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld w))
+1 -1
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
WARNING: orphan instances concerning Aeson classes and Linear.Vx datatypes have been introduced.
+2 -2
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE StandaloneDeriving #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
-1
View File
@@ -1,5 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Picture.Data
+2 -2
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE StandaloneDeriving #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
WARNING: orphan instances concerning Aeson classes and Linear.Quaternion datatypes have been introduced.