{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.Model.Achievement.Persistence where
import Control.Arrow (left)
import Control.Carrier.Lift (sendIO)
import Control.Monad (forM, forM_)
import Data.Either (partitionEithers)
import Data.Yaml qualified as Y
import Swarm.TUI.Model.Achievement.Attainment
import Swarm.TUI.Model.Achievement.Definitions
import Swarm.TUI.Model.Failure
import Swarm.Util
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 ::
IO ([SystemFailure], [Attainment])
loadAchievementsInfo :: IO ([SystemFailure], [Attainment])
loadAchievementsInfo = do
FilePath
savedAchievementsPath <- Bool -> IO FilePath
getSwarmAchievementsPath Bool
False
Bool
doesParentExist <- FilePath -> IO Bool
doesDirectoryExist FilePath
savedAchievementsPath
if Bool
doesParentExist
then do
[FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
savedAchievementsPath
[Either SystemFailure Attainment]
eithersList <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [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 <- 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
CanNotParse) 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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SystemFailure Attainment]
eithersList
else forall (m :: * -> *) a. Monad m => a -> m a
return ([Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded Asset
Achievement FilePath
"." (Entry -> LoadingFailure
DoesNotExist Entry
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