{-# LANGUAGE OverloadedStrings #-}
module Swarm.Game.ResourceLoading where
import Control.Algebra (Has)
import Control.Effect.Lift (Lift, sendIO)
import Control.Effect.Throw (Throw, liftEither, throwError)
import Control.Exception (catch)
import Control.Exception.Base (IOException)
import Control.Monad (forM, when, (<=<))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Paths_swarm (getDataDir)
import Swarm.Game.Failure
import Swarm.Util
import System.Directory (
XdgDirectory (XdgData),
createDirectoryIfMissing,
doesDirectoryExist,
doesFileExist,
getXdgDirectory,
listDirectory,
)
import System.FilePath
import Witch
getDataDirSafe ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData ->
FilePath ->
m FilePath
getDataDirSafe :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
asset FilePath
p = do
FilePath
d <- (FilePath -> FilePath -> FilePath
`appDir` FilePath
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO FilePath
getDataDir
Bool
de <- 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
d
if Bool
de
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d
else do
FilePath
xd <- (FilePath -> FilePath -> FilePath
`appDir` FilePath
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
False FilePath
"data")
Bool
xde <- 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
xd
if Bool
xde then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
xd else forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
asset) FilePath
xd forall a b. (a -> b) -> a -> b
$ Entry -> LoadingFailure
DoesNotExist Entry
Directory
where
appDir :: FilePath -> FilePath -> FilePath
appDir FilePath
r = \case
FilePath
"" -> FilePath
r
FilePath
"." -> FilePath
r
FilePath
d -> FilePath
r FilePath -> FilePath -> FilePath
</> FilePath
d
getDataFileNameSafe ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData ->
FilePath ->
m FilePath
getDataFileNameSafe :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataFileNameSafe AssetData
asset FilePath
name = do
FilePath
d <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
asset FilePath
"."
let fp :: FilePath
fp = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
name
Bool
fe <- 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
fp
if Bool
fe
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
else forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
asset) FilePath
fp forall a b. (a -> b) -> a -> b
$ Entry -> LoadingFailure
DoesNotExist Entry
File
dataNotFound :: FilePath -> IO LoadingFailure
dataNotFound :: FilePath -> IO LoadingFailure
dataNotFound FilePath
f = do
FilePath
d <- Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
False FilePath
""
let squotes :: FilePath -> Text
squotes = Text -> Text
squote forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Text -> LoadingFailure
CustomMessage forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unlines
[ Text
"Could not find the data: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
squotes FilePath
f
, Text
"Try downloading the Swarm 'data' directory to: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
squotes (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"data")
]
getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
subDir = do
FilePath
swarmData <- (FilePath -> FilePath -> FilePath
</> FilePath
subDir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"swarm"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
createDirs (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
swarmData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
swarmData
getSwarmXdgDataFile :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataFile :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataFile Bool
createDirs FilePath
filepath = do
let (FilePath
subDir, FilePath
file) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
filepath
FilePath
d <- Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
subDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
file
getSwarmSavePath :: Bool -> IO FilePath
getSwarmSavePath :: Bool -> IO FilePath
getSwarmSavePath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
"saves"
getSwarmHistoryPath :: Bool -> IO FilePath
getSwarmHistoryPath :: Bool -> IO FilePath
getSwarmHistoryPath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataFile Bool
createDirs FilePath
"history"
readAppData ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m (Map Text Text)
readAppData :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m (Map Text Text)
readAppData = do
FilePath
d <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
AppAsset FilePath
"."
[FilePath]
dirMembers :: [FilePath] <-
(forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO) forall a b. (a -> b) -> a -> b
$
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
d) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) ->
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 b c a. (b -> c) -> (a -> b) -> a -> c
. Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
AppAsset) FilePath
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LoadingFailure
CustomMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show IOException
e
let fs :: [FilePath]
fs = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== FilePath
".txt") forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
dirMembers
[(Text, Maybe Text)]
filesList <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fs (\FilePath
f -> (forall target source. From source target => source -> target
into @Text (FilePath -> FilePath
dropExtension FilePath
f),) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Text)
readFileMayT (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text)]
filesList