Cabal/src/Distribution/Simple.hs

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