1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE RankNTypes #-} 3{-# LANGUAGE LambdaCase #-} 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Simple 7-- Copyright : Isaac Jones 2003-2005 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This is the command line front end to the Simple build system. When given 14-- the parsed command-line args and package information, is able to perform 15-- basic commands like configure, build, install, register, etc. 16-- 17-- This module exports the main functions that Setup.hs scripts use. It 18-- re-exports the 'UserHooks' type, the standard entry points like 19-- 'defaultMain' and 'defaultMainWithHooks' and the predefined sets of 20-- 'UserHooks' that custom @Setup.hs@ scripts can extend to add their own 21-- behaviour. 22-- 23-- This module isn't called \"Simple\" because it's simple. Far from 24-- it. It's called \"Simple\" because it does complicated things to 25-- simple software. 26-- 27-- The original idea was that there could be different build systems that all 28-- presented the same compatible command line interfaces. There is still a 29-- "Distribution.Make" system but in practice no packages use it. 30 31{- 32Work around this warning: 33libraries/Cabal/Distribution/Simple.hs:78:0: 34 Warning: In the use of `runTests' 35 (imported from Distribution.Simple.UserHooks): 36 Deprecated: "Please use the new testing interface instead!" 37-} 38{-# OPTIONS_GHC -fno-warn-deprecations #-} 39 40module Distribution.Simple ( 41 module Distribution.Package, 42 module Distribution.Version, 43 module Distribution.License, 44 module Distribution.Simple.Compiler, 45 module Language.Haskell.Extension, 46 -- * Simple interface 47 defaultMain, defaultMainNoRead, defaultMainArgs, 48 -- * Customization 49 UserHooks(..), Args, 50 defaultMainWithHooks, defaultMainWithHooksArgs, 51 defaultMainWithHooksNoRead, defaultMainWithHooksNoReadArgs, 52 -- ** Standard sets of hooks 53 simpleUserHooks, 54 autoconfUserHooks, 55 emptyUserHooks, 56 ) where 57 58import Control.Exception (try) 59 60import Prelude () 61import Distribution.Compat.Prelude 62 63-- local 64import Distribution.Simple.Compiler 65import Distribution.Simple.UserHooks 66import Distribution.Package 67import Distribution.PackageDescription 68import Distribution.PackageDescription.Configuration 69import Distribution.Simple.Program 70import Distribution.Simple.Program.Db 71import Distribution.Simple.PreProcess 72import Distribution.Simple.Setup 73import Distribution.Simple.Command 74 75import Distribution.Simple.Build 76import Distribution.Simple.SrcDist 77import Distribution.Simple.Register 78 79import Distribution.Simple.Configure 80 81import Distribution.Simple.LocalBuildInfo 82import Distribution.Simple.Bench 83import Distribution.Simple.BuildPaths 84import Distribution.Simple.Test 85import Distribution.Simple.Install 86import Distribution.Simple.Haddock 87import Distribution.Simple.Utils 88import Distribution.Utils.NubList 89import Distribution.Verbosity 90import Language.Haskell.Extension 91import Distribution.Version 92import Distribution.License 93import Distribution.Pretty 94import Distribution.System (buildPlatform) 95 96-- Base 97import System.Environment (getArgs, getProgName) 98import System.Directory (removeFile, doesFileExist 99 ,doesDirectoryExist, removeDirectoryRecursive) 100import System.FilePath (searchPathSeparator, takeDirectory, (</>), splitDirectories, dropDrive) 101import Distribution.Compat.ResponseFile (expandResponse) 102import Distribution.Compat.Directory (makeAbsolute) 103import Distribution.Compat.Environment (getEnvironment) 104import Distribution.Compat.GetShortPathName (getShortPathName) 105 106import Data.List (unionBy, (\\)) 107 108import Distribution.PackageDescription.Parsec 109 110-- | A simple implementation of @main@ for a Cabal setup script. 111-- It reads the package description file using IO, and performs the 112-- action specified on the command line. 113defaultMain :: IO () 114defaultMain = getArgs >>= defaultMainHelper simpleUserHooks 115 116-- | A version of 'defaultMain' that is passed the command line 117-- arguments, rather than getting them from the environment. 118defaultMainArgs :: [String] -> IO () 119defaultMainArgs = defaultMainHelper simpleUserHooks 120 121-- | A customizable version of 'defaultMain'. 122defaultMainWithHooks :: UserHooks -> IO () 123defaultMainWithHooks hooks = getArgs >>= defaultMainHelper hooks 124 125-- | A customizable version of 'defaultMain' that also takes the command 126-- line arguments. 127defaultMainWithHooksArgs :: UserHooks -> [String] -> IO () 128defaultMainWithHooksArgs = defaultMainHelper 129 130-- | Like 'defaultMain', but accepts the package description as input 131-- rather than using IO to read it. 132defaultMainNoRead :: GenericPackageDescription -> IO () 133defaultMainNoRead = defaultMainWithHooksNoRead simpleUserHooks 134 135-- | A customizable version of 'defaultMainNoRead'. 136defaultMainWithHooksNoRead :: UserHooks -> GenericPackageDescription -> IO () 137defaultMainWithHooksNoRead hooks pkg_descr = 138 getArgs >>= 139 defaultMainHelper hooks { readDesc = return (Just pkg_descr) } 140 141-- | A customizable version of 'defaultMainNoRead' that also takes the 142-- command line arguments. 143-- 144-- @since 2.2.0.0 145defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription -> [String] -> IO () 146defaultMainWithHooksNoReadArgs hooks pkg_descr = 147 defaultMainHelper hooks { readDesc = return (Just pkg_descr) } 148 149defaultMainHelper :: UserHooks -> Args -> IO () 150defaultMainHelper hooks args = topHandler $ do 151 args' <- expandResponse args 152 case commandsRun (globalCommand commands) commands args' of 153 CommandHelp help -> printHelp help 154 CommandList opts -> printOptionsList opts 155 CommandErrors errs -> printErrors errs 156 CommandReadyToGo (flags, commandParse) -> 157 case commandParse of 158 _ | fromFlag (globalVersion flags) -> printVersion 159 | fromFlag (globalNumericVersion flags) -> printNumericVersion 160 CommandHelp help -> printHelp help 161 CommandList opts -> printOptionsList opts 162 CommandErrors errs -> printErrors errs 163 CommandReadyToGo action -> action 164 165 where 166 printHelp help = getProgName >>= putStr . help 167 printOptionsList = putStr . unlines 168 printErrors errs = do 169 putStr (intercalate "\n" errs) 170 exitWith (ExitFailure 1) 171 printNumericVersion = putStrLn $ prettyShow cabalVersion 172 printVersion = putStrLn $ "Cabal library version " 173 ++ prettyShow cabalVersion 174 175 progs = addKnownPrograms (hookedPrograms hooks) defaultProgramDb 176 commands = 177 [configureCommand progs `commandAddAction` 178 \fs as -> configureAction hooks fs as >> return () 179 ,buildCommand progs `commandAddAction` buildAction hooks 180 ,showBuildInfoCommand progs `commandAddAction` showBuildInfoAction hooks 181 ,replCommand progs `commandAddAction` replAction hooks 182 ,installCommand `commandAddAction` installAction hooks 183 ,copyCommand `commandAddAction` copyAction hooks 184 ,haddockCommand `commandAddAction` haddockAction hooks 185 ,cleanCommand `commandAddAction` cleanAction hooks 186 ,sdistCommand `commandAddAction` sdistAction hooks 187 ,hscolourCommand `commandAddAction` hscolourAction hooks 188 ,registerCommand `commandAddAction` registerAction hooks 189 ,unregisterCommand `commandAddAction` unregisterAction hooks 190 ,testCommand `commandAddAction` testAction hooks 191 ,benchmarkCommand `commandAddAction` benchAction hooks 192 ] 193 194-- | Combine the preprocessors in the given hooks with the 195-- preprocessors built into cabal. 196allSuffixHandlers :: UserHooks 197 -> [PPSuffixHandler] 198allSuffixHandlers hooks 199 = overridesPP (hookedPreProcessors hooks) knownSuffixHandlers 200 where 201 overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler] 202 overridesPP = unionBy (\x y -> fst x == fst y) 203 204configureAction :: UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo 205configureAction hooks flags args = do 206 distPref <- findDistPrefOrDefault (configDistPref flags) 207 let flags' = flags { configDistPref = toFlag distPref 208 , configArgs = args } 209 210 -- See docs for 'HookedBuildInfo' 211 pbi <- preConf hooks args flags' 212 213 (mb_pd_file, pkg_descr0) <- confPkgDescr hooks verbosity 214 (flagToMaybe (configCabalFilePath flags)) 215 216 let epkg_descr = (pkg_descr0, pbi) 217 218 localbuildinfo0 <- confHook hooks epkg_descr flags' 219 220 -- remember the .cabal filename if we know it 221 -- and all the extra command line args 222 let localbuildinfo = localbuildinfo0 { 223 pkgDescrFile = mb_pd_file, 224 extraConfigArgs = args 225 } 226 writePersistBuildConfig distPref localbuildinfo 227 228 let pkg_descr = localPkgDescr localbuildinfo 229 postConf hooks args flags' pkg_descr localbuildinfo 230 return localbuildinfo 231 where 232 verbosity = fromFlag (configVerbosity flags) 233 234confPkgDescr :: UserHooks -> Verbosity -> Maybe FilePath 235 -> IO (Maybe FilePath, GenericPackageDescription) 236confPkgDescr hooks verbosity mb_path = do 237 mdescr <- readDesc hooks 238 case mdescr of 239 Just descr -> return (Nothing, descr) 240 Nothing -> do 241 pdfile <- case mb_path of 242 Nothing -> defaultPackageDesc verbosity 243 Just path -> return path 244 info verbosity "Using Parsec parser" 245 descr <- readGenericPackageDescription verbosity pdfile 246 return (Just pdfile, descr) 247 248buildAction :: UserHooks -> BuildFlags -> Args -> IO () 249buildAction hooks flags args = do 250 distPref <- findDistPrefOrDefault (buildDistPref flags) 251 let verbosity = fromFlag $ buildVerbosity flags 252 lbi <- getBuildConfig hooks verbosity distPref 253 let flags' = flags { buildDistPref = toFlag distPref 254 , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)} 255 256 progs <- reconfigurePrograms verbosity 257 (buildProgramPaths flags') 258 (buildProgramArgs flags') 259 (withPrograms lbi) 260 261 hookedAction verbosity preBuild buildHook postBuild 262 (return lbi { withPrograms = progs }) 263 hooks flags' { buildArgs = args } args 264 265showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO () 266showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do 267 distPref <- findDistPrefOrDefault (buildDistPref flags) 268 let verbosity = fromFlag $ buildVerbosity flags 269 lbi <- getBuildConfig hooks verbosity distPref 270 let flags' = flags { buildDistPref = toFlag distPref 271 , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) 272 } 273 274 progs <- reconfigurePrograms verbosity 275 (buildProgramPaths flags') 276 (buildProgramArgs flags') 277 (withPrograms lbi) 278 279 pbi <- preBuild hooks args flags' 280 let lbi' = lbi { withPrograms = progs } 281 pkg_descr0 = localPkgDescr lbi' 282 pkg_descr = updatePackageDescription pbi pkg_descr0 283 -- TODO: Somehow don't ignore build hook? 284 buildInfoString <- showBuildInfo pkg_descr lbi' flags 285 286 case fileOutput of 287 Nothing -> putStr buildInfoString 288 Just fp -> writeFile fp buildInfoString 289 290 postBuild hooks args flags' pkg_descr lbi' 291 292replAction :: UserHooks -> ReplFlags -> Args -> IO () 293replAction hooks flags args = do 294 distPref <- findDistPrefOrDefault (replDistPref flags) 295 let verbosity = fromFlag $ replVerbosity flags 296 flags' = flags { replDistPref = toFlag distPref } 297 298 lbi <- getBuildConfig hooks verbosity distPref 299 progs <- reconfigurePrograms verbosity 300 (replProgramPaths flags') 301 (replProgramArgs flags') 302 (withPrograms lbi) 303 304 -- As far as I can tell, the only reason this doesn't use 305 -- 'hookedActionWithArgs' is because the arguments of 'replHook' 306 -- takes the args explicitly. UGH. -- ezyang 307 pbi <- preRepl hooks args flags' 308 let pkg_descr0 = localPkgDescr lbi 309 sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi 310 let pkg_descr = updatePackageDescription pbi pkg_descr0 311 lbi' = lbi { withPrograms = progs 312 , localPkgDescr = pkg_descr } 313 replHook hooks pkg_descr lbi' hooks flags' args 314 postRepl hooks args flags' pkg_descr lbi' 315 316hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO () 317hscolourAction hooks flags args = do 318 distPref <- findDistPrefOrDefault (hscolourDistPref flags) 319 let verbosity = fromFlag $ hscolourVerbosity flags 320 lbi <- getBuildConfig hooks verbosity distPref 321 let flags' = flags { hscolourDistPref = toFlag distPref 322 , hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)} 323 324 hookedAction verbosity preHscolour hscolourHook postHscolour 325 (getBuildConfig hooks verbosity distPref) 326 hooks flags' args 327 328haddockAction :: UserHooks -> HaddockFlags -> Args -> IO () 329haddockAction hooks flags args = do 330 distPref <- findDistPrefOrDefault (haddockDistPref flags) 331 let verbosity = fromFlag $ haddockVerbosity flags 332 lbi <- getBuildConfig hooks verbosity distPref 333 let flags' = flags { haddockDistPref = toFlag distPref 334 , haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)} 335 336 progs <- reconfigurePrograms verbosity 337 (haddockProgramPaths flags') 338 (haddockProgramArgs flags') 339 (withPrograms lbi) 340 341 hookedAction verbosity preHaddock haddockHook postHaddock 342 (return lbi { withPrograms = progs }) 343 hooks flags' { haddockArgs = args } args 344 345cleanAction :: UserHooks -> CleanFlags -> Args -> IO () 346cleanAction hooks flags args = do 347 distPref <- findDistPrefOrDefault (cleanDistPref flags) 348 349 elbi <- tryGetBuildConfig hooks verbosity distPref 350 let flags' = flags { cleanDistPref = toFlag distPref 351 , cleanCabalFilePath = case elbi of 352 Left _ -> mempty 353 Right lbi -> maybeToFlag (cabalFilePath lbi)} 354 355 pbi <- preClean hooks args flags' 356 357 (_, ppd) <- confPkgDescr hooks verbosity Nothing 358 -- It might seem like we are doing something clever here 359 -- but we're really not: if you look at the implementation 360 -- of 'clean' in the end all the package description is 361 -- used for is to clear out @extra-tmp-files@. IMO, 362 -- the configure script goo should go into @dist@ too! 363 -- -- ezyang 364 let pkg_descr0 = flattenPackageDescription ppd 365 -- We don't sanity check for clean as an error 366 -- here would prevent cleaning: 367 --sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi 368 let pkg_descr = updatePackageDescription pbi pkg_descr0 369 370 cleanHook hooks pkg_descr () hooks flags' 371 postClean hooks args flags' pkg_descr () 372 where 373 verbosity = fromFlag (cleanVerbosity flags) 374 375copyAction :: UserHooks -> CopyFlags -> Args -> IO () 376copyAction hooks flags args = do 377 distPref <- findDistPrefOrDefault (copyDistPref flags) 378 let verbosity = fromFlag $ copyVerbosity flags 379 lbi <- getBuildConfig hooks verbosity distPref 380 let flags' = flags { copyDistPref = toFlag distPref 381 , copyCabalFilePath = maybeToFlag (cabalFilePath lbi)} 382 hookedAction verbosity preCopy copyHook postCopy 383 (getBuildConfig hooks verbosity distPref) 384 hooks flags' { copyArgs = args } args 385 386installAction :: UserHooks -> InstallFlags -> Args -> IO () 387installAction hooks flags args = do 388 distPref <- findDistPrefOrDefault (installDistPref flags) 389 let verbosity = fromFlag $ installVerbosity flags 390 lbi <- getBuildConfig hooks verbosity distPref 391 let flags' = flags { installDistPref = toFlag distPref 392 , installCabalFilePath = maybeToFlag (cabalFilePath lbi)} 393 hookedAction verbosity preInst instHook postInst 394 (getBuildConfig hooks verbosity distPref) 395 hooks flags' args 396 397-- Since Cabal-3.4 UserHooks are completely ignored 398sdistAction :: UserHooks -> SDistFlags -> Args -> IO () 399sdistAction _hooks flags _args = do 400 (_, ppd) <- confPkgDescr emptyUserHooks verbosity Nothing 401 let pkg_descr = flattenPackageDescription ppd 402 sdist pkg_descr flags srcPref knownSuffixHandlers 403 where 404 verbosity = fromFlag (sDistVerbosity flags) 405 406testAction :: UserHooks -> TestFlags -> Args -> IO () 407testAction hooks flags args = do 408 distPref <- findDistPrefOrDefault (testDistPref flags) 409 let verbosity = fromFlag $ testVerbosity flags 410 flags' = flags { testDistPref = toFlag distPref } 411 412 hookedActionWithArgs verbosity preTest testHook postTest 413 (getBuildConfig hooks verbosity distPref) 414 hooks flags' args 415 416benchAction :: UserHooks -> BenchmarkFlags -> Args -> IO () 417benchAction hooks flags args = do 418 distPref <- findDistPrefOrDefault (benchmarkDistPref flags) 419 let verbosity = fromFlag $ benchmarkVerbosity flags 420 flags' = flags { benchmarkDistPref = toFlag distPref } 421 hookedActionWithArgs verbosity preBench benchHook postBench 422 (getBuildConfig hooks verbosity distPref) 423 hooks flags' args 424 425registerAction :: UserHooks -> RegisterFlags -> Args -> IO () 426registerAction hooks flags args = do 427 distPref <- findDistPrefOrDefault (regDistPref flags) 428 let verbosity = fromFlag $ regVerbosity flags 429 lbi <- getBuildConfig hooks verbosity distPref 430 let flags' = flags { regDistPref = toFlag distPref 431 , regCabalFilePath = maybeToFlag (cabalFilePath lbi)} 432 hookedAction verbosity preReg regHook postReg 433 (getBuildConfig hooks verbosity distPref) 434 hooks flags' { regArgs = args } args 435 436unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO () 437unregisterAction hooks flags args = do 438 distPref <- findDistPrefOrDefault (regDistPref flags) 439 let verbosity = fromFlag $ regVerbosity flags 440 lbi <- getBuildConfig hooks verbosity distPref 441 let flags' = flags { regDistPref = toFlag distPref 442 , regCabalFilePath = maybeToFlag (cabalFilePath lbi)} 443 hookedAction verbosity preUnreg unregHook postUnreg 444 (getBuildConfig hooks verbosity distPref) 445 hooks flags' args 446 447hookedAction 448 :: Verbosity 449 -> (UserHooks -> Args -> flags -> IO HookedBuildInfo) 450 -> (UserHooks -> PackageDescription -> LocalBuildInfo 451 -> UserHooks -> flags -> IO ()) 452 -> (UserHooks -> Args -> flags -> PackageDescription 453 -> LocalBuildInfo -> IO ()) 454 -> IO LocalBuildInfo 455 -> UserHooks -> flags -> Args -> IO () 456hookedAction verbosity pre_hook cmd_hook = 457 hookedActionWithArgs verbosity pre_hook 458 (\h _ pd lbi uh flags -> 459 cmd_hook h pd lbi uh flags) 460 461hookedActionWithArgs 462 :: Verbosity 463 -> (UserHooks -> Args -> flags -> IO HookedBuildInfo) 464 -> (UserHooks -> Args -> PackageDescription -> LocalBuildInfo 465 -> UserHooks -> flags -> IO ()) 466 -> (UserHooks -> Args -> flags -> PackageDescription 467 -> LocalBuildInfo -> IO ()) 468 -> IO LocalBuildInfo 469 -> UserHooks -> flags -> Args -> IO () 470hookedActionWithArgs verbosity pre_hook cmd_hook post_hook 471 get_build_config hooks flags args = do 472 pbi <- pre_hook hooks args flags 473 lbi0 <- get_build_config 474 let pkg_descr0 = localPkgDescr lbi0 475 sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi 476 let pkg_descr = updatePackageDescription pbi pkg_descr0 477 lbi = lbi0 { localPkgDescr = pkg_descr } 478 cmd_hook hooks args pkg_descr lbi hooks flags 479 post_hook hooks args flags pkg_descr lbi 480 481sanityCheckHookedBuildInfo 482 :: Verbosity -> PackageDescription -> HookedBuildInfo -> IO () 483sanityCheckHookedBuildInfo verbosity 484 (PackageDescription { library = Nothing }) (Just _,_) 485 = die' verbosity $ "The buildinfo contains info for a library, " 486 ++ "but the package does not have a library." 487 488sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes) 489 | exe1 : _ <- nonExistant 490 = die' verbosity $ "The buildinfo contains info for an executable called '" 491 ++ prettyShow exe1 ++ "' but the package does not have a " 492 ++ "executable with that name." 493 where 494 pkgExeNames = nub (map exeName (executables pkg_descr)) 495 hookExeNames = nub (map fst hookExes) 496 nonExistant = hookExeNames \\ pkgExeNames 497 498sanityCheckHookedBuildInfo _ _ _ = return () 499 500-- | Try to read the 'localBuildInfoFile' 501tryGetBuildConfig :: UserHooks -> Verbosity -> FilePath 502 -> IO (Either ConfigStateFileError LocalBuildInfo) 503tryGetBuildConfig u v = try . getBuildConfig u v 504 505 506-- | Read the 'localBuildInfoFile' or throw an exception. 507getBuildConfig :: UserHooks -> Verbosity -> FilePath -> IO LocalBuildInfo 508getBuildConfig hooks verbosity distPref = do 509 lbi_wo_programs <- getPersistBuildConfig distPref 510 -- Restore info about unconfigured programs, since it is not serialized 511 let lbi = lbi_wo_programs { 512 withPrograms = restoreProgramDb 513 (builtinPrograms ++ hookedPrograms hooks) 514 (withPrograms lbi_wo_programs) 515 } 516 517 case pkgDescrFile lbi of 518 Nothing -> return lbi 519 Just pkg_descr_file -> do 520 outdated <- checkPersistBuildConfigOutdated distPref pkg_descr_file 521 if outdated 522 then reconfigure pkg_descr_file lbi 523 else return lbi 524 525 where 526 reconfigure :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo 527 reconfigure pkg_descr_file lbi = do 528 notice verbosity $ pkg_descr_file ++ " has been changed. " 529 ++ "Re-configuring with most recently used options. " 530 ++ "If this fails, please run configure manually.\n" 531 let cFlags = configFlags lbi 532 let cFlags' = cFlags { 533 -- Since the list of unconfigured programs is not serialized, 534 -- restore it to the same value as normally used at the beginning 535 -- of a configure run: 536 configPrograms_ = fmap (restoreProgramDb 537 (builtinPrograms ++ hookedPrograms hooks)) 538 `fmap` configPrograms_ cFlags, 539 540 -- Use the current, not saved verbosity level: 541 configVerbosity = Flag verbosity 542 } 543 configureAction hooks cFlags' (extraConfigArgs lbi) 544 545 546-- -------------------------------------------------------------------------- 547-- Cleaning 548 549clean :: PackageDescription -> CleanFlags -> IO () 550clean pkg_descr flags = do 551 let distPref = fromFlagOrDefault defaultDistPref $ cleanDistPref flags 552 notice verbosity "cleaning..." 553 554 maybeConfig <- if fromFlag (cleanSaveConf flags) 555 then maybeGetPersistBuildConfig distPref 556 else return Nothing 557 558 -- remove the whole dist/ directory rather than tracking exactly what files 559 -- we created in there. 560 chattyTry "removing dist/" $ do 561 exists <- doesDirectoryExist distPref 562 when exists (removeDirectoryRecursive distPref) 563 564 -- Any extra files the user wants to remove 565 traverse_ removeFileOrDirectory (extraTmpFiles pkg_descr) 566 567 -- If the user wanted to save the config, write it back 568 traverse_ (writePersistBuildConfig distPref) maybeConfig 569 570 where 571 removeFileOrDirectory :: FilePath -> IO () 572 removeFileOrDirectory fname = do 573 isDir <- doesDirectoryExist fname 574 isFile <- doesFileExist fname 575 if isDir then removeDirectoryRecursive fname 576 else when isFile $ removeFile fname 577 verbosity = fromFlag (cleanVerbosity flags) 578 579-- -------------------------------------------------------------------------- 580-- Default hooks 581 582-- | Hooks that correspond to a plain instantiation of the 583-- \"simple\" build system 584simpleUserHooks :: UserHooks 585simpleUserHooks = 586 emptyUserHooks { 587 confHook = configure, 588 postConf = finalChecks, 589 buildHook = defaultBuildHook, 590 replHook = defaultReplHook, 591 copyHook = \desc lbi _ f -> install desc lbi f, 592 -- 'install' has correct 'copy' behavior with params 593 testHook = defaultTestHook, 594 benchHook = defaultBenchHook, 595 instHook = defaultInstallHook, 596 cleanHook = \p _ _ f -> clean p f, 597 hscolourHook = \p l h f -> hscolour p l (allSuffixHandlers h) f, 598 haddockHook = \p l h f -> haddock p l (allSuffixHandlers h) f, 599 regHook = defaultRegHook, 600 unregHook = \p l _ f -> unregister p l f 601 } 602 where 603 finalChecks _args flags pkg_descr lbi = 604 checkForeignDeps pkg_descr lbi (lessVerbose verbosity) 605 where 606 verbosity = fromFlag (configVerbosity flags) 607 608-- | Basic autoconf 'UserHooks': 609-- 610-- * 'postConf' runs @.\/configure@, if present. 611-- 612-- * the pre-hooks 'preBuild', 'preClean', 'preCopy', 'preInst', 613-- 'preReg' and 'preUnreg' read additional build information from 614-- /package/@.buildinfo@, if present. 615-- 616-- Thus @configure@ can use local system information to generate 617-- /package/@.buildinfo@ and possibly other files. 618 619autoconfUserHooks :: UserHooks 620autoconfUserHooks 621 = simpleUserHooks 622 { 623 postConf = defaultPostConf, 624 preBuild = readHookWithArgs buildVerbosity buildDistPref, -- buildCabalFilePath, 625 preCopy = readHookWithArgs copyVerbosity copyDistPref, 626 preClean = readHook cleanVerbosity cleanDistPref, 627 preInst = readHook installVerbosity installDistPref, 628 preHscolour = readHook hscolourVerbosity hscolourDistPref, 629 preHaddock = readHookWithArgs haddockVerbosity haddockDistPref, 630 preReg = readHook regVerbosity regDistPref, 631 preUnreg = readHook regVerbosity regDistPref 632 } 633 where defaultPostConf :: Args -> ConfigFlags -> PackageDescription 634 -> LocalBuildInfo -> IO () 635 defaultPostConf args flags pkg_descr lbi 636 = do let verbosity = fromFlag (configVerbosity flags) 637 baseDir lbi' = fromMaybe "" 638 (takeDirectory <$> cabalFilePath lbi') 639 confExists <- doesFileExist $ (baseDir lbi) </> "configure" 640 if confExists 641 then runConfigureScript verbosity 642 backwardsCompatHack flags lbi 643 else die' verbosity "configure script not found." 644 645 pbi <- getHookedBuildInfo verbosity (buildDir lbi) 646 sanityCheckHookedBuildInfo verbosity pkg_descr pbi 647 let pkg_descr' = updatePackageDescription pbi pkg_descr 648 lbi' = lbi { localPkgDescr = pkg_descr' } 649 postConf simpleUserHooks args flags pkg_descr' lbi' 650 651 backwardsCompatHack = False 652 653 readHookWithArgs :: (a -> Flag Verbosity) 654 -> (a -> Flag FilePath) 655 -> Args -> a 656 -> IO HookedBuildInfo 657 readHookWithArgs get_verbosity get_dist_pref _ flags = do 658 dist_dir <- findDistPrefOrDefault (get_dist_pref flags) 659 getHookedBuildInfo verbosity (dist_dir </> "build") 660 where 661 verbosity = fromFlag (get_verbosity flags) 662 663 readHook :: (a -> Flag Verbosity) 664 -> (a -> Flag FilePath) 665 -> Args -> a -> IO HookedBuildInfo 666 readHook get_verbosity get_dist_pref a flags = do 667 noExtraFlags a 668 dist_dir <- findDistPrefOrDefault (get_dist_pref flags) 669 getHookedBuildInfo verbosity (dist_dir </> "build") 670 where 671 verbosity = fromFlag (get_verbosity flags) 672 673runConfigureScript :: Verbosity -> Bool -> ConfigFlags -> LocalBuildInfo 674 -> IO () 675runConfigureScript verbosity backwardsCompatHack flags lbi = do 676 env <- getEnvironment 677 let programDb = withPrograms lbi 678 (ccProg, ccFlags) <- configureCCompiler verbosity programDb 679 ccProgShort <- getShortPathName ccProg 680 -- The C compiler's compilation and linker flags (e.g. 681 -- "C compiler flags" and "Gcc Linker flags" from GHC) have already 682 -- been merged into ccFlags, so we set both CFLAGS and LDFLAGS 683 -- to ccFlags 684 -- We don't try and tell configure which ld to use, as we don't have 685 -- a way to pass its flags too 686 configureFile <- makeAbsolute $ 687 fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure" 688 -- autoconf is fussy about filenames, and has a set of forbidden 689 -- characters that can't appear in the build directory, etc: 690 -- https://www.gnu.org/software/autoconf/manual/autoconf.html#File-System-Conventions 691 -- 692 -- This has caused hard-to-debug failures in the past (#5368), so we 693 -- detect some cases early and warn with a clear message. Windows's 694 -- use of backslashes is problematic here, so we'll switch to 695 -- slashes, but we do still want to fail on backslashes in POSIX 696 -- paths. 697 -- 698 -- TODO: We don't check for colons, tildes or leading dashes. We 699 -- also should check the builddir's path, destdir, and all other 700 -- paths as well. 701 let configureFile' = intercalate "/" $ splitDirectories configureFile 702 for_ badAutoconfCharacters $ \(c, cname) -> 703 when (c `elem` dropDrive configureFile') $ 704 warn verbosity $ concat 705 [ "The path to the './configure' script, '", configureFile' 706 , "', contains the character '", [c], "' (", cname, ")." 707 , " This may cause the script to fail with an obscure error, or for" 708 , " building the package to fail later." 709 ] 710 711 let extraPath = fromNubList $ configProgramPathExtra flags 712 let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) 713 $ lookup "CFLAGS" env 714 spSep = [searchPathSeparator] 715 pathEnv = maybe (intercalate spSep extraPath) 716 ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env 717 overEnv = ("CFLAGS", Just cflagsEnv) : 718 [("PATH", Just pathEnv) | not (null extraPath)] 719 hp = hostPlatform lbi 720 maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)] 721 args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag 722 shProg = simpleProgram "sh" 723 progDb = modifyProgramSearchPath 724 (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb 725 shConfiguredProg <- lookupProgram shProg 726 `fmap` configureProgram verbosity shProg progDb 727 case shConfiguredProg of 728 Just sh -> runProgramInvocation verbosity $ 729 (programInvocation (sh {programOverrideEnv = overEnv}) args') 730 { progInvokeCwd = Just (buildDir lbi) } 731 Nothing -> die' verbosity notFoundMsg 732 where 733 args = configureArgs backwardsCompatHack flags 734 735 notFoundMsg = "The package has a './configure' script. " 736 ++ "If you are on Windows, This requires a " 737 ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. " 738 ++ "If you are not on Windows, ensure that an 'sh' command " 739 ++ "is discoverable in your path." 740 741badAutoconfCharacters :: [(Char, String)] 742badAutoconfCharacters = 743 [ (' ', "space") 744 , ('\t', "tab") 745 , ('\n', "newline") 746 , ('\0', "null") 747 , ('"', "double quote") 748 , ('#', "hash") 749 , ('$', "dollar sign") 750 , ('&', "ampersand") 751 , ('\'', "single quote") 752 , ('(', "left bracket") 753 , (')', "right bracket") 754 , ('*', "star") 755 , (';', "semicolon") 756 , ('<', "less-than sign") 757 , ('=', "equals sign") 758 , ('>', "greater-than sign") 759 , ('?', "question mark") 760 , ('[', "left square bracket") 761 , ('\\', "backslash") 762 , ('`', "backtick") 763 , ('|', "pipe") 764 ] 765 766getHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo 767getHookedBuildInfo verbosity build_dir = do 768 maybe_infoFile <- findHookedPackageDesc verbosity build_dir 769 case maybe_infoFile of 770 Nothing -> return emptyHookedBuildInfo 771 Just infoFile -> do 772 info verbosity $ "Reading parameters from " ++ infoFile 773 readHookedBuildInfo verbosity infoFile 774 775defaultTestHook :: Args -> PackageDescription -> LocalBuildInfo 776 -> UserHooks -> TestFlags -> IO () 777defaultTestHook args pkg_descr localbuildinfo _ flags = 778 test args pkg_descr localbuildinfo flags 779 780defaultBenchHook :: Args -> PackageDescription -> LocalBuildInfo 781 -> UserHooks -> BenchmarkFlags -> IO () 782defaultBenchHook args pkg_descr localbuildinfo _ flags = 783 bench args pkg_descr localbuildinfo flags 784 785defaultInstallHook :: PackageDescription -> LocalBuildInfo 786 -> UserHooks -> InstallFlags -> IO () 787defaultInstallHook pkg_descr localbuildinfo _ flags = do 788 let copyFlags = defaultCopyFlags { 789 copyDistPref = installDistPref flags, 790 copyDest = installDest flags, 791 copyVerbosity = installVerbosity flags 792 } 793 install pkg_descr localbuildinfo copyFlags 794 let registerFlags = defaultRegisterFlags { 795 regDistPref = installDistPref flags, 796 regInPlace = installInPlace flags, 797 regPackageDB = installPackageDB flags, 798 regVerbosity = installVerbosity flags 799 } 800 when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags 801 802defaultBuildHook :: PackageDescription -> LocalBuildInfo 803 -> UserHooks -> BuildFlags -> IO () 804defaultBuildHook pkg_descr localbuildinfo hooks flags = 805 build pkg_descr localbuildinfo flags (allSuffixHandlers hooks) 806 807defaultReplHook :: PackageDescription -> LocalBuildInfo 808 -> UserHooks -> ReplFlags -> [String] -> IO () 809defaultReplHook pkg_descr localbuildinfo hooks flags args = 810 repl pkg_descr localbuildinfo flags (allSuffixHandlers hooks) args 811 812defaultRegHook :: PackageDescription -> LocalBuildInfo 813 -> UserHooks -> RegisterFlags -> IO () 814defaultRegHook pkg_descr localbuildinfo _ flags = 815 if hasLibs pkg_descr 816 then register pkg_descr localbuildinfo flags 817 else setupMessage (fromFlag (regVerbosity flags)) 818 "Package contains no library to register:" (packageId pkg_descr) 819