{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- 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 (getSwarmXdgDataSubdir)
import Swarm.Util.Effect (forMW)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath ((</>))

-- | Get a path to the directory where achievement records are
--   stored. If the argument is set to @True@, create the directory if
--   it does not exist.
getSwarmAchievementsPath :: Bool -> IO FilePath
getSwarmAchievementsPath :: Bool -> IO FilePath
getSwarmAchievementsPath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
"achievement"

-- | 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 <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ Bool -> IO FilePath
getSwarmAchievementsPath Bool
False
  Bool
doesParentExist <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
savedAchievementsPath
  if Bool
doesParentExist
    then do
      [FilePath]
contents <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
savedAchievementsPath
      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 forall a b. (a -> b) -> a -> b
$ \FilePath
p -> do
        let fullPath :: FilePath
fullPath = FilePath
savedAchievementsPath FilePath -> FilePath -> FilePath
</> FilePath
p
        Bool
isFile <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fullPath
        if Bool
isFile
          then do
            Either ParseException Attainment
eitherDecodedFile <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Y.decodeFileEither FilePath
fullPath)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml) Either ParseException Attainment
eitherDecodedFile
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded Asset
Achievement FilePath
p (Entry -> LoadingFailure
EntryNot Entry
File)
    else do
      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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Attainment]
attainmentList forall a b. (a -> b) -> a -> b
$ \Attainment
x -> do
    let achievementName :: FilePath
achievementName = case Attainment -> CategorizedAchievement
_achievement Attainment
x of
          GlobalAchievement GlobalAchievement
y -> forall a. Show a => a -> FilePath
show GlobalAchievement
y
          GameplayAchievement GameplayAchievement
y -> forall a. Show a => a -> FilePath
show GameplayAchievement
y
        fullPath :: FilePath
fullPath = FilePath
savedAchievementsPath FilePath -> FilePath -> FilePath
</> FilePath
achievementName
    forall a. ToJSON a => FilePath -> a -> IO ()
Y.encodeFile FilePath
fullPath Attainment
x