Merge pull request #5919 from drlkf/master

Add XDG support

CONTRIBUTING.md

@@ -190,7 +190,7 @@ updates with your pull request.
 ## Backwards Compatability
 
 The Stack executable does not need to, and does not, strive for the same broad
-compatability with versions of GHC that a library package (such as `pantry`)
+compatibility with versions of GHC that a library package (such as `pantry`)
 would seek. Instead, Stack aims to define a well-known combination of
 dependencies on which its executable relies. That applies in particular to the
 `Cabal` package, where Stack aims to support one, and only one, version of

ChangeLog.md

@@ -30,6 +30,8 @@ Other enhancements:
   likely overwrite on upgrade.
 * Add `stack ls dependencies cabal` command, which lists dependencies in the
   format of exact Cabal constraints.
+* Add `STACK_XDG` environment variable to use the XDG directory specification
+  for the Stack root.
 
 Bug fixes:
 

doc/GUIDE.md

@@ -1764,6 +1764,16 @@ stack path --stack-root
 The location of the Stack root can be configured by setting the `STACK_ROOT`
 environment variable or using Stack's `--stack-root` option on the command line.
 
+Alternatively, Stack can follow the XDG specification by setting the `STACK_XDG`
+environment variable to anything non-empty:
+
+~~~bash
+export STACK_XDG=1
+~~~
+
+The global `config.yaml` will then go in `$XDG_CONFIG_HOME/stack` and the Stack
+root will be located in `$XDG_DATA_HOME/stack`.
+
 On Windows, the length of filepaths may be limited (to
 [MAX_PATH](https://docs.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation?tabs=cmd)),
 and things can break when this limit is exceeded. Setting a Stack root with a

src/Stack/Config.hs

@@ -486,15 +486,15 @@ loadConfig inner = do
     mproject <- loadProjectConfig mstackYaml
     mresolver <- view $ globalOptsL.to globalResolver
     configArgs <- view $ globalOptsL.to globalConfigMonoid
-    (stackRoot, userOwnsStackRoot) <- determineStackRootAndOwnership configArgs
+    (configRoot, stackRoot, userOwnsStackRoot) <- determineStackRootAndOwnership configArgs
 
     let (mproject', addConfigMonoid) =
           case mproject of
             PCProject (proj, fp, cm) -> (PCProject (proj, fp), (cm:))
             PCGlobalProject -> (PCGlobalProject, id)
             PCNoProject deps -> (PCNoProject deps, id)
 
-    userConfigPath <- getDefaultUserConfigPath stackRoot
+    userConfigPath <- getDefaultUserConfigPath configRoot
     extraConfigs0 <- getExtraConfigs userConfigPath >>=
         mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file)
     let extraConfigs =
@@ -751,19 +751,29 @@ determineStackRootAndOwnership
     :: (MonadIO m)
     => ConfigMonoid
     -- ^ Parsed command-line arguments
-    -> m (Path Abs Dir, Bool)
+    -> m (Path Abs Dir, Path Abs Dir, Bool)
 determineStackRootAndOwnership clArgs = liftIO $ do
-    stackRoot <- do
+    (configRoot, stackRoot) <- do
         case getFirst (configMonoidStackRoot clArgs) of
-            Just x -> pure x
+            Just x -> pure (x, x)
             Nothing -> do
                 mstackRoot <- lookupEnv stackRootEnvVar
                 case mstackRoot of
-                    Nothing -> getAppUserDataDir stackProgName
+                    Nothing -> do
+                      wantXdg <- fromMaybe "" <$> lookupEnv stackXdgEnvVar
+                      if not (null wantXdg)
+                        then do
+                          xdgRelDir <- parseRelDir stackProgName
+                          (,)
+                            <$> getXdgDir XdgConfig (Just xdgRelDir)
+                            <*> getXdgDir XdgData (Just xdgRelDir)
+                        else do
+                          oldStyleRoot <- getAppUserDataDir stackProgName
+                          pure (oldStyleRoot, oldStyleRoot)
                     Just x -> case parseAbsDir x of
                         Nothing ->
                             throwIO $ ParseAbsolutePathException stackRootEnvVar x
-                        Just parsed -> pure parsed
+                        Just parsed -> pure (parsed, parsed)
 
     (existingStackRootOrParentDir, userOwnsIt) <- do
         mdirAndOwnership <- findInParents getDirAndOwnership stackRoot
@@ -779,8 +789,9 @@ determineStackRootAndOwnership clArgs = liftIO $ do
                     stackRoot
                     existingStackRootOrParentDir
 
+    configRoot' <- canonicalizePath configRoot
     stackRoot' <- canonicalizePath stackRoot
-    pure (stackRoot', userOwnsIt)
+    pure (configRoot', stackRoot', userOwnsIt)
 
 -- | @'checkOwnership' dir@ throws 'UserDoesn'tOwnDirectory' if @dir@
 -- isn't owned by the current user.

src/Stack/Constants.hs

@@ -13,7 +13,9 @@ module Stack.Constants
     ,stackDotYaml
     ,stackWorkEnvVar
     ,stackRootEnvVar
+    ,stackXdgEnvVar
     ,stackRootOptionName
+    ,stackGlobalConfigOptionName
     ,pantryRootEnvVar
     ,deprecatedStackRootOptionName
     ,inContainerEnvVar
@@ -163,10 +165,18 @@ stackWorkEnvVar = "STACK_WORK"
 stackRootEnvVar :: String
 stackRootEnvVar = "STACK_ROOT"
 
+-- | Environment variable used to indicate XDG directories should be used.
+stackXdgEnvVar :: String
+stackXdgEnvVar = "STACK_XDG"
+
 -- | Option name for the global Stack root.
 stackRootOptionName :: String
 stackRootOptionName = "stack-root"
 
+-- | Option name for the global Stack configuration file.
+stackGlobalConfigOptionName :: String
+stackGlobalConfigOptionName = "global-config"
+
 -- | Environment variable used to override the location of the Pantry store
 pantryRootEnvVar :: String
 pantryRootEnvVar = "PANTRY_ROOT"

src/Stack/Path.hs

@@ -152,6 +152,9 @@ paths =
     [ ( "Global Stack root directory"
       , T.pack stackRootOptionName
       , WithoutHaddocks $ view (stackRootL.to toFilePathNoTrailingSep.to T.pack))
+    , ( "Global Stack configuration file"
+      , T.pack stackGlobalConfigOptionName
+      , WithoutHaddocks $ view (stackGlobalConfigL.to toFilePath.to T.pack))
     , ( "Project root (derived from stack.yaml file)"
       , "project-root"
       , WithoutHaddocks $ view (projectRootL.to toFilePathNoTrailingSep.to T.pack))

src/Stack/Types/Config.hs

@@ -169,6 +169,7 @@ module Stack.Types.Config
   ,buildOptsHaddockL
   ,globalOptsBuildOptsMonoidL
   ,stackRootL
+  ,stackGlobalConfigL
   ,cabalVersionL
   ,whichCompilerL
   ,envOverrideSettingsL
@@ -2038,6 +2039,9 @@ instance HasTerm EnvConfig where
 stackRootL :: HasConfig s => Lens' s (Path Abs Dir)
 stackRootL = configL.lens configStackRoot (\x y -> x { configStackRoot = y })
 
+stackGlobalConfigL :: HasConfig s => Lens' s (Path Abs File)
+stackGlobalConfigL = configL.lens configUserConfigPath (\x y -> x { configUserConfigPath = y })
+
 -- | The compiler specified by the @SnapshotDef@. This may be
 -- different from the actual compiler used!
 wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler