mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-11 14:46:33 +03:00
Fallback to XDG data directory (#678)
- when `datadir` is not available, try using the XDG data directory This way the game can be installed as an executable and data files unpacked to `~/.local/share/swarm/data`. Notice that the XDG data folder is `~/.local/share/swarm`; inside it is the unpacked `data`. The alternative approach is to use the environment variable `swarm_datadir` and set that to the unpacked data folder. That works (even after this change) but is not very beginner friendly. Ideally, we would like to set this in Cabal when building executable, for example to `/usr/share/swarm/<version>`. Reading through haskell/cabal#5997, it looks like that is not supported.
This commit is contained in:
parent
559a3450bd
commit
e13dced169
@ -99,7 +99,7 @@ formatFile input = do
|
|||||||
Text.putStrLn content
|
Text.putStrLn content
|
||||||
exitSuccess
|
exitSuccess
|
||||||
Left e -> do
|
Left e -> do
|
||||||
Text.putStrLn $ showInput input <> ":" <> e
|
Text.hPutStrLn stderr $ showInput input <> ":" <> e
|
||||||
exitFailure
|
exitFailure
|
||||||
|
|
||||||
showVersion :: IO ()
|
showVersion :: IO ()
|
||||||
|
@ -26,6 +26,7 @@ import Swarm.TUI.Model
|
|||||||
import Swarm.TUI.View
|
import Swarm.TUI.View
|
||||||
import Swarm.Version (getNewerReleaseVersion)
|
import Swarm.Version (getNewerReleaseVersion)
|
||||||
import Swarm.Web
|
import Swarm.Web
|
||||||
|
import System.IO (stderr)
|
||||||
|
|
||||||
type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()
|
type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()
|
||||||
|
|
||||||
@ -46,7 +47,7 @@ appMain :: AppOpts -> IO ()
|
|||||||
appMain opts = do
|
appMain opts = do
|
||||||
res <- runExceptT $ initAppState opts
|
res <- runExceptT $ initAppState opts
|
||||||
case res of
|
case res of
|
||||||
Left errMsg -> T.putStrLn errMsg
|
Left errMsg -> T.hPutStrLn stderr errMsg
|
||||||
Right s -> do
|
Right s -> do
|
||||||
-- Send Frame events as at a reasonable rate for 30 fps. The
|
-- Send Frame events as at a reasonable rate for 30 fps. The
|
||||||
-- game is responsible for figuring out how many steps to take
|
-- game is responsible for figuring out how many steps to take
|
||||||
|
@ -103,10 +103,9 @@ import Data.Text qualified as T
|
|||||||
import Data.Yaml
|
import Data.Yaml
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Linear (V2)
|
import Linear (V2)
|
||||||
import Paths_swarm
|
|
||||||
import Swarm.Game.Display
|
import Swarm.Game.Display
|
||||||
import Swarm.Language.Capability
|
import Swarm.Language.Capability
|
||||||
import Swarm.Util (plural, reflow, (?))
|
import Swarm.Util (dataNotFound, getDataFileNameSafe, plural, reflow, (?))
|
||||||
import Swarm.Util.Yaml
|
import Swarm.Util.Yaml
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import Witch
|
import Witch
|
||||||
@ -362,8 +361,11 @@ instance ToJSON Entity where
|
|||||||
-- either an 'EntityMap' or a pretty-printed parse error.
|
-- either an 'EntityMap' or a pretty-printed parse error.
|
||||||
loadEntities :: MonadIO m => m (Either Text EntityMap)
|
loadEntities :: MonadIO m => m (Either Text EntityMap)
|
||||||
loadEntities = liftIO $ do
|
loadEntities = liftIO $ do
|
||||||
fileName <- getDataFileName "entities.yaml"
|
let f = "entities.yaml"
|
||||||
bimap (from . prettyPrintParseException) buildEntityMap <$> decodeFileEither fileName
|
mayFileName <- getDataFileNameSafe f
|
||||||
|
case mayFileName of
|
||||||
|
Nothing -> Left <$> dataNotFound f
|
||||||
|
Just fileName -> bimap (from . prettyPrintParseException) buildEntityMap <$> decodeFileEither fileName
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- Entity lenses
|
-- Entity lenses
|
||||||
|
@ -51,8 +51,7 @@ import Witch
|
|||||||
|
|
||||||
import Control.Algebra (Has)
|
import Control.Algebra (Has)
|
||||||
import Control.Carrier.Lift (Lift, sendIO)
|
import Control.Carrier.Lift (Lift, sendIO)
|
||||||
import Control.Carrier.Throw.Either (runThrow)
|
import Control.Carrier.Throw.Either (runThrow, throwError)
|
||||||
import Paths_swarm
|
|
||||||
import Swarm.Game.Entity as E
|
import Swarm.Game.Entity as E
|
||||||
import Swarm.Util
|
import Swarm.Util
|
||||||
import Swarm.Util.Yaml
|
import Swarm.Util.Yaml
|
||||||
@ -143,11 +142,15 @@ instance FromJSONE EntityMap (Recipe Entity) where
|
|||||||
-- recipes from the data file @recipes.yaml@.
|
-- recipes from the data file @recipes.yaml@.
|
||||||
loadRecipes :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text [Recipe Entity])
|
loadRecipes :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text [Recipe Entity])
|
||||||
loadRecipes em = runThrow $ do
|
loadRecipes em = runThrow $ do
|
||||||
fileName <- sendIO $ getDataFileName "recipes.yaml"
|
let f = "recipes.yaml"
|
||||||
res <- sendIO $ decodeFileEither @[Recipe Text] fileName
|
mayFileName <- sendIO $ getDataFileNameSafe f
|
||||||
textRecipes <- res `isRightOr` (from @String @Text . prettyPrintParseException)
|
case mayFileName of
|
||||||
resolveRecipes em textRecipes
|
Nothing -> sendIO (dataNotFound f) >>= throwError
|
||||||
`isSuccessOr` (T.append "Unknown entities in recipe(s): " . T.intercalate ", ")
|
Just fileName -> do
|
||||||
|
res <- sendIO $ decodeFileEither @[Recipe Text] fileName
|
||||||
|
textRecipes <- res `isRightOr` (from @String @Text . prettyPrintParseException)
|
||||||
|
resolveRecipes em textRecipes
|
||||||
|
`isSuccessOr` (T.append "Unknown entities in recipe(s): " . T.intercalate ", ")
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -46,6 +46,7 @@ module Swarm.Game.Scenario (
|
|||||||
-- * Loading from disk
|
-- * Loading from disk
|
||||||
loadScenario,
|
loadScenario,
|
||||||
loadScenarioFile,
|
loadScenarioFile,
|
||||||
|
getScenarioPath,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Algebra (Has)
|
import Control.Algebra (Has)
|
||||||
@ -60,7 +61,7 @@ import Data.Aeson.KeyMap (KeyMap)
|
|||||||
import Data.Aeson.KeyMap qualified as KeyMap
|
import Data.Aeson.KeyMap qualified as KeyMap
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import Data.Map qualified as M
|
import Data.Map qualified as M
|
||||||
import Data.Maybe (isNothing, listToMaybe)
|
import Data.Maybe (catMaybes, isNothing, listToMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Vector qualified as V
|
import Data.Vector qualified as V
|
||||||
@ -68,13 +69,12 @@ import Data.Yaml as Y
|
|||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import GHC.Int (Int64)
|
import GHC.Int (Int64)
|
||||||
import Linear.V2
|
import Linear.V2
|
||||||
import Paths_swarm (getDataFileName)
|
|
||||||
import Swarm.Game.Entity
|
import Swarm.Game.Entity
|
||||||
import Swarm.Game.Recipe
|
import Swarm.Game.Recipe
|
||||||
import Swarm.Game.Robot (TRobot, trobotName)
|
import Swarm.Game.Robot (TRobot, trobotName)
|
||||||
import Swarm.Game.Terrain
|
import Swarm.Game.Terrain
|
||||||
import Swarm.Language.Pipeline (ProcessedTerm)
|
import Swarm.Language.Pipeline (ProcessedTerm)
|
||||||
import Swarm.Util (reflow)
|
import Swarm.Util (getDataFileNameSafe, reflow)
|
||||||
import Swarm.Util.Yaml
|
import Swarm.Util.Yaml
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import System.FilePath ((<.>), (</>))
|
import System.FilePath ((<.>), (</>))
|
||||||
@ -328,11 +328,18 @@ scenarioSolution :: Lens' Scenario (Maybe ProcessedTerm)
|
|||||||
-- | Optionally, specify the maximum number of steps each robot may
|
-- | Optionally, specify the maximum number of steps each robot may
|
||||||
-- take during a single tick.
|
-- take during a single tick.
|
||||||
scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
|
scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- Loading scenarios
|
-- Loading scenarios
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
|
|
||||||
|
getScenarioPath :: FilePath -> IO (Maybe FilePath)
|
||||||
|
getScenarioPath scenario = do
|
||||||
|
libScenario <- getDataFileNameSafe $ "scenarios" </> scenario
|
||||||
|
libScenarioExt <- getDataFileNameSafe $ "scenarios" </> scenario <.> "yaml"
|
||||||
|
|
||||||
|
let candidates = catMaybes [Just scenario, libScenarioExt, libScenario]
|
||||||
|
listToMaybe <$> filterM doesFileExist candidates
|
||||||
|
|
||||||
-- | Load a scenario with a given name from disk, given an entity map
|
-- | Load a scenario with a given name from disk, given an entity map
|
||||||
-- to use. This function is used if a specific scenario is
|
-- to use. This function is used if a specific scenario is
|
||||||
-- requested on the command line.
|
-- requested on the command line.
|
||||||
@ -342,13 +349,7 @@ loadScenario ::
|
|||||||
EntityMap ->
|
EntityMap ->
|
||||||
m (Scenario, FilePath)
|
m (Scenario, FilePath)
|
||||||
loadScenario scenario em = do
|
loadScenario scenario em = do
|
||||||
libScenario <- sendIO $ getDataFileName $ "scenarios" </> scenario
|
mfileName <- sendIO $ getScenarioPath scenario
|
||||||
libScenarioExt <- sendIO $ getDataFileName $ "scenarios" </> scenario <.> "yaml"
|
|
||||||
|
|
||||||
mfileName <-
|
|
||||||
sendIO $
|
|
||||||
listToMaybe <$> filterM doesFileExist [scenario, libScenarioExt, libScenario]
|
|
||||||
|
|
||||||
case mfileName of
|
case mfileName of
|
||||||
Nothing -> throwError @Text $ "Scenario not found: " <> from @String scenario
|
Nothing -> throwError @Text $ "Scenario not found: " <> from @String scenario
|
||||||
Just fileName -> (,fileName) <$> loadScenarioFile em fileName
|
Just fileName -> (,fileName) <$> loadScenarioFile em fileName
|
||||||
|
@ -66,10 +66,9 @@ import Data.Text (Text, pack)
|
|||||||
import Data.Time (NominalDiffTime, ZonedTime, diffUTCTime, zonedTimeToUTC)
|
import Data.Time (NominalDiffTime, ZonedTime, diffUTCTime, zonedTimeToUTC)
|
||||||
import Data.Yaml as Y
|
import Data.Yaml as Y
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Paths_swarm (getDataDir)
|
|
||||||
import Swarm.Game.Entity
|
import Swarm.Game.Entity
|
||||||
import Swarm.Game.Scenario
|
import Swarm.Game.Scenario
|
||||||
import Swarm.Util (getSwarmSavePath)
|
import Swarm.Util (dataNotFound, getDataDirSafe, getSwarmSavePath)
|
||||||
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
|
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
|
||||||
import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
|
import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
|
||||||
import Witch (into)
|
import Witch (into)
|
||||||
@ -213,7 +212,8 @@ normalizeScenarioPath col p =
|
|||||||
then return path
|
then return path
|
||||||
else do
|
else do
|
||||||
canonPath <- canonicalizePath path
|
canonPath <- canonicalizePath path
|
||||||
d <- getDataDir >>= canonicalizePath
|
Just ddir <- getDataDirSafe "." -- no way we got this far without data directory
|
||||||
|
d <- canonicalizePath ddir
|
||||||
let n =
|
let n =
|
||||||
stripPrefix (d </> "scenarios") canonPath
|
stripPrefix (d </> "scenarios") canonPath
|
||||||
& maybe canonPath (dropWhile (== pathSeparator))
|
& maybe canonPath (dropWhile (== pathSeparator))
|
||||||
@ -227,8 +227,11 @@ scenarioCollectionToList (SC (Just order) m) = (m M.!) <$> order
|
|||||||
-- | Load all the scenarios from the scenarios data directory.
|
-- | Load all the scenarios from the scenarios data directory.
|
||||||
loadScenarios :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text ScenarioCollection)
|
loadScenarios :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text ScenarioCollection)
|
||||||
loadScenarios em = runThrow $ do
|
loadScenarios em = runThrow $ do
|
||||||
dataDir <- sendIO getDataDir
|
let p = "scenarios"
|
||||||
loadScenarioDir em (dataDir </> "scenarios")
|
mdataDir <- sendIO $ getDataDirSafe p
|
||||||
|
case mdataDir of
|
||||||
|
Nothing -> sendIO (dataNotFound p) >>= throwError
|
||||||
|
Just dataDir -> loadScenarioDir em dataDir
|
||||||
|
|
||||||
-- | The name of the special file which indicates the order of
|
-- | The name of the special file which indicates the order of
|
||||||
-- scenarios in a folder.
|
-- scenarios in a folder.
|
||||||
|
@ -131,7 +131,6 @@ import Data.Text.IO qualified as T (readFile)
|
|||||||
import Data.Time (getZonedTime)
|
import Data.Time (getZonedTime)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Linear
|
import Linear
|
||||||
import Paths_swarm (getDataFileName)
|
|
||||||
import Swarm.Game.CESK (emptyStore, initMachine)
|
import Swarm.Game.CESK (emptyStore, initMachine)
|
||||||
import Swarm.Game.Entity
|
import Swarm.Game.Entity
|
||||||
import Swarm.Game.Recipe (
|
import Swarm.Game.Recipe (
|
||||||
@ -154,7 +153,7 @@ import Swarm.Language.Pipeline (ProcessedTerm)
|
|||||||
import Swarm.Language.Pipeline.QQ (tmQ)
|
import Swarm.Language.Pipeline.QQ (tmQ)
|
||||||
import Swarm.Language.Syntax (Const, Term (TText), allConst)
|
import Swarm.Language.Syntax (Const, Term (TText), allConst)
|
||||||
import Swarm.Language.Types
|
import Swarm.Language.Types
|
||||||
import Swarm.Util (getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
|
import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
|
||||||
import System.Clock qualified as Clock
|
import System.Clock qualified as Clock
|
||||||
import System.Random (StdGen, mkStdGen, randomRIO)
|
import System.Random (StdGen, mkStdGen, randomRIO)
|
||||||
import Witch (into)
|
import Witch (into)
|
||||||
@ -668,9 +667,10 @@ initGameState = do
|
|||||||
let markEx what a = catchError a (\e -> fail $ "Failed to " <> what <> ": " <> show e)
|
let markEx what a = catchError a (\e -> fail $ "Failed to " <> what <> ": " <> show e)
|
||||||
|
|
||||||
(adjs, names) <- liftIO . markEx "load name generation data" $ do
|
(adjs, names) <- liftIO . markEx "load name generation data" $ do
|
||||||
adjsFile <- getDataFileName "adjectives.txt"
|
-- if data directory did not exist we would have failed loading scenarios
|
||||||
|
Just adjsFile <- getDataFileNameSafe "adjectives.txt"
|
||||||
as <- tail . T.lines <$> T.readFile adjsFile
|
as <- tail . T.lines <$> T.readFile adjsFile
|
||||||
namesFile <- getDataFileName "names.txt"
|
Just namesFile <- getDataFileNameSafe "names.txt"
|
||||||
ns <- tail . T.lines <$> T.readFile namesFile
|
ns <- tail . T.lines <$> T.readFile namesFile
|
||||||
return (as, ns)
|
return (as, ns)
|
||||||
|
|
||||||
|
@ -63,6 +63,9 @@ module Swarm.Util (
|
|||||||
|
|
||||||
-- * Utilities for NP-hard approximation
|
-- * Utilities for NP-hard approximation
|
||||||
smallHittingSet,
|
smallHittingSet,
|
||||||
|
getDataDirSafe,
|
||||||
|
getDataFileNameSafe,
|
||||||
|
dataNotFound,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Algebra (Has)
|
import Control.Algebra (Has)
|
||||||
@ -101,6 +104,8 @@ import System.Clock (TimeSpec)
|
|||||||
import System.Directory (
|
import System.Directory (
|
||||||
XdgDirectory (XdgData),
|
XdgDirectory (XdgData),
|
||||||
createDirectoryIfMissing,
|
createDirectoryIfMissing,
|
||||||
|
doesDirectoryExist,
|
||||||
|
doesFileExist,
|
||||||
getXdgDirectory,
|
getXdgDirectory,
|
||||||
listDirectory,
|
listDirectory,
|
||||||
)
|
)
|
||||||
@ -210,6 +215,43 @@ readFileMayT = catchIO . T.readFile
|
|||||||
catchIO :: IO a -> IO (Maybe a)
|
catchIO :: IO a -> IO (Maybe a)
|
||||||
catchIO act = (Just <$> act) `catchIOError` (\_ -> return Nothing)
|
catchIO act = (Just <$> act) `catchIOError` (\_ -> return Nothing)
|
||||||
|
|
||||||
|
getDataDirSafe :: FilePath -> IO (Maybe FilePath)
|
||||||
|
getDataDirSafe p = do
|
||||||
|
d <- mySubdir <$> getDataDir
|
||||||
|
de <- doesDirectoryExist d
|
||||||
|
if de
|
||||||
|
then return $ Just d
|
||||||
|
else do
|
||||||
|
xd <- mySubdir . (</> "data") <$> getSwarmDataPath False
|
||||||
|
xde <- doesDirectoryExist xd
|
||||||
|
return $ if xde then Just xd else Nothing
|
||||||
|
where
|
||||||
|
mySubdir d = d `appDir` p
|
||||||
|
appDir r = \case
|
||||||
|
"" -> r
|
||||||
|
"." -> r
|
||||||
|
d -> r </> d
|
||||||
|
|
||||||
|
getDataFileNameSafe :: FilePath -> IO (Maybe FilePath)
|
||||||
|
getDataFileNameSafe name = do
|
||||||
|
dir <- getDataDirSafe "."
|
||||||
|
case dir of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just d -> do
|
||||||
|
let fp = d </> name
|
||||||
|
fe <- doesFileExist fp
|
||||||
|
return $ if fe then Just fp else Nothing
|
||||||
|
|
||||||
|
dataNotFound :: FilePath -> IO Text
|
||||||
|
dataNotFound f = do
|
||||||
|
d <- getSwarmDataPath False
|
||||||
|
let squotes = squote . T.pack
|
||||||
|
return $
|
||||||
|
T.unlines
|
||||||
|
[ "Could not find the data: " <> squotes f
|
||||||
|
, "Try downloading the Swarm 'data' directory to: " <> squotes d
|
||||||
|
]
|
||||||
|
|
||||||
-- | Get path to swarm data, optionally creating necessary
|
-- | Get path to swarm data, optionally creating necessary
|
||||||
-- directories.
|
-- directories.
|
||||||
getSwarmDataPath :: Bool -> IO FilePath
|
getSwarmDataPath :: Bool -> IO FilePath
|
||||||
@ -236,14 +278,17 @@ getSwarmHistoryPath createDirs =
|
|||||||
-- | Read all the .txt files in the data/ directory.
|
-- | Read all the .txt files in the data/ directory.
|
||||||
readAppData :: IO (Map Text Text)
|
readAppData :: IO (Map Text Text)
|
||||||
readAppData = do
|
readAppData = do
|
||||||
d <- getDataDir
|
md <- getDataDirSafe "."
|
||||||
fs <-
|
case md of
|
||||||
filter ((== ".txt") . takeExtension)
|
Nothing -> fail . T.unpack =<< dataNotFound "<the data directory itself>"
|
||||||
<$> ( listDirectory d `catch` \e ->
|
Just d -> do
|
||||||
hPutStr stderr (show (e :: IOException)) >> return []
|
fs <-
|
||||||
)
|
filter ((== ".txt") . takeExtension)
|
||||||
M.fromList . mapMaybe sequenceA
|
<$> ( listDirectory d `catch` \e ->
|
||||||
<$> forM fs (\f -> (into @Text (dropExtension f),) <$> readFileMayT (d </> f))
|
hPutStr stderr (show (e :: IOException)) >> return []
|
||||||
|
)
|
||||||
|
M.fromList . mapMaybe sequenceA
|
||||||
|
<$> forM fs (\f -> (into @Text (dropExtension f),) <$> readFileMayT (d </> f))
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- Some Text-y stuff
|
-- Some Text-y stuff
|
||||||
|
Loading…
Reference in New Issue
Block a user