Treat stackProgName as a constant

Author: mpilgrem

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
@@ -134,10 +136,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 +158,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"]
@@ -535,6 +543,9 @@ relDirUnderHome = $(mkRelDir "_home")
 relDirSrc :: Path Rel Dir
 relDirSrc = $(mkRelDir "src")
 
+relDirStack :: Path Rel File
+relDirStack = $(mkRelFile "stack")
+
 relFileLibtinfoSo5 :: Path Rel File
 relFileLibtinfoSo5 = $(mkRelFile "libtinfo.so.5")
 

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

@@ -39,7 +39,7 @@ import           Stack.Build.Source
 import           Stack.Build.Target ( NeedTargets (..), parseTargets )
 import           Stack.Constants
                    ( relDirHaskellStackGhci, relFileCabalMacrosH
-                   , relFileGhciScript
+                   , relFileGhciScript, stackProgName'
                    )
 import           Stack.Constants.Config ( ghciDirL, objectInterfaceDirL )
 import           Stack.Ghci.Script

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 }