{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Fetching game data
--
-- Various utilities related to loading game data files.
module Swarm.Game.ResourceLoading (
  -- * Generic data access
  getDataDirSafe,
  getDataFileNameSafe,

  -- * Concrete data access
  getSwarmConfigIniFile,
  getSwarmSavePath,
  getSwarmHistoryPath,
  getSwarmAchievementsPath,

  -- ** Loading text files
  readAppData,
  NameGenerator (..),
  initNameGenerator,
) 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.Array (Array, listArray)
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 (..),
  createDirectoryIfMissing,
  doesDirectoryExist,
  doesFileExist,
  getXdgDirectory,
  listDirectory,
 )
import System.FilePath
import Witch

-- | Read-only lists of adjectives and words for use in building random robot names
data NameGenerator = NameGenerator
  { NameGenerator -> Array Int Text
adjList :: Array Int Text
  , NameGenerator -> Array Int Text
nameList :: Array Int Text
  }

-- | Get subdirectory from swarm data directory.
--
-- This will first look in Cabal generated path and then
-- try a @data@ directory in 'XdgData' path.
--
-- The idea is that when installing with Cabal/Stack the first
-- is preferred, but when the players install a binary they
-- need to extract the `data` archive to the XDG directory.
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) (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> m FilePath
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO FilePath
getDataDir
  Bool
de <- 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
d
  if Bool
de
    then FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d
    else do
      FilePath
xd <- (FilePath -> FilePath -> FilePath
`appDir` FilePath
p) (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> m FilePath
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 <- 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
xd
      if Bool
xde then FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
xd else SystemFailure -> m FilePath
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (SystemFailure -> m FilePath) -> SystemFailure -> m FilePath
forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
asset) FilePath
xd (LoadingFailure -> SystemFailure)
-> LoadingFailure -> SystemFailure
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

-- | Get file from swarm data directory.
--
-- See the note in 'getDataDirSafe'.
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 <- AssetData -> FilePath -> m FilePath
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 <- 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
fp
  if Bool
fe
    then FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
    else SystemFailure -> m FilePath
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (SystemFailure -> m FilePath) -> SystemFailure -> m FilePath
forall a b. (a -> b) -> a -> b
$ Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
asset) FilePath
fp (LoadingFailure -> SystemFailure)
-> LoadingFailure -> SystemFailure
forall a b. (a -> b) -> a -> b
$ Entry -> LoadingFailure
DoesNotExist Entry
File

getSwarmConfigIniFile :: Bool -> IO (Bool, FilePath)
getSwarmConfigIniFile :: Bool -> IO (Bool, FilePath)
getSwarmConfigIniFile Bool
createDirs = do
  FilePath
swarmConfig <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
"swarm"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
createDirs (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
swarmConfig)
  let ini :: FilePath
ini = FilePath
swarmConfig FilePath -> FilePath -> FilePath
</> FilePath
"config.ini"
  Bool
iniExists <- FilePath -> IO Bool
doesFileExist FilePath
ini
  (Bool, FilePath) -> IO (Bool, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
iniExists, FilePath
ini)

-- | Get path to swarm data, optionally creating necessary
--   directories. This could fail if user has bad permissions
--   on his own @$HOME@ or @$XDG_DATA_HOME@ which is unlikely.
getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
subDir = do
  FilePath
swarmData <- (FilePath -> FilePath -> FilePath
</> FilePath
subDir) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"swarm"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
createDirs (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
swarmData)
  FilePath -> IO FilePath
forall a. a -> IO a
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
  FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
file

-- | Get path to swarm saves, optionally creating necessary
--   directories.
getSwarmSavePath :: Bool -> IO FilePath
getSwarmSavePath :: Bool -> IO FilePath
getSwarmSavePath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataSubdir Bool
createDirs FilePath
"saves"

-- | Get path to swarm history, optionally creating necessary
--   directories.
getSwarmHistoryPath :: Bool -> IO FilePath
getSwarmHistoryPath :: Bool -> IO FilePath
getSwarmHistoryPath Bool
createDirs = Bool -> FilePath -> IO FilePath
getSwarmXdgDataFile Bool
createDirs FilePath
"history"

-- | 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"

-- | Read all the @.txt@ files in the @data/@ directory.
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 <- AssetData -> FilePath -> m FilePath
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
AppAsset FilePath
"."
  [FilePath]
dirMembers :: [FilePath] <-
    (Either SystemFailure [FilePath] -> m [FilePath]
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither (Either SystemFailure [FilePath] -> m [FilePath])
-> (IO (Either SystemFailure [FilePath])
    -> m (Either SystemFailure [FilePath]))
-> IO (Either SystemFailure [FilePath])
-> m [FilePath]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either SystemFailure [FilePath])
-> m (Either SystemFailure [FilePath])
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO) (IO (Either SystemFailure [FilePath]) -> m [FilePath])
-> IO (Either SystemFailure [FilePath]) -> m [FilePath]
forall a b. (a -> b) -> a -> b
$
      ([FilePath] -> Either SystemFailure [FilePath]
forall a. a -> Either SystemFailure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> Either SystemFailure [FilePath])
-> IO [FilePath] -> IO (Either SystemFailure [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
d) IO (Either SystemFailure [FilePath])
-> (IOException -> IO (Either SystemFailure [FilePath]))
-> IO (Either SystemFailure [FilePath])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) ->
        Either SystemFailure [FilePath]
-> IO (Either SystemFailure [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SystemFailure [FilePath]
 -> IO (Either SystemFailure [FilePath]))
-> (FilePath -> Either SystemFailure [FilePath])
-> FilePath
-> IO (Either SystemFailure [FilePath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemFailure -> Either SystemFailure [FilePath]
forall a b. a -> Either a b
Left (SystemFailure -> Either SystemFailure [FilePath])
-> (FilePath -> SystemFailure)
-> FilePath
-> Either SystemFailure [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
AppAsset) FilePath
d (LoadingFailure -> SystemFailure)
-> (FilePath -> LoadingFailure) -> FilePath -> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LoadingFailure
CustomMessage (Text -> LoadingFailure)
-> (FilePath -> Text) -> FilePath -> LoadingFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> IO (Either SystemFailure [FilePath]))
-> FilePath -> IO (Either SystemFailure [FilePath])
forall a b. (a -> b) -> a -> b
$ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e
  let fs :: [FilePath]
fs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".txt") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
dirMembers

  [(Text, Maybe Text)]
filesList <- IO [(Text, Maybe Text)] -> m [(Text, Maybe Text)]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO [(Text, Maybe Text)] -> m [(Text, Maybe Text)])
-> IO [(Text, Maybe Text)] -> m [(Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Text, Maybe Text)) -> IO [(Text, Maybe Text)]
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),) (Maybe Text -> (Text, Maybe Text))
-> IO (Maybe Text) -> IO (Text, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Text)
readFileMayT (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f))
  Map Text Text -> m (Map Text Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text Text -> m (Map Text Text))
-> Map Text Text -> m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> ([(Text, Maybe Text)] -> [(Text, Text)])
-> [(Text, Maybe Text)]
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Text) -> Maybe (Text, Text))
-> [(Text, Maybe Text)] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Maybe Text) -> Maybe (Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => (Text, f a) -> f (Text, a)
sequenceA ([(Text, Maybe Text)] -> Map Text Text)
-> [(Text, Maybe Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text)]
filesList

initNameGenerator :: Has (Throw SystemFailure) sig m => Map Text Text -> m NameGenerator
initNameGenerator :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw SystemFailure) sig m =>
Map Text Text -> m NameGenerator
initNameGenerator Map Text Text
appDataMap = do
  [Text]
adjs <- Text -> m [Text]
forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"adjectives"
  [Text]
names <- Text -> m [Text]
forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"names"
  NameGenerator -> m NameGenerator
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameGenerator -> m NameGenerator)
-> NameGenerator -> m NameGenerator
forall a b. (a -> b) -> a -> b
$
    NameGenerator
      { adjList :: Array Int Text
adjList = [Text] -> Array Int Text
forall {e}. [e] -> Array Int e
makeArr [Text]
adjs
      , nameList :: Array Int Text
nameList = [Text] -> Array Int Text
forall {e}. [e] -> Array Int e
makeArr [Text]
names
      }
 where
  makeArr :: [e] -> Array Int e
makeArr [e]
xs = (Int, Int) -> [e] -> Array Int e
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [e] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [e]
xs
  getDataLines :: Text -> m [Text]
getDataLines Text
f = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
f Map Text Text
appDataMap of
    Maybe Text
Nothing ->
      SystemFailure -> m [Text]
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (SystemFailure -> m [Text]) -> SystemFailure -> m [Text]
forall a b. (a -> b) -> a -> b
$
        Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
NameGeneration) (forall target source. From source target => source -> target
into @FilePath Text
f FilePath -> FilePath -> FilePath
<.> FilePath
"txt") (Entry -> LoadingFailure
DoesNotExist Entry
File)
    Just Text
content -> [Text] -> m [Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> m [Text]) -> (Text -> [Text]) -> Text -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> m [Text]) -> Text -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text
content