@@ -96,10 +96,10 @@ import Distribution.Text
9696
9797-- Base
9898import System.Environment (getArgs , getProgName )
99- import System.Directory (removeFile , doesFileExist
99+ import System.Directory (removeFile , doesFileExist , getCurrentDirectory
100100 ,doesDirectoryExist , removeDirectoryRecursive )
101101import System.Exit (exitWith ,ExitCode (.. ))
102- import System.FilePath (searchPathSeparator )
102+ import System.FilePath (searchPathSeparator , takeDirectory , (</>) )
103103import Distribution.Compat.Environment (getEnvironment )
104104import Distribution.Compat.GetShortPathName (getShortPathName )
105105
@@ -248,9 +248,10 @@ buildAction :: UserHooks -> BuildFlags -> Args -> IO ()
248248buildAction hooks flags args = do
249249 distPref <- findDistPrefOrDefault (buildDistPref flags)
250250 let verbosity = fromFlag $ buildVerbosity flags
251- flags' = flags { buildDistPref = toFlag distPref }
252-
253251 lbi <- getBuildConfig hooks verbosity distPref
252+ let flags' = flags { buildDistPref = toFlag distPref
253+ , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)}
254+
254255 progs <- reconfigurePrograms verbosity
255256 (buildProgramPaths flags')
256257 (buildProgramArgs flags')
@@ -288,7 +289,10 @@ hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()
288289hscolourAction hooks flags args = do
289290 distPref <- findDistPrefOrDefault (hscolourDistPref flags)
290291 let verbosity = fromFlag $ hscolourVerbosity flags
291- flags' = flags { hscolourDistPref = toFlag distPref }
292+ lbi <- getBuildConfig hooks verbosity distPref
293+ let flags' = flags { hscolourDistPref = toFlag distPref
294+ , hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)}
295+
292296 hookedAction preHscolour hscolourHook postHscolour
293297 (getBuildConfig hooks verbosity distPref)
294298 hooks flags' args
@@ -313,9 +317,10 @@ haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()
313317haddockAction hooks flags args = do
314318 distPref <- findDistPrefOrDefault (haddockDistPref flags)
315319 let verbosity = fromFlag $ haddockVerbosity flags
316- flags' = flags { haddockDistPref = toFlag distPref }
317-
318320 lbi <- getBuildConfig hooks verbosity distPref
321+ let flags' = flags { haddockDistPref = toFlag distPref
322+ , haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)}
323+
319324 progs <- reconfigurePrograms verbosity
320325 (haddockProgramPaths flags')
321326 (haddockProgramArgs flags')
@@ -328,7 +333,10 @@ haddockAction hooks flags args = do
328333cleanAction :: UserHooks -> CleanFlags -> Args -> IO ()
329334cleanAction hooks flags args = do
330335 distPref <- findDistPrefOrDefault (cleanDistPref flags)
331- let flags' = flags { cleanDistPref = toFlag distPref }
336+
337+ lbi <- getBuildConfig hooks verbosity distPref
338+ let flags' = flags { cleanDistPref = toFlag distPref
339+ , cleanCabalFilePath = maybeToFlag (cabalFilePath lbi)}
332340
333341 pbi <- preClean hooks args flags'
334342
@@ -354,7 +362,9 @@ copyAction :: UserHooks -> CopyFlags -> Args -> IO ()
354362copyAction hooks flags args = do
355363 distPref <- findDistPrefOrDefault (copyDistPref flags)
356364 let verbosity = fromFlag $ copyVerbosity flags
357- flags' = flags { copyDistPref = toFlag distPref }
365+ lbi <- getBuildConfig hooks verbosity distPref
366+ let flags' = flags { copyDistPref = toFlag distPref
367+ , copyCabalFilePath = maybeToFlag (cabalFilePath lbi)}
358368 hookedAction preCopy copyHook postCopy
359369 (getBuildConfig hooks verbosity distPref)
360370 hooks flags' { copyArgs = args } args
@@ -363,7 +373,9 @@ installAction :: UserHooks -> InstallFlags -> Args -> IO ()
363373installAction hooks flags args = do
364374 distPref <- findDistPrefOrDefault (installDistPref flags)
365375 let verbosity = fromFlag $ installVerbosity flags
366- flags' = flags { installDistPref = toFlag distPref }
376+ lbi <- getBuildConfig hooks verbosity distPref
377+ let flags' = flags { installDistPref = toFlag distPref
378+ , installCabalFilePath = maybeToFlag (cabalFilePath lbi)}
367379 hookedAction preInst instHook postInst
368380 (getBuildConfig hooks verbosity distPref)
369381 hooks flags' args
@@ -427,7 +439,9 @@ registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()
427439registerAction hooks flags args = do
428440 distPref <- findDistPrefOrDefault (regDistPref flags)
429441 let verbosity = fromFlag $ regVerbosity flags
430- flags' = flags { regDistPref = toFlag distPref }
442+ lbi <- getBuildConfig hooks verbosity distPref
443+ let flags' = flags { regDistPref = toFlag distPref
444+ , regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
431445 hookedAction preReg regHook postReg
432446 (getBuildConfig hooks verbosity distPref)
433447 hooks flags' { regArgs = args } args
@@ -436,7 +450,9 @@ unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()
436450unregisterAction hooks flags args = do
437451 distPref <- findDistPrefOrDefault (regDistPref flags)
438452 let verbosity = fromFlag $ regVerbosity flags
439- flags' = flags { regDistPref = toFlag distPref }
453+ lbi <- getBuildConfig hooks verbosity distPref
454+ let flags' = flags { regDistPref = toFlag distPref
455+ , regCabalFilePath = maybeToFlag (cabalFilePath lbi)}
440456 hookedAction preUnreg unregHook postUnreg
441457 (getBuildConfig hooks verbosity distPref)
442458 hooks flags' args
@@ -618,62 +634,83 @@ defaultUserHooks = autoconfUserHooks {
618634 -- https://github.com/haskell/cabal/issues/158
619635 where oldCompatPostConf args flags pkg_descr lbi
620636 = do let verbosity = fromFlag (configVerbosity flags)
621- confExists <- doesFileExist " configure"
637+ baseDir lbi' = fromMaybe " " (takeDirectory <$> cabalFilePath lbi')
638+
639+ confExists <- doesFileExist $ (baseDir lbi) </> " configure"
622640 when confExists $
623641 runConfigureScript verbosity
624642 backwardsCompatHack flags lbi
625643
626- pbi <- getHookedBuildInfo verbosity
644+ base_dir <- getBaseDir (configCabalFilePath flags)
645+
646+ pbi <- getHookedBuildInfo base_dir verbosity
627647 sanityCheckHookedBuildInfo pkg_descr pbi
628648 let pkg_descr' = updatePackageDescription pbi pkg_descr
629649 lbi' = lbi { localPkgDescr = pkg_descr' }
630650 postConf simpleUserHooks args flags pkg_descr' lbi'
631651
632652 backwardsCompatHack = True
633653
654+ getBaseDir :: Flag FilePath -> IO FilePath
655+ getBaseDir flag = do
656+ -- compute the base directory. This is the current
657+ -- working directory unless a different one was provided
658+ -- via --cabal-file-path.
659+ pwd <- getCurrentDirectory
660+ return $ fromMaybe pwd (takeDirectory <$> flagToMaybe flag)
661+
634662autoconfUserHooks :: UserHooks
635663autoconfUserHooks
636664 = simpleUserHooks
637665 {
638666 postConf = defaultPostConf,
639- preBuild = readHookWithArgs buildVerbosity,
640- preCopy = readHookWithArgs copyVerbosity,
641- preClean = readHook cleanVerbosity,
642- preInst = readHook installVerbosity,
643- preHscolour = readHook hscolourVerbosity,
644- preHaddock = readHook haddockVerbosity,
645- preReg = readHook regVerbosity,
646- preUnreg = readHook regVerbosity
667+ preBuild = readHookWithArgs buildVerbosity buildCabalFilePath ,
668+ preCopy = readHookWithArgs copyVerbosity copyCabalFilePath ,
669+ preClean = readHook cleanVerbosity cleanCabalFilePath ,
670+ preInst = readHook installVerbosity installCabalFilePath ,
671+ preHscolour = readHook hscolourVerbosity hscolourCabalFilePath ,
672+ preHaddock = readHook haddockVerbosity haddockCabalFilePath ,
673+ preReg = readHook regVerbosity regCabalFilePath ,
674+ preUnreg = readHook regVerbosity regCabalFilePath
647675 }
648676 where defaultPostConf :: Args -> ConfigFlags -> PackageDescription
649677 -> LocalBuildInfo -> IO ()
650678 defaultPostConf args flags pkg_descr lbi
651679 = do let verbosity = fromFlag (configVerbosity flags)
652- confExists <- doesFileExist " configure"
680+ baseDir lbi' = fromMaybe " " (takeDirectory <$> cabalFilePath lbi')
681+ confExists <- doesFileExist $ (baseDir lbi) </> " configure"
653682 if confExists
654683 then runConfigureScript verbosity
655684 backwardsCompatHack flags lbi
656685 else die " configure script not found."
657686
658- pbi <- getHookedBuildInfo verbosity
687+ base_dir <- getBaseDir (configCabalFilePath flags)
688+
689+ pbi <- getHookedBuildInfo base_dir verbosity
659690 sanityCheckHookedBuildInfo pkg_descr pbi
660691 let pkg_descr' = updatePackageDescription pbi pkg_descr
661692 lbi' = lbi { localPkgDescr = pkg_descr' }
662693 postConf simpleUserHooks args flags pkg_descr' lbi'
663694
664695 backwardsCompatHack = False
665696
666- readHookWithArgs :: (a -> Flag Verbosity ) -> Args -> a
697+ readHookWithArgs :: (a -> Flag Verbosity )
698+ -> (a -> Flag FilePath )
699+ -> Args -> a
667700 -> IO HookedBuildInfo
668- readHookWithArgs get_verbosity _ flags = do
669- getHookedBuildInfo verbosity
701+ readHookWithArgs get_verbosity get_cabal_file_path _ flags = do
702+ base_dir <- getBaseDir (get_cabal_file_path flags)
703+ getHookedBuildInfo base_dir verbosity
670704 where
671705 verbosity = fromFlag (get_verbosity flags)
672706
673- readHook :: (a -> Flag Verbosity ) -> Args -> a -> IO HookedBuildInfo
674- readHook get_verbosity a flags = do
707+ readHook :: (a -> Flag Verbosity )
708+ -> (a -> Flag FilePath )
709+ -> Args -> a -> IO HookedBuildInfo
710+ readHook get_verbosity get_cabal_file_path a flags = do
675711 noExtraFlags a
676- getHookedBuildInfo verbosity
712+ base_dir <- getBaseDir (get_cabal_file_path flags)
713+ getHookedBuildInfo base_dir verbosity
677714 where
678715 verbosity = fromFlag (get_verbosity flags)
679716
@@ -705,8 +742,9 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
705742 shConfiguredProg <- lookupProgram shProg
706743 `fmap` configureProgram verbosity shProg progDb
707744 case shConfiguredProg of
708- Just sh -> runProgramInvocation verbosity
745+ Just sh -> runProgramInvocation verbosity $
709746 (programInvocation (sh {programOverrideEnv = overEnv}) args')
747+ { progInvokeCwd = takeDirectory <$> cabalFilePath lbi }
710748 Nothing -> die notFoundMsg
711749
712750 where
@@ -718,9 +756,13 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
718756 ++ " If you are not on Windows, ensure that an 'sh' command "
719757 ++ " is discoverable in your path."
720758
721- getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo
722- getHookedBuildInfo verbosity = do
723- maybe_infoFile <- defaultHookedPackageDesc
759+ getHookedBuildInfo :: FilePath -> Verbosity -> IO HookedBuildInfo
760+ getHookedBuildInfo baseDir verbosity = do
761+ -- TODO: We should probably better generate this in the
762+ -- build dir, rather then in the base dir? However
763+ -- `configure` is run in the baseDir.
764+
765+ maybe_infoFile <- findHookedPackageDesc baseDir
724766 case maybe_infoFile of
725767 Nothing -> return emptyHookedBuildInfo
726768 Just infoFile -> do
0 commit comments