1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE DataKinds #-} 3{-# LANGUAGE DeriveDataTypeable #-} 4{-# LANGUAGE DeriveGeneric #-} 5{-# LANGUAGE FlexibleInstances #-} 6{-# LANGUAGE GeneralizedNewtypeDeriving #-} 7{-# LANGUAGE OverloadedStrings #-} 8 9-- | Build-specific types. 10 11module Stack.Types.Build 12 (StackBuildException(..) 13 ,FlagSource(..) 14 ,UnusedFlags(..) 15 ,InstallLocation(..) 16 ,Installed(..) 17 ,psVersion 18 ,Task(..) 19 ,taskIsTarget 20 ,taskLocation 21 ,taskTargetIsMutable 22 ,LocalPackage(..) 23 ,BaseConfigOpts(..) 24 ,Plan(..) 25 ,TestOpts(..) 26 ,BenchmarkOpts(..) 27 ,FileWatchOpts(..) 28 ,BuildOpts(..) 29 ,BuildSubset(..) 30 ,defaultBuildOpts 31 ,TaskType(..) 32 ,IsMutable(..) 33 ,installLocationIsMutable 34 ,TaskConfigOpts(..) 35 ,BuildCache(..) 36 ,ConfigCache(..) 37 ,configureOpts 38 ,CachePkgSrc (..) 39 ,toCachePkgSrc 40 ,isStackOpt 41 ,wantedLocalPackages 42 ,FileCacheInfo (..) 43 ,ConfigureOpts (..) 44 ,PrecompiledCache (..) 45 ) 46 where 47 48import Stack.Prelude 49import Data.Aeson (ToJSON, FromJSON) 50import qualified Data.ByteString as S 51import Data.Char (isSpace) 52import Data.List.Extra 53import qualified Data.Map as Map 54import qualified Data.Set as Set 55import qualified Data.Text as T 56import Database.Persist.Sql (PersistField(..) 57 ,PersistFieldSql(..) 58 ,PersistValue(PersistText) 59 ,SqlType(SqlString)) 60import Distribution.PackageDescription (TestSuiteInterface) 61import Distribution.System (Arch) 62import qualified Distribution.Text as C 63import Distribution.Version (mkVersion) 64import Path (parseRelDir, (</>), parent) 65import Path.Extra (toFilePathNoTrailingSep) 66import Stack.Constants 67import Stack.Types.Compiler 68import Stack.Types.CompilerBuild 69import Stack.Types.Config 70import Stack.Types.GhcPkgId 71import Stack.Types.NamedComponent 72import Stack.Types.Package 73import Stack.Types.Version 74import System.FilePath (pathSeparator) 75import RIO.Process (showProcessArgDebug) 76 77---------------------------------------------- 78-- Exceptions 79data StackBuildException 80 = Couldn'tFindPkgId PackageName 81 | CompilerVersionMismatch 82 (Maybe (ActualCompiler, Arch)) -- found 83 (WantedCompiler, Arch) -- expected 84 GHCVariant -- expected 85 CompilerBuild -- expected 86 VersionCheck 87 (Maybe (Path Abs File)) -- Path to the stack.yaml file 88 Text -- recommended resolution 89 | Couldn'tParseTargets [Text] 90 | UnknownTargets 91 (Set PackageName) -- no known version 92 (Map PackageName Version) -- not in snapshot, here's the most recent version in the index 93 (Path Abs File) -- stack.yaml 94 | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString 95 | TestSuiteTypeUnsupported TestSuiteInterface 96 | ConstructPlanFailed String 97 | CabalExitedUnsuccessfully 98 ExitCode 99 PackageIdentifier 100 (Path Abs File) -- cabal Executable 101 [String] -- cabal arguments 102 (Maybe (Path Abs File)) -- logfiles location 103 [Text] -- log contents 104 | SetupHsBuildFailure 105 ExitCode 106 (Maybe PackageIdentifier) -- which package's custom setup, is simple setup if Nothing 107 (Path Abs File) -- ghc Executable 108 [String] -- ghc arguments 109 (Maybe (Path Abs File)) -- logfiles location 110 [Text] -- log contents 111 | ExecutionFailure [SomeException] 112 | LocalPackageDoesn'tMatchTarget 113 PackageName 114 Version -- local version 115 Version -- version specified on command line 116 | NoSetupHsFound (Path Abs Dir) 117 | InvalidFlagSpecification (Set UnusedFlags) 118 | InvalidGhcOptionsSpecification [PackageName] 119 | TargetParseException [Text] 120 | SomeTargetsNotBuildable [(PackageName, NamedComponent)] 121 | TestSuiteExeMissing Bool String String String 122 | CabalCopyFailed Bool String 123 | LocalPackagesPresent [PackageIdentifier] 124 | CouldNotLockDistDir !(Path Abs File) 125 deriving Typeable 126 127data FlagSource = FSCommandLine | FSStackYaml 128 deriving (Show, Eq, Ord) 129 130data UnusedFlags = UFNoPackage FlagSource PackageName 131 | UFFlagsNotDefined 132 FlagSource 133 PackageName 134 (Set FlagName) -- defined in package 135 (Set FlagName) -- not defined 136 | UFSnapshot PackageName 137 deriving (Show, Eq, Ord) 138 139instance Show StackBuildException where 140 show (Couldn'tFindPkgId name) = 141 "After installing " <> packageNameString name <> 142 ", the package id couldn't be found " <> "(via ghc-pkg describe " <> 143 packageNameString name <> "). This shouldn't happen, " <> 144 "please report as a bug" 145 show (CompilerVersionMismatch mactual (expected, earch) ghcVariant ghcBuild check mstack resolution) = concat 146 [ case mactual of 147 Nothing -> "No compiler found, expected " 148 Just (actual, arch) -> concat 149 [ "Compiler version mismatched, found " 150 , compilerVersionString actual 151 , " (" 152 , C.display arch 153 , ")" 154 , ", but expected " 155 ] 156 , case check of 157 MatchMinor -> "minor version match with " 158 MatchExact -> "exact version " 159 NewerMinor -> "minor version match or newer with " 160 , T.unpack $ utf8BuilderToText $ display expected 161 , " (" 162 , C.display earch 163 , ghcVariantSuffix ghcVariant 164 , compilerBuildSuffix ghcBuild 165 , ") (based on " 166 , case mstack of 167 Nothing -> "command line arguments" 168 Just stack -> "resolver setting in " ++ toFilePath stack 169 , ").\n" 170 , T.unpack resolution 171 ] 172 show (Couldn'tParseTargets targets) = unlines 173 $ "The following targets could not be parsed as package names or directories:" 174 : map T.unpack targets 175 show (UnknownTargets noKnown notInSnapshot stackYaml) = 176 unlines $ noKnown' ++ notInSnapshot' 177 where 178 noKnown' 179 | Set.null noKnown = [] 180 | otherwise = return $ 181 "The following target packages were not found: " ++ 182 intercalate ", " (map packageNameString $ Set.toList noKnown) ++ 183 "\nSee https://docs.haskellstack.org/en/stable/build_command/#target-syntax for details." 184 notInSnapshot' 185 | Map.null notInSnapshot = [] 186 | otherwise = 187 "The following packages are not in your snapshot, but exist" 188 : "in your package index. Recommended action: add them to your" 189 : ("extra-deps in " ++ toFilePath stackYaml) 190 : "(Note: these are the most recent versions," 191 : "but there's no guarantee that they'll build together)." 192 : "" 193 : map 194 (\(name, version') -> "- " ++ packageIdentifierString 195 (PackageIdentifier name version')) 196 (Map.toList notInSnapshot) 197 show (TestSuiteFailure ident codes mlogFile bs) = unlines $ concat 198 [ ["Test suite failure for package " ++ packageIdentifierString ident] 199 , flip map (Map.toList codes) $ \(name, mcode) -> concat 200 [ " " 201 , T.unpack name 202 , ": " 203 , case mcode of 204 Nothing -> " executable not found" 205 Just ec -> " exited with: " ++ show ec 206 ] 207 , return $ case mlogFile of 208 Nothing -> "Logs printed to console" 209 -- TODO Should we load up the full error output and print it here? 210 Just logFile -> "Full log available at " ++ toFilePath logFile 211 , if S.null bs 212 then [] 213 else ["", "", doubleIndent $ T.unpack $ decodeUtf8With lenientDecode bs] 214 ] 215 where 216 indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines 217 doubleIndent = indent . indent 218 show (TestSuiteTypeUnsupported interface) = 219 "Unsupported test suite type: " <> show interface 220 -- Supressing duplicate output 221 show (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) = 222 showBuildError False exitCode (Just taskProvides') execName fullArgs logFiles bss 223 show (SetupHsBuildFailure exitCode mtaskProvides execName fullArgs logFiles bss) = 224 showBuildError True exitCode mtaskProvides execName fullArgs logFiles bss 225 show (ExecutionFailure es) = intercalate "\n\n" $ map show es 226 show (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat 227 [ "Version for local package " 228 , packageNameString name 229 , " is " 230 , versionString localV 231 , ", but you asked for " 232 , versionString requestedV 233 , " on the command line" 234 ] 235 show (NoSetupHsFound dir) = 236 "No Setup.hs or Setup.lhs file found in " ++ toFilePath dir 237 show (InvalidFlagSpecification unused) = unlines 238 $ "Invalid flag specification:" 239 : map go (Set.toList unused) 240 where 241 showFlagSrc :: FlagSource -> String 242 showFlagSrc FSCommandLine = " (specified on command line)" 243 showFlagSrc FSStackYaml = " (specified in stack.yaml)" 244 245 go :: UnusedFlags -> String 246 go (UFNoPackage src name) = concat 247 [ "- Package '" 248 , packageNameString name 249 , "' not found" 250 , showFlagSrc src 251 ] 252 go (UFFlagsNotDefined src pname pkgFlags flags) = concat 253 [ "- Package '" 254 , name 255 , "' does not define the following flags" 256 , showFlagSrc src 257 , ":\n" 258 , intercalate "\n" 259 (map (\flag -> " " ++ flagNameString flag) 260 (Set.toList flags)) 261 , "\n- Flags defined by package '" ++ name ++ "':\n" 262 , intercalate "\n" 263 (map (\flag -> " " ++ name ++ ":" ++ flagNameString flag) 264 (Set.toList pkgFlags)) 265 ] 266 where name = packageNameString pname 267 go (UFSnapshot name) = concat 268 [ "- Attempted to set flag on snapshot package " 269 , packageNameString name 270 , ", please add to extra-deps" 271 ] 272 show (InvalidGhcOptionsSpecification unused) = unlines 273 $ "Invalid GHC options specification:" 274 : map showGhcOptionSrc unused 275 where 276 showGhcOptionSrc name = concat 277 [ "- Package '" 278 , packageNameString name 279 , "' not found" 280 ] 281 show (TargetParseException [err]) = "Error parsing targets: " ++ T.unpack err 282 show (TargetParseException errs) = unlines 283 $ "The following errors occurred while parsing the build targets:" 284 : map (("- " ++) . T.unpack) errs 285 286 show (SomeTargetsNotBuildable xs) = 287 "The following components have 'buildable: False' set in the cabal configuration, and so cannot be targets:\n " ++ 288 T.unpack (renderPkgComponents xs) ++ 289 "\nTo resolve this, either provide flags such that these components are buildable, or only specify buildable targets." 290 show (TestSuiteExeMissing isSimpleBuildType exeName pkgName' testName) = 291 missingExeError isSimpleBuildType $ concat 292 [ "Test suite executable \"" 293 , exeName 294 , " not found for " 295 , pkgName' 296 , ":test:" 297 , testName 298 ] 299 show (CabalCopyFailed isSimpleBuildType innerMsg) = 300 missingExeError isSimpleBuildType $ concat 301 [ "'cabal copy' failed. Error message:\n" 302 , innerMsg 303 , "\n" 304 ] 305 show (ConstructPlanFailed msg) = msg 306 show (LocalPackagesPresent locals) = unlines 307 $ "Local packages are not allowed when using the script command. Packages found:" 308 : map (\ident -> "- " ++ packageIdentifierString ident) locals 309 show (CouldNotLockDistDir lockFile) = unlines 310 [ "Locking the dist directory failed, try to lock file:" 311 , " " ++ toFilePath lockFile 312 , "Maybe you're running another copy of Stack?" 313 ] 314 315missingExeError :: Bool -> String -> String 316missingExeError isSimpleBuildType msg = 317 unlines $ msg : 318 case possibleCauses of 319 [] -> [] 320 [cause] -> ["One possible cause of this issue is:\n* " <> cause] 321 _ -> "Possible causes of this issue:" : map ("* " <>) possibleCauses 322 where 323 possibleCauses = 324 "No module named \"Main\". The 'main-is' source file should usually have a header indicating that it's a 'Main' module." : 325 "A cabal file that refers to nonexistent other files (e.g. a license-file that doesn't exist). Running 'cabal check' may point out these issues." : 326 if isSimpleBuildType 327 then [] 328 else ["The Setup.hs file is changing the installation target dir."] 329 330showBuildError 331 :: Bool 332 -> ExitCode 333 -> Maybe PackageIdentifier 334 -> Path Abs File 335 -> [String] 336 -> Maybe (Path Abs File) 337 -> [Text] 338 -> String 339showBuildError isBuildingSetup exitCode mtaskProvides execName fullArgs logFiles bss = 340 let fullCmd = unwords 341 $ dropQuotes (toFilePath execName) 342 : map (T.unpack . showProcessArgDebug) fullArgs 343 logLocations = maybe "" (\fp -> "\n Logs have been written to: " ++ toFilePath fp) logFiles 344 in "\n-- While building " ++ 345 (case (isBuildingSetup, mtaskProvides) of 346 (False, Nothing) -> error "Invariant violated: unexpected case in showBuildError" 347 (False, Just taskProvides') -> "package " ++ dropQuotes (packageIdentifierString taskProvides') 348 (True, Nothing) -> "simple Setup.hs" 349 (True, Just taskProvides') -> "custom Setup.hs for package " ++ dropQuotes (packageIdentifierString taskProvides') 350 ) ++ 351 " (scroll up to its section to see the error) using:\n " ++ fullCmd ++ "\n" ++ 352 " Process exited with code: " ++ show exitCode ++ 353 (if exitCode == ExitFailure (-9) 354 then " (THIS MAY INDICATE OUT OF MEMORY)" 355 else "") ++ 356 logLocations ++ 357 (if null bss 358 then "" 359 else "\n\n" ++ removeTrailingSpaces (map T.unpack bss)) 360 where 361 removeTrailingSpaces = dropWhileEnd isSpace . unlines 362 dropQuotes = filter ('\"' /=) 363 364instance Exception StackBuildException 365 366---------------------------------------------- 367 368-- | Package dependency oracle. 369newtype PkgDepsOracle = 370 PkgDeps PackageName 371 deriving (Show,Typeable,Eq,NFData) 372 373-- | Stored on disk to know whether the files have changed. 374newtype BuildCache = BuildCache 375 { buildCacheTimes :: Map FilePath FileCacheInfo 376 -- ^ Modification times of files. 377 } 378 deriving (Generic, Eq, Show, Typeable, ToJSON, FromJSON) 379instance NFData BuildCache 380 381-- | Stored on disk to know whether the flags have changed. 382data ConfigCache = ConfigCache 383 { configCacheOpts :: !ConfigureOpts 384 -- ^ All options used for this package. 385 , configCacheDeps :: !(Set GhcPkgId) 386 -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take 387 -- the complete GhcPkgId (only a PackageIdentifier) in the configure 388 -- options, just using the previous value is insufficient to know if 389 -- dependencies have changed. 390 , configCacheComponents :: !(Set S.ByteString) 391 -- ^ The components to be built. It's a bit of a hack to include this in 392 -- here, as it's not a configure option (just a build option), but this 393 -- is a convenient way to force compilation when the components change. 394 , configCacheHaddock :: !Bool 395 -- ^ Are haddocks to be built? 396 , configCachePkgSrc :: !CachePkgSrc 397 , configCachePathEnvVar :: !Text 398 -- ^ Value of the PATH env var, see <https://github.com/commercialhaskell/stack/issues/3138> 399 } 400 deriving (Generic, Eq, Show, Data, Typeable) 401instance NFData ConfigCache 402 403data CachePkgSrc = CacheSrcUpstream | CacheSrcLocal FilePath 404 deriving (Generic, Eq, Read, Show, Data, Typeable) 405instance NFData CachePkgSrc 406 407instance PersistField CachePkgSrc where 408 toPersistValue CacheSrcUpstream = PersistText "upstream" 409 toPersistValue (CacheSrcLocal fp) = PersistText ("local:" <> T.pack fp) 410 fromPersistValue (PersistText t) = do 411 if t == "upstream" 412 then Right CacheSrcUpstream 413 else case T.stripPrefix "local:" t of 414 Just fp -> Right $ CacheSrcLocal (T.unpack fp) 415 Nothing -> Left $ "Unexpected CachePkgSrc value: " <> t 416 fromPersistValue _ = Left "Unexpected CachePkgSrc type" 417 418instance PersistFieldSql CachePkgSrc where 419 sqlType _ = SqlString 420 421toCachePkgSrc :: PackageSource -> CachePkgSrc 422toCachePkgSrc (PSFilePath lp) = CacheSrcLocal (toFilePath (parent (lpCabalFile lp))) 423toCachePkgSrc PSRemote{} = CacheSrcUpstream 424 425-- | A task to perform when building 426data Task = Task 427 { taskProvides :: !PackageIdentifier -- FIXME turn this into a function on taskType? 428 -- ^ the package/version to be built 429 , taskType :: !TaskType 430 -- ^ the task type, telling us how to build this 431 , taskConfigOpts :: !TaskConfigOpts 432 , taskBuildHaddock :: !Bool 433 , taskPresent :: !(Map PackageIdentifier GhcPkgId) 434 -- ^ GhcPkgIds of already-installed dependencies 435 , taskAllInOne :: !Bool 436 -- ^ indicates that the package can be built in one step 437 , taskCachePkgSrc :: !CachePkgSrc 438 , taskAnyMissing :: !Bool 439 -- ^ Were any of the dependencies missing? The reason this is 440 -- necessary is... hairy. And as you may expect, a bug in 441 -- Cabal. See: 442 -- <https://github.com/haskell/cabal/issues/4728#issuecomment-337937673>. The 443 -- problem is that Cabal may end up generating the same package ID 444 -- for a dependency, even if the ABI has changed. As a result, 445 -- without this field, Stack would think that a reconfigure is 446 -- unnecessary, when in fact we _do_ need to reconfigure. The 447 -- details here suck. We really need proper hashes for package 448 -- identifiers. 449 , taskBuildTypeConfig :: !Bool 450 -- ^ Is the build type of this package Configure. Check out 451 -- ensureConfigureScript in Stack.Build.Execute for the motivation 452 } 453 deriving Show 454 455-- | Given the IDs of any missing packages, produce the configure options 456data TaskConfigOpts = TaskConfigOpts 457 { tcoMissing :: !(Set PackageIdentifier) 458 -- ^ Dependencies for which we don't yet have an GhcPkgId 459 , tcoOpts :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts) 460 -- ^ Produce the list of options given the missing @GhcPkgId@s 461 } 462instance Show TaskConfigOpts where 463 show (TaskConfigOpts missing f) = concat 464 [ "Missing: " 465 , show missing 466 , ". Without those: " 467 , show $ f Map.empty 468 ] 469 470-- | The type of a task, either building local code or something from the 471-- package index (upstream) 472data TaskType 473 = TTLocalMutable LocalPackage 474 | TTRemotePackage IsMutable Package PackageLocationImmutable 475 deriving Show 476 477data IsMutable 478 = Mutable 479 | Immutable 480 deriving (Eq, Show) 481 482instance Semigroup IsMutable where 483 Mutable <> _ = Mutable 484 _ <> Mutable = Mutable 485 Immutable <> Immutable = Immutable 486 487instance Monoid IsMutable where 488 mempty = Immutable 489 mappend = (<>) 490 491taskIsTarget :: Task -> Bool 492taskIsTarget t = 493 case taskType t of 494 TTLocalMutable lp -> lpWanted lp 495 _ -> False 496 497taskLocation :: Task -> InstallLocation 498taskLocation task = 499 case taskType task of 500 TTLocalMutable _ -> Local 501 TTRemotePackage Mutable _ _ -> Local 502 TTRemotePackage Immutable _ _ -> Snap 503 504taskTargetIsMutable :: Task -> IsMutable 505taskTargetIsMutable task = 506 case taskType task of 507 TTLocalMutable _ -> Mutable 508 TTRemotePackage mutable _ _ -> mutable 509 510installLocationIsMutable :: InstallLocation -> IsMutable 511installLocationIsMutable Snap = Immutable 512installLocationIsMutable Local = Mutable 513 514-- | A complete plan of what needs to be built and how to do it 515data Plan = Plan 516 { planTasks :: !(Map PackageName Task) 517 , planFinals :: !(Map PackageName Task) 518 -- ^ Final actions to be taken (test, benchmark, etc) 519 , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text)) 520 -- ^ Text is reason we're unregistering, for display only 521 , planInstallExes :: !(Map Text InstallLocation) 522 -- ^ Executables that should be installed after successful building 523 } 524 deriving Show 525 526-- | Basic information used to calculate what the configure options are 527data BaseConfigOpts = BaseConfigOpts 528 { bcoSnapDB :: !(Path Abs Dir) 529 , bcoLocalDB :: !(Path Abs Dir) 530 , bcoSnapInstallRoot :: !(Path Abs Dir) 531 , bcoLocalInstallRoot :: !(Path Abs Dir) 532 , bcoBuildOpts :: !BuildOpts 533 , bcoBuildOptsCLI :: !BuildOptsCLI 534 , bcoExtraDBs :: ![Path Abs Dir] 535 } 536 deriving Show 537 538-- | Render a @BaseConfigOpts@ to an actual list of options 539configureOpts :: EnvConfig 540 -> BaseConfigOpts 541 -> Map PackageIdentifier GhcPkgId -- ^ dependencies 542 -> Bool -- ^ local non-extra-dep? 543 -> IsMutable 544 -> Package 545 -> ConfigureOpts 546configureOpts econfig bco deps isLocal isMutable package = ConfigureOpts 547 { coDirs = configureOptsDirs bco isMutable package 548 , coNoDirs = configureOptsNoDir econfig bco deps isLocal package 549 } 550 551-- options set by stack 552isStackOpt :: Text -> Bool 553isStackOpt t = any (`T.isPrefixOf` t) 554 [ "--dependency=" 555 , "--constraint=" 556 , "--package-db=" 557 , "--libdir=" 558 , "--bindir=" 559 , "--datadir=" 560 , "--libexecdir=" 561 , "--sysconfdir" 562 , "--docdir=" 563 , "--htmldir=" 564 , "--haddockdir=" 565 , "--enable-tests" 566 , "--enable-benchmarks" 567 , "--exact-configuration" 568 -- Treat these as causing dirtiness, to resolve 569 -- https://github.com/commercialhaskell/stack/issues/2984 570 -- 571 -- , "--enable-library-profiling" 572 -- , "--enable-executable-profiling" 573 -- , "--enable-profiling" 574 ] || t == "--user" 575 576configureOptsDirs :: BaseConfigOpts 577 -> IsMutable 578 -> Package 579 -> [String] 580configureOptsDirs bco isMutable package = concat 581 [ ["--user", "--package-db=clear", "--package-db=global"] 582 , map (("--package-db=" ++) . toFilePathNoTrailingSep) $ case isMutable of 583 Immutable -> bcoExtraDBs bco ++ [bcoSnapDB bco] 584 Mutable -> bcoExtraDBs bco ++ [bcoSnapDB bco] ++ [bcoLocalDB bco] 585 , [ "--libdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLib) 586 , "--bindir=" ++ toFilePathNoTrailingSep (installRoot </> bindirSuffix) 587 , "--datadir=" ++ toFilePathNoTrailingSep (installRoot </> relDirShare) 588 , "--libexecdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLibexec) 589 , "--sysconfdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirEtc) 590 , "--docdir=" ++ toFilePathNoTrailingSep docDir 591 , "--htmldir=" ++ toFilePathNoTrailingSep docDir 592 , "--haddockdir=" ++ toFilePathNoTrailingSep docDir] 593 ] 594 where 595 installRoot = 596 case isMutable of 597 Immutable -> bcoSnapInstallRoot bco 598 Mutable -> bcoLocalInstallRoot bco 599 docDir = 600 case pkgVerDir of 601 Nothing -> installRoot </> docDirSuffix 602 Just dir -> installRoot </> docDirSuffix </> dir 603 pkgVerDir = 604 parseRelDir (packageIdentifierString (PackageIdentifier (packageName package) 605 (packageVersion package)) ++ 606 [pathSeparator]) 607 608-- | Same as 'configureOpts', but does not include directory path options 609configureOptsNoDir :: EnvConfig 610 -> BaseConfigOpts 611 -> Map PackageIdentifier GhcPkgId -- ^ dependencies 612 -> Bool -- ^ is this a local, non-extra-dep? 613 -> Package 614 -> [String] 615configureOptsNoDir econfig bco deps isLocal package = concat 616 [ depOptions 617 , ["--enable-library-profiling" | boptsLibProfile bopts || boptsExeProfile bopts] 618 -- Cabal < 1.21.1 does not support --enable-profiling, use --enable-executable-profiling instead 619 , let profFlag = "--enable-" <> concat ["executable-" | not newerCabal] <> "profiling" 620 in [ profFlag | boptsExeProfile bopts && isLocal] 621 , ["--enable-split-objs" | boptsSplitObjs bopts] 622 , ["--disable-library-stripping" | not $ boptsLibStrip bopts || boptsExeStrip bopts] 623 , ["--disable-executable-stripping" | not (boptsExeStrip bopts) && isLocal] 624 , map (\(name,enabled) -> 625 "-f" <> 626 (if enabled 627 then "" 628 else "-") <> 629 flagNameString name) 630 (Map.toList flags) 631 , map T.unpack $ packageCabalConfigOpts package 632 , processGhcOptions (packageGhcOptions package) 633 , map ("--extra-include-dirs=" ++) (configExtraIncludeDirs config) 634 , map ("--extra-lib-dirs=" ++) (configExtraLibDirs config) 635 , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config) 636 , ["--exact-configuration"] 637 , ["--ghc-option=-fhide-source-paths" | hideSourcePaths cv] 638 ] 639 where 640 -- This function parses the GHC options that are providing in the 641 -- stack.yaml file. In order to handle RTS arguments correctly, we need 642 -- to provide the RTS arguments as a single argument. 643 processGhcOptions :: [Text] -> [String] 644 processGhcOptions args = 645 let 646 (preRtsArgs, mid) = 647 break ("+RTS" ==) args 648 (rtsArgs, end) = 649 break ("-RTS" ==) mid 650 fullRtsArgs = 651 case rtsArgs of 652 [] -> 653 -- This means that we didn't have any RTS args - no 654 -- `+RTS` - and therefore no need for a `-RTS`. 655 [] 656 _ -> 657 -- In this case, we have some RTS args. `break` 658 -- puts the `"-RTS"` string in the `snd` list, so 659 -- we want to append it on the end of `rtsArgs` 660 -- here. 661 -- 662 -- We're not checking that `-RTS` is the first 663 -- element of `end`. This is because the GHC RTS 664 -- allows you to omit a trailing -RTS if that's the 665 -- last of the arguments. This permits a GHC 666 -- options in stack.yaml that matches what you 667 -- might pass directly to GHC. 668 [T.unwords $ rtsArgs ++ ["-RTS"]] 669 -- We drop the first element from `end`, because it is always 670 -- either `"-RTS"` (and we don't want that as a separate 671 -- argument) or the list is empty (and `drop _ [] = []`). 672 postRtsArgs = 673 drop 1 end 674 newArgs = 675 concat [preRtsArgs, fullRtsArgs, postRtsArgs] 676 in 677 concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) newArgs 678 679 wc = view (actualCompilerVersionL.to whichCompiler) econfig 680 cv = view (actualCompilerVersionL.to getGhcVersion) econfig 681 682 hideSourcePaths ghcVersion = ghcVersion >= mkVersion [8, 2] && configHideSourcePaths config 683 684 config = view configL econfig 685 bopts = bcoBuildOpts bco 686 687 newerCabal = view cabalVersionL econfig >= mkVersion [1, 22] 688 689 -- Unioning atop defaults is needed so that all flags are specified 690 -- with --exact-configuration. 691 flags = packageFlags package `Map.union` packageDefaultFlags package 692 693 depOptions = map (uncurry toDepOption) $ Map.toList deps 694 where 695 toDepOption = if newerCabal then toDepOption1_22 else toDepOption1_18 696 697 toDepOption1_22 (PackageIdentifier name _) gid = concat 698 [ "--dependency=" 699 , packageNameString name 700 , "=" 701 , ghcPkgIdString gid 702 ] 703 704 toDepOption1_18 ident _gid = concat 705 [ "--constraint=" 706 , packageNameString name 707 , "==" 708 , versionString version' 709 ] 710 where 711 PackageIdentifier name version' = ident 712 713-- | Get set of wanted package names from locals. 714wantedLocalPackages :: [LocalPackage] -> Set PackageName 715wantedLocalPackages = Set.fromList . map (packageName . lpPackage) . filter lpWanted 716 717-- | Configure options to be sent to Setup.hs configure 718data ConfigureOpts = ConfigureOpts 719 { coDirs :: ![String] 720 -- ^ Options related to various paths. We separate these out since they do 721 -- not have an impact on the contents of the compiled binary for checking 722 -- if we can use an existing precompiled cache. 723 , coNoDirs :: ![String] 724 } 725 deriving (Show, Eq, Generic, Data, Typeable) 726instance NFData ConfigureOpts 727 728-- | Information on a compiled package: the library conf file (if relevant), 729-- the sublibraries (if present) and all of the executable paths. 730data PrecompiledCache base = PrecompiledCache 731 { pcLibrary :: !(Maybe (Path base File)) 732 -- ^ .conf file inside the package database 733 , pcSubLibs :: ![Path base File] 734 -- ^ .conf file inside the package database, for each of the sublibraries 735 , pcExes :: ![Path base File] 736 -- ^ Full paths to executables 737 } 738 deriving (Show, Eq, Generic, Typeable) 739instance NFData (PrecompiledCache Abs) 740instance NFData (PrecompiledCache Rel) 741