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