Merge pull request #6117 from commercialhaskell/fix5203

Fix #5203 Put GHCi configuration scripts in a user-specific location

ChangeLog.md

@@ -10,6 +10,12 @@ Major changes:
 
 Behavior changes:
 
+* Use `$XDG_CACHE_HOME/stack/ghci-script`, rather than `<temp>/haskell-stack-ghci`
+  (where `<temp>` is the directory yielded by the `temporary` package's
+  `System.IO.Temp.getCanonicalTemporaryDirectory`), as the base location for
+  GHCi script files generated by `stack ghci` or `stack repl`. See
+  [#5203](https://github.com/commercialhaskell/stack/issues/5203)
+
 Other enhancements:
 
 Bug fixes:

doc/ghci.md

@@ -29,6 +29,14 @@ but not another is quite likely to cause failures. GHCi will be run with
 `-XNoImplicitPrelude`, but it is likely that modules in the other component
 assume that the `Prelude` is implicitly imported.
 
+`stack ghci` configures GHCi by using a GHCi script file. Such files are located
+in subdirectories of `<XDG_CACHE_HOME>/stack/ghci-script`, where
+`<XDG_CACHE_HOME>` refers to the
+[XDG Base Directory Specification](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html)
+for user-specific non-essential (cached) data. On Unix-like operating systems,
+the default for `<XDG_CACHE_HOME>` is `$HOME/.cache`. On Windows, the default
+is `%LOCALAPPDATA%`.
+
 ## Selecting Main module
 
 When loading multiple packages, there may be multiple definitions for the `Main`

package.yaml

@@ -125,7 +125,6 @@ dependencies:
 - streaming-commons
 - tar
 - template-haskell
-- temporary
 - text
 - text-metrics
 - th-reify-many

src/Data/Attoparsec/Interpreter.hs

@@ -61,6 +61,7 @@ import           Conduit ( decodeUtf8C, withSourceFile )
 import           Data.Conduit.Attoparsec ( ParseError (..), Position (..), sinkParserEither )
 import           Data.List ( intercalate )
 import           Data.Text ( pack )
+import           Stack.Constants ( stackProgName )
 import           Stack.Prelude
 import           System.FilePath ( takeExtension )
 import           System.IO ( hPutStrLn )

src/Stack/Build/Execute.hs

@@ -113,7 +113,7 @@ import           Stack.Constants
                    , relDirSetupExeCache, relDirSetupExeSrc, relFileBuildLock
                    , relFileConfigure, relFileSetupHs, relFileSetupLhs
                    , relFileSetupLower, relFileSetupMacrosH, setupGhciShimCode
-                   , testGhcEnvRelFile
+                   , stackProgName, testGhcEnvRelFile
                    )
 import           Stack.Constants.Config
                    ( distDirFromDir, distRelativeDir, hpcDirFromDir

src/Stack/Config.hs

@@ -85,8 +85,8 @@ import           Stack.Constants
                    , platformVariantEnvVar, relDirBin, relDirStackWork
                    , relFileReadmeTxt, relFileStorage, relDirPantry
                    , relDirPrograms, relDirStackProgName, relDirUpperPrograms
-                   , stackDeveloperModeDefault, stackDotYaml, stackRootEnvVar
-                   , stackWorkEnvVar, stackXdgEnvVar
+                   , stackDeveloperModeDefault, stackDotYaml, stackProgName
+                   , stackRootEnvVar, stackWorkEnvVar, stackXdgEnvVar
                    )
 import           Stack.Lock ( lockCachedWanted )
 import           Stack.Prelude

src/Stack/Constants.hs

@@ -10,6 +10,8 @@ module Stack.Constants
   , buildPlanCacheDir
   , haskellFileExts
   , haskellDefaultPreprocessorExts
+  , stackProgName
+  , stackProgName'
   , stackDotYaml
   , stackWorkEnvVar
   , stackRootEnvVar
@@ -44,6 +46,8 @@ module Stack.Constants
   , relFileCabalMacrosH
   , relDirBuild
   , relDirBin
+  , relDirGhci
+  , relDirGhciScript
   , relDirPantry
   , relDirPrograms
   , relDirUpperPrograms
@@ -88,7 +92,6 @@ module Stack.Constants
   , relDirAll
   , relFilePackageCache
   , relFileDockerfile
-  , relDirHaskellStackGhci
   , relFileGhciScript
   , relDirCombined
   , relFileHpcIndexHtml
@@ -134,10 +137,12 @@ import           Data.ByteString.Builder ( byteString )
 import           Data.Char ( toUpper )
 import           Data.FileEmbed ( embedFile, makeRelativeToProject )
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import           Distribution.Package ( mkPackageName )
 import           Hpack.Config ( packageConfig )
 import qualified Language.Haskell.TH.Syntax as TH ( runIO, lift )
 import           Path ( (</>), mkRelDir, mkRelFile, parseAbsFile )
+import           Stack.Constants.StackProgName ( stackProgName )
 import           Stack.Constants.UsrLibDirs ( usrLibDirs )
 import           Stack.Prelude
 import           Stack.Types.Compiler ( WhichCompiler (..) )
@@ -154,6 +159,10 @@ instance Exception ConstantsException where
   displayException WiredInPackagesNotParsedBug = bugReport "[S-6057]"
     "Parse error in wiredInPackages."
 
+-- | Name of the Stack program.
+stackProgName' :: Text
+stackProgName' = T.pack stackProgName
+
 -- | Extensions used for Haskell modules. Excludes preprocessor ones.
 haskellFileExts :: [Text]
 haskellFileExts = ["hs", "hsc", "lhs"]
@@ -357,6 +366,12 @@ relDirBuild = $(mkRelDir "build")
 relDirBin :: Path Rel Dir
 relDirBin = $(mkRelDir "bin")
 
+relDirGhci :: Path Rel Dir
+relDirGhci = $(mkRelDir "ghci")
+
+relDirGhciScript :: Path Rel Dir
+relDirGhciScript = $(mkRelDir "ghci-script")
+
 relDirPantry :: Path Rel Dir
 relDirPantry = $(mkRelDir "pantry")
 
@@ -493,9 +508,6 @@ relFilePackageCache = $(mkRelFile "package.cache")
 relFileDockerfile :: Path Rel File
 relFileDockerfile = $(mkRelFile "Dockerfile")
 
-relDirHaskellStackGhci :: Path Rel Dir
-relDirHaskellStackGhci = $(mkRelDir "haskell-stack-ghci")
-
 relFileGhciScript :: Path Rel File
 relFileGhciScript = $(mkRelFile "ghci-script")
 

src/Stack/Constants/Config.hs

@@ -24,7 +24,8 @@ module Stack.Constants.Config
   ) where
 
 import           Path ( (</>), mkRelDir, mkRelFile, parseRelDir )
-import           Stack.Constants ( cabalPackageName )
+import           Stack.Constants
+                   ( cabalPackageName, relDirDist, relDirGhci, relDirHpc )
 import           Stack.Prelude
 import           Stack.Types.BuildConfig ( HasBuildConfig, projectRootL )
 import           Stack.Types.CompilerPaths ( cabalVersionL )
@@ -44,7 +45,7 @@ ghciDirL :: HasBuildConfig env => Getting r env (Path Abs Dir)
 ghciDirL = to $ \env -> -- FIXME is this idiomatic lens code?
   let workDir = view workDirL env
       root = view projectRootL env
-  in  root </> workDir </> $(mkRelDir "ghci/")
+  in  root </> workDir </> relDirGhci
 
 -- | The directory containing the files used for dirtiness check of source files.
 buildCachesDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
@@ -112,7 +113,7 @@ hpcDirFromDir fp =
 hpcRelativeDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                => m (Path Rel Dir)
 hpcRelativeDir =
-  fmap (</> $(mkRelDir "hpc")) distRelativeDir
+  fmap (</> relDirHpc) distRelativeDir
 
 -- | Package's setup-config storing Cabal configuration
 setupConfigFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
@@ -145,7 +146,7 @@ rootDistRelativeDir ::
   => m (Path Rel Dir)
 rootDistRelativeDir = do
     workDir <- view workDirL
-    pure $ workDir </> $(mkRelDir "dist")
+    pure $ workDir </> relDirDist
 
 -- | Package's working directory.
 workDirFromDir :: (MonadReader env m, HasConfig env)

src/Stack/Constants/StackProgName.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Constants.StackProgName
+  ( stackProgName
+  ) where
+
+import           Stack.Prelude ( String )
+
+-- | Name of the Stack program.
+
+-- NOTE: Defined in this module rather than in "Stack.Constants", due to
+-- GHC stage restrictions and the use of Template Haskell.
+stackProgName :: String
+stackProgName = "stack"

src/Stack/Ghci.hs

@@ -25,9 +25,10 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import qualified Distribution.PackageDescription as C
-import           Path ((</>), parent, parseAbsDir, parseRelFile )
+import           Path ((</>), parent, parseRelFile )
 import           Path.Extra ( forgivingResolveFile', toFilePathNoTrailingSep )
-import           Path.IO ( doesFileExist, ensureDir )
+import           Path.IO
+                   ( XdgDirectory (..), doesFileExist, ensureDir, getXdgDir )
 import           RIO.Process
                    ( HasProcessContext, exec, proc, readProcess_
                    , withWorkingDir
@@ -38,8 +39,8 @@ import           Stack.Build.Source
                    ( getLocalFlags, localDependencies, projectLocalPackages )
 import           Stack.Build.Target ( NeedTargets (..), parseTargets )
 import           Stack.Constants
-                   ( relDirHaskellStackGhci, relFileCabalMacrosH
-                   , relFileGhciScript
+                   ( relDirGhciScript, relDirStackProgName, relFileCabalMacrosH
+                   , relFileGhciScript, stackProgName'
                    )
 import           Stack.Constants.Config ( ghciDirL, objectInterfaceDirL )
 import           Stack.Ghci.Script
@@ -85,7 +86,6 @@ import           Stack.Types.SourceMap
                    , SMTargets (..), SMWanted (..), SourceMap (..), Target (..)
                    )
 import           System.IO ( putStrLn )
-import           System.IO.Temp ( getCanonicalTemporaryDirectory )
 import           System.Permissions ( setScriptPerms )
 
 -- | Type representing exceptions thrown by functions exported by the
@@ -566,9 +566,8 @@ runGhci GhciOpts{..} targets mainFile pkgs extraFiles exposePackages = do
     -- file names are determined by hashing. This also has the nice side
     -- effect of making it possible to copy the ghci invocation out of
     -- the log and have it still work.
-    tmpDirectory <-
-        (</> relDirHaskellStackGhci) <$>
-        (parseAbsDir =<< liftIO getCanonicalTemporaryDirectory)
+    tmpDirectory <- getXdgDir XdgCache $
+      Just (relDirStackProgName </> relDirGhciScript)
     ghciDir <- view ghciDirL
     ensureDir ghciDir
     ensureDir tmpDirectory

src/Stack/Hoogle.hs

@@ -19,6 +19,7 @@ import qualified RIO.Map as Map
 import           RIO.Process ( findExecutable, proc, readProcess_, runProcess_)
 import qualified Stack.Build ( build )
 import           Stack.Build.Target ( NeedTargets (NeedTargets) )
+import           Stack.Constants ( stackProgName' )
 import           Stack.Prelude
 import           Stack.Runners
                    ( ShouldReexec (..), withConfig, withDefaultEnvConfig

src/Stack/Init.hs

@@ -41,7 +41,7 @@ import           Stack.BuildPlan
                    , removeSrcPkgDefaultFlags, selectBestSnapshot
                    )
 import           Stack.Config ( getSnapshots, makeConcreteResolver )
-import           Stack.Constants ( stackDotYaml )
+import           Stack.Constants ( stackDotYaml, stackProgName' )
 import           Stack.Prelude
 import           Stack.Runners
                    ( ShouldReexec (..), withConfig, withGlobalProject )

src/Stack/Options/DockerParser.hs

@@ -17,6 +17,7 @@ import           Options.Applicative.Builder.Extra
                    , firstBoolFlagsFalse, firstBoolFlagsNoDefault
                    , firstBoolFlagsTrue, optionalFirst
                    )
+import           Stack.Constants ( stackProgName )
 import           Stack.Docker ( dockerCmdName )
 import           Stack.Prelude
 import           Stack.Options.Utils ( hideMods )

src/Stack/Prelude.hs

@@ -13,8 +13,6 @@ module Stack.Prelude
   , prompt
   , promptPassword
   , promptBool
-  , stackProgName
-  , stackProgName'
   , FirstTrue (..)
   , fromFirstTrue
   , defaultFirstTrue
@@ -259,16 +257,6 @@ promptBool txt = liftIO $ do
       T.putStrLn "Please press either 'y' or 'n', and then enter."
       promptBool txt
 
--- | Name of the 'stack' program.
---
--- NOTE: Should be defined in "Stack.Constants", but not doing so due to the
--- GHC stage restrictions.
-stackProgName :: String
-stackProgName = "stack"
-
-stackProgName' :: Text
-stackProgName' = T.pack stackProgName
-
 -- | Like @First Bool@, but the default is @True@.
 newtype FirstTrue
   = FirstTrue { getFirstTrue :: Maybe Bool }

src/Stack/SDist.hs

@@ -51,6 +51,7 @@ import           Stack.Build.Execute
                    )
 import           Stack.Build.Installed ( getInstalled, toInstallMap )
 import           Stack.Build.Source ( projectLocalPackages )
+import           Stack.Constants ( stackProgName, stackProgName' )
 import           Stack.Constants.Config ( distDirFromDir )
 import           Stack.Package
                    ( PackageDescriptionPair (..), resolvePackage

src/Stack/Setup.hs

@@ -93,7 +93,7 @@ import           Stack.Constants
                    , relFileLibgmpSo3, relFileLibncurseswSo6, relFileLibtinfoSo5
                    , relFileLibtinfoSo6, relFileMainHs, relFileStack
                    , relFileStackDotExe, relFileStackDotTmp
-                   , relFileStackDotTmpDotExe, usrLibDirs
+                   , relFileStackDotTmpDotExe, stackProgName, usrLibDirs
                    )
 import           Stack.Constants.Config ( distRelativeDir )
 import           Stack.GhcPkg

src/Stack/SourceMap.hs

@@ -31,6 +31,7 @@ import qualified Pantry.SHA256 as SHA256
 import qualified RIO.Map as Map
 import           RIO.Process ( HasProcessContext )
 import qualified RIO.Set as Set
+import           Stack.Constants ( stackProgName' )
 import           Stack.PackageDump ( conduitDumpPackage, ghcPkgDump )
 import           Stack.Prelude
 import           Stack.Types.Build.Exception ( BuildPrettyException (..) )

src/Stack/Types/Docker.hs

@@ -50,6 +50,7 @@ import           Distribution.Version ( anyVersion )
 import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
 import           Pantry.Internal.AesonExtended
 import           Path
+import           Stack.Constants ( stackProgName )
 import           Stack.Prelude hiding ( Display (..) )
 import           Stack.Types.Version
 import           Text.Read ( Read (..) )

src/main/Main.hs

@@ -10,6 +10,7 @@ import           BuildInfo ( versionString' )
 import           GHC.IO.Encoding ( mkTextEncoding, textEncodingName )
 import           Options.Applicative.Builder.Extra ( execExtraHelp )
 import           Stack.CLI ( commandLineHandler )
+import           Stack.Constants ( stackProgName )
 import           Stack.Docker ( dockerCmdName, dockerHelpOptName )
 import           Stack.Nix ( nixCmdName, nixHelpOptName )
 import           Stack.Options.DockerParser ( dockerOptsParser )

src/main/Stack/CLI.hs

@@ -21,7 +21,7 @@ import           RIO.Process ( withProcessContextNoLogging )
 import           Stack.Build ( buildCmd )
 import           Stack.Clean ( CleanCommand (..), cleanCmd )
 import           Stack.ConfigCmd as ConfigCmd
-import           Stack.Constants ( globalFooter )
+import           Stack.Constants ( globalFooter, stackProgName )
 import           Stack.Coverage ( hpcReportCmd )
 import           Stack.Docker
                    ( dockerCmdName, dockerHelpOptName, dockerPullCmdName )

src/test/Stack/ArgsSpec.hs

@@ -14,6 +14,7 @@ import           Data.Attoparsec.Interpreter ( interpreterArgsParser )
 import qualified Data.Attoparsec.Text as P
 import           Data.Text ( pack )
 import           Prelude ( head )
+import           Stack.Constants ( stackProgName )
 import           Stack.Prelude
 import           Test.Hspec ( Spec, describe, it )
 

stack.cabal

@@ -308,6 +308,7 @@ library
   other-modules:
       Path.Extended
       Stack.ComponentFile
+      Stack.Constants.StackProgName
       Stack.Internal.BuildInfo
       Stack.PackageFile
       Stack.Types.Cache
@@ -388,7 +389,6 @@ library
     , streaming-commons
     , tar
     , template-haskell
-    , temporary
     , text
     , text-metrics
     , th-reify-many
@@ -522,7 +522,6 @@ executable stack
     , streaming-commons
     , tar
     , template-haskell
-    , temporary
     , text
     , text-metrics
     , th-reify-many
@@ -649,7 +648,6 @@ executable stack-integration-test
     , streaming-commons
     , tar
     , template-haskell
-    , temporary
     , text
     , text-metrics
     , th-reify-many
@@ -784,7 +782,6 @@ test-suite stack-test
     , streaming-commons
     , tar
     , template-haskell
-    , temporary
     , text
     , text-metrics
     , th-reify-many