Allow for concurrent effects

src/Dodge/Save.hs

@@ -1,71 +1,73 @@
 module Dodge.Save (
-    saveWorldInEmptySlot,
+    saveWorldInSlot,
     loadSaveSlot,
     doQuicksave,
-    saveLevelStartSlot,
+--    saveLevelStartSlot,
     writeSaveSlot,
     readSaveSlot,
+    reloadLevelStart,
 ) where
 import Control.Lens
+import Dodge.Data.SaveSlot
 import Data.Aeson
 import qualified Data.Aeson.Encode.Pretty as AEP
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.Map.Strict as M
 import Dodge.Data.Universe
 --import qualified Data.Set as S
 import System.Directory
 
-writeSaveSlot :: SaveSlot -> Universe -> IO ()
+writeSaveSlot :: SaveSlot -> Universe -> IO (Universe -> Universe)
 writeSaveSlot ss u = do
     createDirectoryIfMissing True "saveSlot"
     BS.writeFile (saveSlotPath ss) $
         AEP.encodePretty'
             (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
             (u ^. uvWorld . cWorld)
+    return id
 
 --writeFile (saveSlotPath ss) (show $ u ^. uvWorld . cWorld)
 
-readSaveSlot :: SaveSlot -> Universe -> IO Universe
-readSaveSlot ss uv = do
+readSaveSlot :: SaveSlot -> IO (Universe -> Universe)
+readSaveSlot ss = do
     fExists <- doesFileExist $ saveSlotPath ss
     if fExists
         then do
-            --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
+                Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return id
+                Just cw -> return $ \uv -> uv & uvWorld . cWorld .~ cw
+        else putStrLn "loadSaveSlot failed to find saved file" >> return id
 
 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))
-    _ -> w
+saveSlotPath (LevelStartSlot i) = "saveSlot/LevelStart" ++ show i
 
 saveWorldInSlot :: SaveSlot -> Universe -> Universe
-saveWorldInSlot slot u = u & savedWorlds %~ M.insert slot (clearKeys (_uvWorld u))
+saveWorldInSlot slot u = u & uvConcEffects ?~
+    writeSaveSlot slot u
+    
+reloadLevelStart :: Universe -> Universe
+reloadLevelStart u = case u ^. uvWorld . gameSlot of
+    GameNum i -> loadSaveSlot (LevelStartSlot i) u
+    _ -> u
 
 loadSaveSlot :: SaveSlot -> Universe -> Universe
-loadSaveSlot slot u =
-    maybe
-        u
-        (\w -> u & menuLayers .~ [] & uvWorld .~ w)
-        $ M.lookup slot (_savedWorlds u)
+loadSaveSlot slot = (uvConcEffects ?~ readSaveSlot slot)
+    . (uvWorld . gameSlot .~ GameLoading slot)
+--    maybe
+--        u
+--        (\w -> u & menuLayers .~ [] & uvWorld .~ w)
+--        $ M.lookup slot (_savedWorlds u)
 
 doQuicksave :: Universe -> Universe
 doQuicksave = saveWorldInSlot QuicksaveSlot
 
-clearKeys :: World -> World
-clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
+--clearKeys :: World -> World
+--clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
 
-saveLevelStartSlot :: Universe -> Universe
---saveLevelStartSlot = id
-saveLevelStartSlot = saveWorldInSlot LevelStartSlot
+--saveLevelStartSlot :: Universe -> Universe
+----saveLevelStartSlot = id
+--saveLevelStartSlot = saveWorldInSlot LevelStartSlot
 
 --saveLevelStartSlot = sideEffects %~ (fmap  (undefined) . )