Move all mkRel TH calls into Stack.Constants (fixes #4272)

Author: snoyberg

src/Data/Attoparsec/Interpreter.hs

@@ -62,7 +62,6 @@ import           Conduit
 import           Data.Conduit.Attoparsec
 import           Data.List (intercalate)
 import           Data.Text (pack)
-import           Stack.Constants
 import           Stack.Prelude
 import           System.FilePath (takeExtension)
 import           System.IO (stderr, hPutStrLn)

src/Stack/Build/Cache.hs

@@ -49,6 +49,7 @@ import           Data.Store.VersionTagged
 import qualified Data.Text as T
 import           Path
 import           Path.IO
+import           Stack.Constants
 import           Stack.Constants.Config
 import           Stack.Types.Build
 import           Stack.Types.Compiler
@@ -61,8 +62,8 @@ import qualified System.FilePath as FP
 -- | Directory containing files to mark an executable as installed
 exeInstalledDir :: (MonadReader env m, HasEnvConfig env, MonadThrow m)
                 => InstallLocation -> m (Path Abs Dir)
-exeInstalledDir Snap = (</> $(mkRelDir "installed-packages")) `liftM` installationRootDeps
-exeInstalledDir Local = (</> $(mkRelDir "installed-packages")) `liftM` installationRootLocal
+exeInstalledDir Snap = (</> relDirInstalledPackages) `liftM` installationRootDeps
+exeInstalledDir Local = (</> relDirInstalledPackages) `liftM` installationRootLocal
 
 -- | Get all of the installed executables
 getInstalledExes :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m)
@@ -268,7 +269,7 @@ precompiledCacheFile loc copts installedPackageIDs = do
   platformRelDir <- platformGhcRelDir
   let precompiledDir =
             view stackRootL ec
-        </> $(mkRelDir "precompiled")
+        </> relDirPrecompiled
         </> platformRelDir
         </> compiler
         </> cabal

src/Stack/Build/Execute.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -43,7 +42,6 @@ import           Data.Conduit.Process.Typed
                      createPipe, runProcess_, getStdout,
                      getStderr, createSource)
 import qualified Data.Conduit.Text as CT
-import           Data.FileEmbed (embedFile, makeRelativeToProject)
 import           Data.IORef.RunOnce (runOnce)
 import           Data.List hiding (any)
 import qualified Data.Map.Strict as M
@@ -228,11 +226,6 @@ buildSetupArgs =
      , "StackSetupShim.mainOverride"
      ]
 
-setupGhciShimCode :: S.ByteString
-setupGhciShimCode = $(do
-    path <- makeRelativeToProject "src/setup-shim/StackSetupShim.hs"
-    embedFile path)
-
 simpleSetupCode :: S.ByteString
 simpleSetupCode = "import Distribution.Simple\nmain = defaultMain"
 
@@ -274,7 +267,7 @@ getSetupExe setupHs setupShimHs tmpdir = do
             baseNameS ++ ".jsexe"
         setupDir =
             view stackRootL config </>
-            $(mkRelDir "setup-exe-cache") </>
+            relDirSetupExeCache </>
             platformDir
 
     exePath <- (setupDir </>) <$> parseRelFile exeNameS
@@ -333,7 +326,7 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka
         -- Create files for simple setup and setup shim, if necessary
         let setupSrcDir =
                 view stackRootL config </>
-                $(mkRelDir "setup-exe-src")
+                relDirSetupExeSrc
         ensureDir setupSrcDir
         setupFileName <- parseRelFile ("setup-" ++ simpleSetupHash ++ ".hs")
         let setupHs = setupSrcDir </> setupFileName
@@ -864,7 +857,7 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task =
     -- with autoreconf -i. See:
     -- https://github.com/commercialhaskell/stack/issues/3534
     ensureConfigureScript = do
-      let fp = pkgDir </> $(mkRelFile "configure")
+      let fp = pkgDir </> relFileConfigure
       exists <- doesFileExist fp
       unless exists $ do
         logInfo $ "Trying to generate configure with autoreconf in " <> fromString (toFilePath pkgDir)
@@ -951,7 +944,7 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi
 
                 -- See: https://github.com/fpco/stack/issues/157
                 distDir <- distRelativeDir
-                let oldDist = dir </> $(mkRelDir "dist")
+                let oldDist = dir </> relDirDist
                     newDist = dir </> distDir
                 exists <- doesDirExist oldDist
                 when exists $ do
@@ -1086,7 +1079,7 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi
                             let depsArgs = map fst matchedDeps
                             -- Generate setup_macros.h and provide it to ghc
                             let macroDeps = mapMaybe snd matchedDeps
-                                cppMacrosFile = toFilePath $ setupDir </> $(mkRelFile "setup_macros.h")
+                                cppMacrosFile = toFilePath $ setupDir </> relFileSetupMacrosH
                                 cppArgs = ["-optP-include", "-optP" ++ cppMacrosFile]
                             liftIO $ S.writeFile cppMacrosFile (encodeUtf8 (T.pack (C.generatePackageVersionMacros macroDeps)))
                             return (packageDBArgs ++ depsArgs ++ cppArgs)
@@ -1193,8 +1186,8 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi
                 Left setupExe -> return setupExe
                 Right setuphs -> do
                     distDir <- distDirFromDir pkgDir
-                    let setupDir = distDir </> $(mkRelDir "setup")
-                        outputFile = setupDir </> $(mkRelFile "setup")
+                    let setupDir = distDir </> relDirSetup
+                        outputFile = setupDir </> relFileSetupLower
                     customBuilt <- liftIO $ readIORef eeCustomBuilt
                     if Set.member (packageName package) customBuilt
                         then return outputFile
@@ -1662,7 +1655,7 @@ checkExeStatus
     -> RIO env (Text, ExecutableBuildStatus)
 checkExeStatus compiler platform distDir name = do
     exename <- parseRelDir (T.unpack name)
-    exists <- checkPath (distDir </> $(mkRelDir "build") </> exename)
+    exists <- checkPath (distDir </> relDirBuild </> exename)
     pure
         ( name
         , if exists
@@ -1984,8 +1977,8 @@ getSetupHs dir = do
                 then return fp2
                 else throwM $ NoSetupHsFound dir
   where
-    fp1 = dir </> $(mkRelFile "Setup.hs")
-    fp2 = dir </> $(mkRelFile "Setup.lhs")
+    fp1 = dir </> relFileSetupHs
+    fp2 = dir </> relFileSetupLhs
 
 -- Do not pass `-hpcdir` as GHC option if the coverage is not enabled.
 -- This helps running stack-compiled programs with dynamic interpreters like `hint`.

src/Stack/Build/Haddock.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
 
 -- | Generate haddocks
 module Stack.Build.Haddock
@@ -26,6 +25,7 @@ import           Data.Time (UTCTime)
 import           Path
 import           Path.Extra
 import           Path.IO
+import           Stack.Constants
 import           Stack.PackageDump
 import           Stack.PrettyPrint
 import           Stack.Types.Build
@@ -283,15 +283,15 @@ lookupDumpPackage ghcPkgId dumpPkgs =
 
 -- | Path of haddock index file.
 haddockIndexFile :: Path Abs Dir -> Path Abs File
-haddockIndexFile destDir = destDir </> $(mkRelFile "index.html")
+haddockIndexFile destDir = destDir </> relFileIndexHtml
 
 -- | Path of local packages documentation directory.
 localDocDir :: BaseConfigOpts -> Path Abs Dir
 localDocDir bco = bcoLocalInstallRoot bco </> docDirSuffix
 
 -- | Path of documentation directory for the dependencies of local packages
 localDepsDocDir :: BaseConfigOpts -> Path Abs Dir
-localDepsDocDir bco = localDocDir bco </> $(mkRelDir "all")
+localDepsDocDir bco = localDocDir bco </> relDirAll
 
 -- | Path of snapshot packages documentation directory.
 snapDocDir :: BaseConfigOpts -> Path Abs Dir

src/Stack/Config.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -237,7 +236,7 @@ configFromConfigMonoid
      -- If --stack-work is passed, prefer it. Otherwise, if STACK_WORK
      -- is set, use that. If neither, use the default ".stack-work"
      mstackWorkEnv <- liftIO $ lookupEnv stackWorkEnvVar
-     configWorkDir0 <- maybe (return $(mkRelDir ".stack-work")) (liftIO . parseRelDir) mstackWorkEnv
+     configWorkDir0 <- maybe (return relDirStackWork) (liftIO . parseRelDir) mstackWorkEnv
      let configWorkDir = fromFirst configWorkDir0 configMonoidWorkDir
      -- This code is to handle the deprecation of latest-snapshot-url
      configUrls <- case (getFirst configMonoidLatestSnapshotUrl, getFirst (urlsMonoidLatestSnapshot configMonoidUrls)) of
@@ -315,7 +314,7 @@ configFromConfigMonoid
          case getFirst configMonoidLocalBinPath of
              Nothing -> do
                  localDir <- getAppUserDataDir "local"
-                 return $ localDir </> $(mkRelDir "bin")
+                 return $ localDir </> relDirBin
              Just userPath ->
                  (case mproject of
                      -- Not in a project
@@ -381,7 +380,7 @@ configFromConfigMonoid
          Just [hsc] -> pure hsc
          Just x -> error $ "When overriding the default package index, you must provide exactly one value, received: " ++ show x
      withPantryConfig
-       (configStackRoot </> $(mkRelDir "pantry"))
+       (configStackRoot </> relDirPantry)
        hsc
        (maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)
        clConnectionCount
@@ -395,7 +394,7 @@ getDefaultLocalProgramsBase :: MonadThrow m
                             -> m (Path Abs Dir)
 getDefaultLocalProgramsBase configStackRoot configPlatform override =
   let
-    defaultBase = configStackRoot </> $(mkRelDir "programs")
+    defaultBase = configStackRoot </> relDirPrograms
   in
     case configPlatform of
       -- For historical reasons, on Windows a subdirectory of LOCALAPPDATA is
@@ -407,7 +406,8 @@ getDefaultLocalProgramsBase configStackRoot configPlatform override =
           Just t ->
             case parseAbsDir $ T.unpack t of
               Nothing -> throwM $ stringException ("Failed to parse LOCALAPPDATA environment variable (expected absolute directory): " ++ show t)
-              Just lad -> return $ lad </> $(mkRelDir "Programs") </> $(mkRelDir stackProgName)
+              Just lad ->
+                return $ lad </> relDirUpperPrograms </> relDirStackProgName
           Nothing -> return defaultBase
       _ -> return defaultBase
 
@@ -583,7 +583,7 @@ loadBuildConfig mproject maresolver mcompiler = do
                            , "# http://docs.haskellstack.org/en/stable/yaml_configuration/\n"
                            , "#\n"
                            , Yaml.encode p]
-                       S.writeFile (toFilePath $ parent dest </> $(mkRelFile "README.txt")) $ S.concat
+                       S.writeFile (toFilePath $ parent dest </> relFileReadmeTxt) $ S.concat
                            [ "This is the implicit global project, which is used only when 'stack' is run\n"
                            , "outside of a real project.\n" ]
                    return (p, dest)
@@ -922,7 +922,7 @@ getFakeConfigPath stackRoot ar = do
   -- Better would be to defer figuring out this value until
   -- after we have a fully loaded snapshot with a hash.
   asDir <- parseRelDir $ takeWhile (/= ':') asString
-  let full = stackRoot </> $(mkRelDir "script") </> asDir </> $(mkRelFile "config.yaml")
+  let full = stackRoot </> relDirScript </> asDir </> relFileConfigYaml
   ensureDir (parent full)
   return full
 

src/Stack/Config/Docker.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, TemplateHaskell #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards #-}
 
 -- | Docker configuration
 module Stack.Config.Docker where
@@ -11,6 +11,7 @@ import qualified Data.Text as T
 import           Data.Text.Read (decimal)
 import           Distribution.Version (simplifyVersionRange)
 import           Path
+import           Stack.Constants
 import           Stack.Types.Version
 import           Stack.Types.Config
 import           Stack.Types.Docker
@@ -78,7 +79,7 @@ dockerOptsFromMonoid mproject stackRoot maresolver DockerOptsMonoid{..} = do
         dockerSetUser = getFirst dockerMonoidSetUser
         dockerRequireDockerVersion =
             simplifyVersionRange (getIntersectingVersionRange dockerMonoidRequireDockerVersion)
-        dockerDatabasePath = fromFirst (stackRoot </> $(mkRelFile "docker.db")) dockerMonoidDatabasePath
+        dockerDatabasePath = fromFirst (stackRoot </> relFileDockerDb) dockerMonoidDatabasePath
         dockerStackExe = getFirst dockerMonoidStackExe
 
     return DockerOpts{..}