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.

app/Main.hs

@@ -99,7 +99,7 @@ formatFile input = do
       Text.putStrLn content
       exitSuccess
     Left e -> do
-      Text.putStrLn $ showInput input <> ":" <> e
+      Text.hPutStrLn stderr $ showInput input <> ":" <> e
       exitFailure
 
 showVersion :: IO ()

src/Swarm/App.hs

@@ -26,6 +26,7 @@ import Swarm.TUI.Model
 import Swarm.TUI.View
 import Swarm.Version (getNewerReleaseVersion)
 import Swarm.Web
+import System.IO (stderr)
 
 type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()
 
@@ -46,7 +47,7 @@ appMain :: AppOpts -> IO ()
 appMain opts = do
   res <- runExceptT $ initAppState opts
   case res of
-    Left errMsg -> T.putStrLn errMsg
+    Left errMsg -> T.hPutStrLn stderr errMsg
     Right s -> do
       -- Send Frame events as at a reasonable rate for 30 fps. The
       -- game is responsible for figuring out how many steps to take

src/Swarm/Game/Entity.hs

@@ -103,10 +103,9 @@ import Data.Text qualified as T
 import Data.Yaml
 import GHC.Generics (Generic)
 import Linear (V2)
-import Paths_swarm
 import Swarm.Game.Display
 import Swarm.Language.Capability
-import Swarm.Util (plural, reflow, (?))
+import Swarm.Util (dataNotFound, getDataFileNameSafe, plural, reflow, (?))
 import Swarm.Util.Yaml
 import Text.Read (readMaybe)
 import Witch
@@ -362,8 +361,11 @@ instance ToJSON Entity where
 --   either an 'EntityMap' or a pretty-printed parse error.
 loadEntities :: MonadIO m => m (Either Text EntityMap)
 loadEntities = liftIO $ do
-  fileName <- getDataFileName "entities.yaml"
-  bimap (from . prettyPrintParseException) buildEntityMap <$> decodeFileEither fileName
+  let f = "entities.yaml"
+  mayFileName <- getDataFileNameSafe f
+  case mayFileName of
+    Nothing -> Left <$> dataNotFound f
+    Just fileName -> bimap (from . prettyPrintParseException) buildEntityMap <$> decodeFileEither fileName
 
 ------------------------------------------------------------
 -- Entity lenses

src/Swarm/Game/Recipe.hs

@@ -51,8 +51,7 @@ import Witch
 
 import Control.Algebra (Has)
 import Control.Carrier.Lift (Lift, sendIO)
-import Control.Carrier.Throw.Either (runThrow)
-import Paths_swarm
+import Control.Carrier.Throw.Either (runThrow, throwError)
 import Swarm.Game.Entity as E
 import Swarm.Util
 import Swarm.Util.Yaml
@@ -143,11 +142,15 @@ instance FromJSONE EntityMap (Recipe Entity) where
 --   recipes from the data file @recipes.yaml@.
 loadRecipes :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text [Recipe Entity])
 loadRecipes em = runThrow $ do
-  fileName <- sendIO $ getDataFileName "recipes.yaml"
-  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 ", ")
+  let f = "recipes.yaml"
+  mayFileName <- sendIO $ getDataFileNameSafe f
+  case mayFileName of
+    Nothing -> sendIO (dataNotFound f) >>= throwError
+    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 ", ")
 
 ------------------------------------------------------------
 

src/Swarm/Game/Scenario.hs

@@ -46,6 +46,7 @@ module Swarm.Game.Scenario (
   -- * Loading from disk
   loadScenario,
   loadScenarioFile,
+  getScenarioPath,
 ) where
 
 import Control.Algebra (Has)
@@ -60,7 +61,7 @@ import Data.Aeson.KeyMap (KeyMap)
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Map (Map)
 import Data.Map qualified as M
-import Data.Maybe (isNothing, listToMaybe)
+import Data.Maybe (catMaybes, isNothing, listToMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Vector qualified as V
@@ -68,13 +69,12 @@ import Data.Yaml as Y
 import GHC.Generics (Generic)
 import GHC.Int (Int64)
 import Linear.V2
-import Paths_swarm (getDataFileName)
 import Swarm.Game.Entity
 import Swarm.Game.Recipe
 import Swarm.Game.Robot (TRobot, trobotName)
 import Swarm.Game.Terrain
 import Swarm.Language.Pipeline (ProcessedTerm)
-import Swarm.Util (reflow)
+import Swarm.Util (getDataFileNameSafe, reflow)
 import Swarm.Util.Yaml
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
@@ -328,11 +328,18 @@ scenarioSolution :: Lens' Scenario (Maybe ProcessedTerm)
 -- | Optionally, specify the maximum number of steps each robot may
 --   take during a single tick.
 scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
-
 ------------------------------------------------------------
 -- 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
 --   to use.  This function is used if a specific scenario is
 --   requested on the command line.
@@ -342,13 +349,7 @@ loadScenario ::
   EntityMap ->
   m (Scenario, FilePath)
 loadScenario scenario em = do
-  libScenario <- sendIO $ getDataFileName $ "scenarios" </> scenario
-  libScenarioExt <- sendIO $ getDataFileName $ "scenarios" </> scenario <.> "yaml"
-
-  mfileName <-
-    sendIO $
-      listToMaybe <$> filterM doesFileExist [scenario, libScenarioExt, libScenario]
-
+  mfileName <- sendIO $ getScenarioPath scenario
   case mfileName of
     Nothing -> throwError @Text $ "Scenario not found: " <> from @String scenario
     Just fileName -> (,fileName) <$> loadScenarioFile em fileName

src/Swarm/Game/ScenarioInfo.hs

@@ -66,10 +66,9 @@ import Data.Text (Text, pack)
 import Data.Time (NominalDiffTime, ZonedTime, diffUTCTime, zonedTimeToUTC)
 import Data.Yaml as Y
 import GHC.Generics (Generic)
-import Paths_swarm (getDataDir)
 import Swarm.Game.Entity
 import Swarm.Game.Scenario
-import Swarm.Util (getSwarmSavePath)
+import Swarm.Util (dataNotFound, getDataDirSafe, getSwarmSavePath)
 import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
 import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
 import Witch (into)
@@ -213,7 +212,8 @@ normalizeScenarioPath col p =
         then return path
         else do
           canonPath <- canonicalizePath path
-          d <- getDataDir >>= canonicalizePath
+          Just ddir <- getDataDirSafe "." -- no way we got this far without data directory
+          d <- canonicalizePath ddir
           let n =
                 stripPrefix (d </> "scenarios") canonPath
                   & 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.
 loadScenarios :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text ScenarioCollection)
 loadScenarios em = runThrow $ do
-  dataDir <- sendIO getDataDir
-  loadScenarioDir em (dataDir </> "scenarios")
+  let p = "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
 --   scenarios in a folder.

src/Swarm/Game/State.hs

@@ -131,7 +131,6 @@ import Data.Text.IO qualified as T (readFile)
 import Data.Time (getZonedTime)
 import GHC.Generics (Generic)
 import Linear
-import Paths_swarm (getDataFileName)
 import Swarm.Game.CESK (emptyStore, initMachine)
 import Swarm.Game.Entity
 import Swarm.Game.Recipe (
@@ -154,7 +153,7 @@ import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Syntax (Const, Term (TText), allConst)
 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.Random (StdGen, mkStdGen, randomRIO)
 import Witch (into)
@@ -668,9 +667,10 @@ initGameState = do
   let markEx what a = catchError a (\e -> fail $ "Failed to " <> what <> ": " <> show e)
 
   (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
-    namesFile <- getDataFileName "names.txt"
+    Just namesFile <- getDataFileNameSafe "names.txt"
     ns <- tail . T.lines <$> T.readFile namesFile
     return (as, ns)
 

src/Swarm/Util.hs

@@ -63,6 +63,9 @@ module Swarm.Util (
 
   -- * Utilities for NP-hard approximation
   smallHittingSet,
+  getDataDirSafe,
+  getDataFileNameSafe,
+  dataNotFound,
 ) where
 
 import Control.Algebra (Has)
@@ -101,6 +104,8 @@ import System.Clock (TimeSpec)
 import System.Directory (
   XdgDirectory (XdgData),
   createDirectoryIfMissing,
+  doesDirectoryExist,
+  doesFileExist,
   getXdgDirectory,
   listDirectory,
  )
@@ -210,6 +215,43 @@ readFileMayT = catchIO . T.readFile
 catchIO :: IO a -> IO (Maybe a)
 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
 --   directories.
 getSwarmDataPath :: Bool -> IO FilePath
@@ -236,14 +278,17 @@ getSwarmHistoryPath createDirs =
 -- | Read all the .txt files in the data/ directory.
 readAppData :: IO (Map Text Text)
 readAppData = do
-  d <- getDataDir
-  fs <-
-    filter ((== ".txt") . takeExtension)
-      <$> ( listDirectory d `catch` \e ->
-              hPutStr stderr (show (e :: IOException)) >> return []
-          )
-  M.fromList . mapMaybe sequenceA
-    <$> forM fs (\f -> (into @Text (dropExtension f),) <$> readFileMayT (d </> f))
+  md <- getDataDirSafe "."
+  case md of
+    Nothing -> fail . T.unpack =<< dataNotFound "<the data directory itself>"
+    Just d -> do
+      fs <-
+        filter ((== ".txt") . takeExtension)
+          <$> ( listDirectory d `catch` \e ->
+                  hPutStr stderr (show (e :: IOException)) >> return []
+              )
+      M.fromList . mapMaybe sequenceA
+        <$> forM fs (\f -> (into @Text (dropExtension f),) <$> readFileMayT (d </> f))
 
 ------------------------------------------------------------
 -- Some Text-y stuff