{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Various utilities related to loading game data files.
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.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 (XdgData),
  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) 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

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

-- | Get a nice message suggesting to download @data@ directory to 'XdgData'.
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")
        ]

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

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

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

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 <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"adjectives"
  [Text]
names <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"names"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    NameGenerator
      { adjList :: Array Int Text
adjList = forall {e}. [e] -> Array Int e
makeArr [Text]
adjs
      , nameList :: Array Int Text
nameList = forall {e}. [e] -> Array Int e
makeArr [Text]
names
      }
 where
  makeArr :: [e] -> Array Int e
makeArr [e]
xs = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs forall a. Num a => a -> a -> a
- Int
1) [e]
xs
  getDataLines :: Text -> m [Text]
getDataLines Text
f = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
f Map Text Text
appDataMap of
    Maybe Text
Nothing ->
      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
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
content