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