{-# LANGUAGE OverloadedStrings #-}
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 ((</>))
getSwarmAchievementsPath :: Bool -> IO FilePath
getSwarmAchievementsPath :: Bool -> IO FilePath
getSwarmAchievementsPath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
"achievement"
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 []
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