-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Achievements load/save
--
-- Load/save logic for achievements.
-- Each achievement is saved to its own file to better
-- support forward-compatibility.
module Swarm.Game.Achievement.Persistence where

import Control.Arrow (left)
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Monad (forM_)
import Data.Sequence (Seq)
import Data.Yaml qualified as Y
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Failure
import Swarm.Game.ResourceLoading (getSwarmAchievementsPath)
import Swarm.Util.Effect (forMW)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath ((</>))

-- | Load saved info about achievements from XDG data directory.
--   Returns a list of attained achievements.
loadAchievementsInfo ::
  (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
  m [Attainment]
loadAchievementsInfo :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m [Attainment]
loadAchievementsInfo = do
  FilePath
savedAchievementsPath <- IO FilePath -> m FilePath
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Bool -> IO FilePath
getSwarmAchievementsPath Bool
False
  Bool
doesParentExist <- IO Bool -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
savedAchievementsPath
  if Bool
doesParentExist
    then do
      [FilePath]
contents <- IO [FilePath] -> m [FilePath]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
savedAchievementsPath
      [FilePath]
-> (FilePath -> m (Either SystemFailure Attainment))
-> m [Attainment]
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *) (t :: * -> *) a
       b.
(Has (Accum (Seq w)) sig m, Witherable t) =>
t a -> (a -> m (Either w b)) -> m (t b)
forMW [FilePath]
contents ((FilePath -> m (Either SystemFailure Attainment))
 -> m [Attainment])
-> (FilePath -> m (Either SystemFailure Attainment))
-> m [Attainment]
forall a b. (a -> b) -> a -> b
$ \FilePath
p -> do
        let fullPath :: FilePath
fullPath = FilePath
savedAchievementsPath FilePath -> FilePath -> FilePath
</> FilePath
p
        Bool
isFile <- IO Bool -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fullPath
        if Bool
isFile
          then do
            Either ParseException Attainment
eitherDecodedFile <- IO (Either ParseException Attainment)
-> m (Either ParseException Attainment)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (FilePath -> IO (Either ParseException Attainment)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Y.decodeFileEither FilePath
fullPath)
            Either SystemFailure Attainment
-> m (Either SystemFailure Attainment)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SystemFailure Attainment
 -> m (Either SystemFailure Attainment))
-> Either SystemFailure Attainment
-> m (Either SystemFailure Attainment)
forall a b. (a -> b) -> a -> b
$ (ParseException -> SystemFailure)
-> Either ParseException Attainment
-> Either SystemFailure Attainment
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded Asset
Achievement FilePath
p (LoadingFailure -> SystemFailure)
-> (ParseException -> LoadingFailure)
-> ParseException
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml) Either ParseException Attainment
eitherDecodedFile
          else Either SystemFailure Attainment
-> m (Either SystemFailure Attainment)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SystemFailure Attainment
 -> m (Either SystemFailure Attainment))
-> (SystemFailure -> Either SystemFailure Attainment)
-> SystemFailure
-> m (Either SystemFailure Attainment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemFailure -> Either SystemFailure Attainment
forall a b. a -> Either a b
Left (SystemFailure -> m (Either SystemFailure Attainment))
-> SystemFailure -> m (Either SystemFailure Attainment)
forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded Asset
Achievement FilePath
p (Entry -> LoadingFailure
EntryNot Entry
File)
    else do
      [Attainment] -> m [Attainment]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Save info about achievements to XDG data directory.
saveAchievementsInfo ::
  [Attainment] ->
  IO ()
saveAchievementsInfo :: [Attainment] -> IO ()
saveAchievementsInfo [Attainment]
attainmentList = do
  FilePath
savedAchievementsPath <- Bool -> IO FilePath
getSwarmAchievementsPath Bool
True
  [Attainment] -> (Attainment -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Attainment]
attainmentList ((Attainment -> IO ()) -> IO ()) -> (Attainment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Attainment
x -> do
    let achievementName :: FilePath
achievementName = case Attainment -> CategorizedAchievement
_achievement Attainment
x of
          GlobalAchievement GlobalAchievement
y -> GlobalAchievement -> FilePath
forall a. Show a => a -> FilePath
show GlobalAchievement
y
          GameplayAchievement GameplayAchievement
y -> GameplayAchievement -> FilePath
forall a. Show a => a -> FilePath
show GameplayAchievement
y
        fullPath :: FilePath
fullPath = FilePath
savedAchievementsPath FilePath -> FilePath -> FilePath
</> FilePath
achievementName
    FilePath -> Attainment -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Y.encodeFile FilePath
fullPath Attainment
x