1{-# LANGUAGE CPP #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE TemplateHaskell #-} -- keep TH usage here
5
6-- | Constants used throughout the project.
7
8module Stack.Constants
9    (buildPlanDir
10    ,buildPlanCacheDir
11    ,haskellFileExts
12    ,haskellDefaultPreprocessorExts
13    ,stackDotYaml
14    ,stackWorkEnvVar
15    ,stackRootEnvVar
16    ,stackRootOptionName
17    ,deprecatedStackRootOptionName
18    ,inContainerEnvVar
19    ,inNixShellEnvVar
20    ,stackProgNameUpper
21    ,wiredInPackages
22    ,cabalPackageName
23    ,implicitGlobalProjectDirDeprecated
24    ,implicitGlobalProjectDir
25    ,defaultUserConfigPathDeprecated
26    ,defaultUserConfigPath
27    ,defaultGlobalConfigPathDeprecated
28    ,defaultGlobalConfigPath
29    ,platformVariantEnvVar
30    ,compilerOptionsCabalFlag
31    ,ghcColorForceFlag
32    ,minTerminalWidth
33    ,maxTerminalWidth
34    ,defaultTerminalWidth
35    ,osIsWindows
36    ,relFileSetupHs
37    ,relFileSetupLhs
38    ,relFileHpackPackageConfig
39    ,relDirGlobalAutogen
40    ,relDirAutogen
41    ,relDirLogs
42    ,relFileCabalMacrosH
43    ,relDirBuild
44    ,relDirBin
45    ,relDirPantry
46    ,relDirPrograms
47    ,relDirUpperPrograms
48    ,relDirStackProgName
49    ,relDirStackWork
50    ,relFileReadmeTxt
51    ,relDirScript
52    ,relFileConfigYaml
53    ,relDirSnapshots
54    ,relDirGlobalHints
55    ,relFileGlobalHintsYaml
56    ,relDirInstall
57    ,relDirCompilerTools
58    ,relDirHoogle
59    ,relFileDatabaseHoo
60    ,relDirPkgdb
61    ,relFileStorage
62    ,relDirLoadedSnapshotCache
63    ,bindirSuffix
64    ,docDirSuffix
65    ,relDirHpc
66    ,relDirLib
67    ,relDirShare
68    ,relDirLibexec
69    ,relDirEtc
70    ,setupGhciShimCode
71    ,relDirSetupExeCache
72    ,relDirSetupExeSrc
73    ,relFileConfigure
74    ,relDirDist
75    ,relFileSetupMacrosH
76    ,relDirSetup
77    ,relFileSetupLower
78    ,relDirMingw
79    ,relDirMingw32
80    ,relDirMingw64
81    ,relDirLocal
82    ,relDirUsr
83    ,relDirInclude
84    ,relFileIndexHtml
85    ,relDirAll
86    ,relFilePackageCache
87    ,relFileDockerfile
88    ,relDirHaskellStackGhci
89    ,relFileGhciScript
90    ,relDirCombined
91    ,relFileHpcIndexHtml
92    ,relDirCustom
93    ,relDirPackageConfInplace
94    ,relDirExtraTixFiles
95    ,relDirInstalledPackages
96    ,backupUrlRelPath
97    ,relDirDotLocal
98    ,relDirDotSsh
99    ,relDirDotStackProgName
100    ,relDirUnderHome
101    ,relDirSrc
102    ,relFileLibtinfoSo5
103    ,relFileLibtinfoSo6
104    ,relFileLibncurseswSo6
105    ,relFileLibgmpSo10
106    ,relFileLibgmpSo3
107    ,relDirNewCabal
108    ,relFileSetupExe
109    ,relFileSetupUpper
110    ,relFile7zexe
111    ,relFile7zdll
112    ,relFileMainHs
113    ,relFileStack
114    ,relFileStackDotExe
115    ,relFileStackDotTmpDotExe
116    ,relFileStackDotTmp
117    ,ghcShowOptionsOutput
118    ,hadrianScriptsWindows
119    ,hadrianScriptsPosix
120    ,usrLibDirs
121    ,testGhcEnvRelFile
122    ,relFileBuildLock
123    ,stackDeveloperModeDefault
124    )
125    where
126
127import           Data.ByteString.Builder (byteString)
128import           Data.Char (toUpper)
129import           Data.FileEmbed (embedFile, makeRelativeToProject)
130import qualified Data.Set as Set
131import           Distribution.Package (mkPackageName)
132import qualified Hpack.Config as Hpack
133import qualified Language.Haskell.TH.Syntax as TH (runIO, lift)
134import           Path as FL
135import           Stack.Prelude
136import           Stack.Types.Compiler
137import           System.Permissions (osIsWindows)
138import           System.Process (readProcess)
139
140-- | Extensions used for Haskell modules. Excludes preprocessor ones.
141haskellFileExts :: [Text]
142haskellFileExts = ["hs", "hsc", "lhs"]
143
144-- | Extensions for modules that are preprocessed by common preprocessors.
145haskellDefaultPreprocessorExts :: [Text]
146haskellDefaultPreprocessorExts = ["gc", "chs", "hsc", "x", "y", "ly", "cpphs"]
147
148-- | Name of the 'stack' program, uppercased
149stackProgNameUpper :: String
150stackProgNameUpper = map toUpper stackProgName
151
152-- | The filename used for the stack config file.
153stackDotYaml :: Path Rel File
154stackDotYaml = $(mkRelFile "stack.yaml")
155
156-- | Environment variable used to override the '.stack-work' relative dir.
157stackWorkEnvVar :: String
158stackWorkEnvVar = "STACK_WORK"
159
160-- | Environment variable used to override the '~/.stack' location.
161stackRootEnvVar :: String
162stackRootEnvVar = "STACK_ROOT"
163
164-- | Option name for the global stack root.
165stackRootOptionName :: String
166stackRootOptionName = "stack-root"
167
168-- | Deprecated option name for the global stack root.
169--
170-- Deprecated since stack-1.1.0.
171--
172-- TODO: Remove occurrences of this variable and use 'stackRootOptionName' only
173-- after an appropriate deprecation period.
174deprecatedStackRootOptionName :: String
175deprecatedStackRootOptionName = "global-stack-root"
176
177-- | Environment variable used to indicate stack is running in container.
178inContainerEnvVar :: String
179inContainerEnvVar = stackProgNameUpper ++ "_IN_CONTAINER"
180
181-- | Environment variable used to indicate stack is running in container.
182-- although we already have STACK_IN_NIX_EXTRA_ARGS that is set in the same conditions,
183-- it can happen that STACK_IN_NIX_EXTRA_ARGS is set to empty.
184inNixShellEnvVar :: String
185inNixShellEnvVar = map toUpper stackProgName ++ "_IN_NIX_SHELL"
186
187-- See https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc/src/Module.html#integerPackageKey
188wiredInPackages :: Set PackageName
189wiredInPackages =
190    maybe (error "Parse error in wiredInPackages") Set.fromList mparsed
191  where
192    mparsed = mapM parsePackageName
193      [ "ghc-prim"
194      , "integer-gmp"
195      , "integer-simple"
196      , "base"
197      , "rts"
198      , "template-haskell"
199      , "dph-seq"
200      , "dph-par"
201      , "ghc"
202      , "interactive"
203      ]
204
205-- | Just to avoid repetition and magic strings.
206cabalPackageName :: PackageName
207cabalPackageName =
208    mkPackageName "Cabal"
209
210-- | Deprecated implicit global project directory used when outside of a project.
211implicitGlobalProjectDirDeprecated :: Path Abs Dir -- ^ Stack root.
212                                   -> Path Abs Dir
213implicitGlobalProjectDirDeprecated p =
214    p </>
215    $(mkRelDir "global")
216
217-- | Implicit global project directory used when outside of a project.
218-- Normally, @getImplicitGlobalProjectDir@ should be used instead.
219implicitGlobalProjectDir :: Path Abs Dir -- ^ Stack root.
220                         -> Path Abs Dir
221implicitGlobalProjectDir p =
222    p </>
223    $(mkRelDir "global-project")
224
225-- | Deprecated default global config path.
226defaultUserConfigPathDeprecated :: Path Abs Dir -> Path Abs File
227defaultUserConfigPathDeprecated = (</> $(mkRelFile "stack.yaml"))
228
229-- | Default global config path.
230-- Normally, @getDefaultUserConfigPath@ should be used instead.
231defaultUserConfigPath :: Path Abs Dir -> Path Abs File
232defaultUserConfigPath = (</> $(mkRelFile "config.yaml"))
233
234-- | Deprecated default global config path.
235-- Note that this will be @Nothing@ on Windows, which is by design.
236defaultGlobalConfigPathDeprecated :: Maybe (Path Abs File)
237defaultGlobalConfigPathDeprecated = parseAbsFile "/etc/stack/config"
238
239-- | Default global config path.
240-- Normally, @getDefaultGlobalConfigPath@ should be used instead.
241-- Note that this will be @Nothing@ on Windows, which is by design.
242defaultGlobalConfigPath :: Maybe (Path Abs File)
243defaultGlobalConfigPath = parseAbsFile "/etc/stack/config.yaml"
244
245-- | Path where build plans are stored.
246buildPlanDir :: Path Abs Dir -- ^ Stack root
247             -> Path Abs Dir
248buildPlanDir = (</> $(mkRelDir "build-plan"))
249
250-- | Path where binary caches of the build plans are stored.
251buildPlanCacheDir
252  :: Path Abs Dir -- ^ Stack root
253  -> Path Abs Dir
254buildPlanCacheDir = (</> $(mkRelDir "build-plan-cache"))
255
256-- | Environment variable that stores a variant to append to platform-specific directory
257-- names.  Used to ensure incompatible binaries aren't shared between Docker builds and host
258platformVariantEnvVar :: String
259platformVariantEnvVar = stackProgNameUpper ++ "_PLATFORM_VARIANT"
260
261-- | Provides --ghc-options for 'Ghc'
262compilerOptionsCabalFlag :: WhichCompiler -> String
263compilerOptionsCabalFlag Ghc = "--ghc-options"
264
265-- | The flag to pass to GHC when we want to force its output to be
266-- colorized.
267ghcColorForceFlag :: String
268ghcColorForceFlag = "-fdiagnostics-color=always"
269
270-- | The minimum allowed terminal width. Used for pretty-printing.
271minTerminalWidth :: Int
272minTerminalWidth = 40
273
274-- | The maximum allowed terminal width. Used for pretty-printing.
275maxTerminalWidth :: Int
276maxTerminalWidth = 200
277
278-- | The default terminal width. Used for pretty-printing when we can't
279-- automatically detect it and when the user doesn't supply one.
280defaultTerminalWidth :: Int
281defaultTerminalWidth = 100
282
283relFileSetupHs :: Path Rel File
284relFileSetupHs = $(mkRelFile "Setup.hs")
285
286relFileSetupLhs :: Path Rel File
287relFileSetupLhs = $(mkRelFile "Setup.lhs")
288
289relFileHpackPackageConfig :: Path Rel File
290relFileHpackPackageConfig = $(mkRelFile Hpack.packageConfig)
291
292relDirGlobalAutogen :: Path Rel Dir
293relDirGlobalAutogen = $(mkRelDir "global-autogen")
294
295relDirAutogen :: Path Rel Dir
296relDirAutogen = $(mkRelDir "autogen")
297
298relDirLogs :: Path Rel Dir
299relDirLogs = $(mkRelDir "logs")
300
301relFileCabalMacrosH :: Path Rel File
302relFileCabalMacrosH = $(mkRelFile "cabal_macros.h")
303
304relDirBuild :: Path Rel Dir
305relDirBuild = $(mkRelDir "build")
306
307relDirBin :: Path Rel Dir
308relDirBin = $(mkRelDir "bin")
309
310relDirPantry :: Path Rel Dir
311relDirPantry = $(mkRelDir "pantry")
312
313relDirPrograms :: Path Rel Dir
314relDirPrograms = $(mkRelDir "programs")
315
316relDirUpperPrograms :: Path Rel Dir
317relDirUpperPrograms = $(mkRelDir "Programs")
318
319relDirStackProgName :: Path Rel Dir
320relDirStackProgName = $(mkRelDir stackProgName)
321
322relDirStackWork :: Path Rel Dir
323relDirStackWork = $(mkRelDir ".stack-work")
324
325relFileReadmeTxt :: Path Rel File
326relFileReadmeTxt = $(mkRelFile "README.txt")
327
328relDirScript :: Path Rel Dir
329relDirScript = $(mkRelDir "script")
330
331relFileConfigYaml :: Path Rel File
332relFileConfigYaml = $(mkRelFile "config.yaml")
333
334relDirSnapshots :: Path Rel Dir
335relDirSnapshots = $(mkRelDir "snapshots")
336
337relDirGlobalHints :: Path Rel Dir
338relDirGlobalHints = $(mkRelDir "global-hints")
339
340relFileGlobalHintsYaml :: Path Rel File
341relFileGlobalHintsYaml = $(mkRelFile "global-hints.yaml")
342
343relDirInstall :: Path Rel Dir
344relDirInstall = $(mkRelDir "install")
345
346relDirCompilerTools :: Path Rel Dir
347relDirCompilerTools = $(mkRelDir "compiler-tools")
348
349relDirHoogle :: Path Rel Dir
350relDirHoogle = $(mkRelDir "hoogle")
351
352relFileDatabaseHoo :: Path Rel File
353relFileDatabaseHoo = $(mkRelFile "database.hoo")
354
355relDirPkgdb :: Path Rel Dir
356relDirPkgdb = $(mkRelDir "pkgdb")
357
358relFileStorage :: Path Rel File
359relFileStorage = $(mkRelFile "stack.sqlite3")
360
361relDirLoadedSnapshotCache :: Path Rel Dir
362relDirLoadedSnapshotCache = $(mkRelDir "loaded-snapshot-cached")
363
364-- | Suffix applied to an installation root to get the bin dir
365bindirSuffix :: Path Rel Dir
366bindirSuffix = relDirBin
367
368-- | Suffix applied to an installation root to get the doc dir
369docDirSuffix :: Path Rel Dir
370docDirSuffix = $(mkRelDir "doc")
371
372relDirHpc :: Path Rel Dir
373relDirHpc = $(mkRelDir "hpc")
374
375relDirLib :: Path Rel Dir
376relDirLib = $(mkRelDir "lib")
377
378relDirShare :: Path Rel Dir
379relDirShare = $(mkRelDir "share")
380
381relDirLibexec :: Path Rel Dir
382relDirLibexec = $(mkRelDir "libexec")
383
384relDirEtc :: Path Rel Dir
385relDirEtc = $(mkRelDir "etc")
386
387setupGhciShimCode :: Builder
388setupGhciShimCode = byteString $(do
389    path <- makeRelativeToProject "src/setup-shim/StackSetupShim.hs"
390    embedFile path)
391
392relDirSetupExeCache :: Path Rel Dir
393relDirSetupExeCache = $(mkRelDir "setup-exe-cache")
394
395relDirSetupExeSrc :: Path Rel Dir
396relDirSetupExeSrc = $(mkRelDir "setup-exe-src")
397
398relFileConfigure :: Path Rel File
399relFileConfigure = $(mkRelFile "configure")
400
401relDirDist :: Path Rel Dir
402relDirDist = $(mkRelDir "dist")
403
404relFileSetupMacrosH :: Path Rel File
405relFileSetupMacrosH = $(mkRelFile "setup_macros.h")
406
407relDirSetup :: Path Rel Dir
408relDirSetup = $(mkRelDir "setup")
409
410relFileSetupLower :: Path Rel File
411relFileSetupLower = $(mkRelFile "setup")
412
413relDirMingw :: Path Rel Dir
414relDirMingw = $(mkRelDir "mingw")
415
416relDirMingw32 :: Path Rel Dir
417relDirMingw32 = $(mkRelDir "mingw32")
418
419relDirMingw64 :: Path Rel Dir
420relDirMingw64 = $(mkRelDir "mingw64")
421
422relDirLocal :: Path Rel Dir
423relDirLocal = $(mkRelDir "local")
424
425relDirUsr :: Path Rel Dir
426relDirUsr = $(mkRelDir "usr")
427
428relDirInclude :: Path Rel Dir
429relDirInclude = $(mkRelDir "include")
430
431relFileIndexHtml :: Path Rel File
432relFileIndexHtml = $(mkRelFile "index.html")
433
434relDirAll :: Path Rel Dir
435relDirAll = $(mkRelDir "all")
436
437relFilePackageCache :: Path Rel File
438relFilePackageCache = $(mkRelFile "package.cache")
439
440relFileDockerfile :: Path Rel File
441relFileDockerfile = $(mkRelFile "Dockerfile")
442
443relDirHaskellStackGhci :: Path Rel Dir
444relDirHaskellStackGhci = $(mkRelDir "haskell-stack-ghci")
445
446relFileGhciScript :: Path Rel File
447relFileGhciScript = $(mkRelFile "ghci-script")
448
449relDirCombined :: Path Rel Dir
450relDirCombined = $(mkRelDir "combined")
451
452relFileHpcIndexHtml :: Path Rel File
453relFileHpcIndexHtml = $(mkRelFile "hpc_index.html")
454
455relDirCustom :: Path Rel Dir
456relDirCustom = $(mkRelDir "custom")
457
458relDirPackageConfInplace :: Path Rel Dir
459relDirPackageConfInplace = $(mkRelDir "package.conf.inplace")
460
461relDirExtraTixFiles :: Path Rel Dir
462relDirExtraTixFiles = $(mkRelDir "extra-tix-files")
463
464relDirInstalledPackages :: Path Rel Dir
465relDirInstalledPackages = $(mkRelDir "installed-packages")
466
467backupUrlRelPath :: Path Rel File
468backupUrlRelPath = $(mkRelFile "downloaded.template.file.hsfiles")
469
470relDirDotLocal :: Path Rel Dir
471relDirDotLocal = $(mkRelDir ".local")
472
473relDirDotSsh :: Path Rel Dir
474relDirDotSsh = $(mkRelDir ".ssh")
475
476relDirDotStackProgName :: Path Rel Dir
477relDirDotStackProgName = $(mkRelDir ('.' : stackProgName))
478
479relDirUnderHome :: Path Rel Dir
480relDirUnderHome = $(mkRelDir "_home")
481
482relDirSrc :: Path Rel Dir
483relDirSrc = $(mkRelDir "src")
484
485relFileLibtinfoSo5 :: Path Rel File
486relFileLibtinfoSo5 = $(mkRelFile "libtinfo.so.5")
487
488relFileLibtinfoSo6 :: Path Rel File
489relFileLibtinfoSo6 = $(mkRelFile "libtinfo.so.6")
490
491relFileLibncurseswSo6 :: Path Rel File
492relFileLibncurseswSo6 = $(mkRelFile "libncursesw.so.6")
493
494relFileLibgmpSo10 :: Path Rel File
495relFileLibgmpSo10 = $(mkRelFile "libgmp.so.10")
496
497relFileLibgmpSo3 :: Path Rel File
498relFileLibgmpSo3 = $(mkRelFile "libgmp.so.3")
499
500relDirNewCabal :: Path Rel Dir
501relDirNewCabal = $(mkRelDir "new-cabal")
502
503relFileSetupExe :: Path Rel File
504relFileSetupExe = $(mkRelFile "Setup.exe")
505
506relFileSetupUpper :: Path Rel File
507relFileSetupUpper = $(mkRelFile "Setup")
508
509relFile7zexe :: Path Rel File
510relFile7zexe = $(mkRelFile "7z.exe")
511
512relFile7zdll :: Path Rel File
513relFile7zdll = $(mkRelFile "7z.dll")
514
515relFileMainHs :: Path Rel File
516relFileMainHs = $(mkRelFile "Main.hs")
517
518relFileStackDotExe :: Path Rel File
519relFileStackDotExe = $(mkRelFile "stack.exe")
520
521relFileStackDotTmpDotExe :: Path Rel File
522relFileStackDotTmpDotExe = $(mkRelFile "stack.tmp.exe")
523
524relFileStackDotTmp :: Path Rel File
525relFileStackDotTmp = $(mkRelFile "stack.tmp")
526
527relFileStack :: Path Rel File
528relFileStack = $(mkRelFile "stack")
529
530-- Technically, we should be consulting the user's current ghc,
531-- but that would require loading up a BuildConfig.
532ghcShowOptionsOutput :: [String]
533ghcShowOptionsOutput =
534  $(TH.runIO (readProcess "ghc" ["--show-options"] "") >>= TH.lift . lines)
535
536-- | Relative paths inside a GHC repo to the Hadrian build batch script.
537-- The second path is maintained for compatibility with older GHC versions.
538hadrianScriptsWindows :: [Path Rel File]
539hadrianScriptsWindows = [$(mkRelFile "hadrian/build-stack.bat"), $(mkRelFile "hadrian/build.stack.bat")]
540
541-- | Relative paths inside a GHC repo to the Hadrian build shell script
542-- The second path is maintained for compatibility with older GHC versions.
543hadrianScriptsPosix :: [Path Rel File]
544hadrianScriptsPosix = [$(mkRelFile "hadrian/build-stack"), $(mkRelFile "hadrian/build.stack.sh")]
545
546-- | Used in Stack.Setup for detecting libtinfo, see comments at use site
547usrLibDirs :: [Path Abs Dir]
548#if WINDOWS
549usrLibDirs = []
550#else
551usrLibDirs = [$(mkAbsDir "/usr/lib"),$(mkAbsDir "/usr/lib64")]
552#endif
553
554-- | Relative file path for a temporary GHC environment file for tests
555testGhcEnvRelFile :: Path Rel File
556testGhcEnvRelFile = $(mkRelFile "test-ghc-env")
557
558-- | File inside a dist directory to use for locking
559relFileBuildLock :: Path Rel File
560relFileBuildLock = $(mkRelFile "build-lock")
561
562-- | What should the default be for stack-developer-mode
563stackDeveloperModeDefault :: Bool
564stackDeveloperModeDefault = STACK_DEVELOPER_MODE_DEFAULT
565