Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b0ff24f454ace1acaa16e667c618e7b915422367 >--------------------------------------------------------------- commit b0ff24f454ace1acaa16e667c618e7b915422367 Author: Duncan Coutts <[email protected]> Date: Sat Aug 2 13:39:22 2008 +0000 Warn about symlinks that could not be created >--------------------------------------------------------------- cabal-install/Distribution/Client/Install.hs | 32 +++++++++++++++++- .../Distribution/Client/InstallSymlink.hs | 34 ++++++++++++------- 2 files changed, 51 insertions(+), 15 deletions(-) diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index fd96ad6..3b881d7 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -52,6 +52,7 @@ import Distribution.Client.Reporting import Distribution.Client.Logging ( writeInstallPlanBuildLog ) import qualified Distribution.Client.InstallSymlink as InstallSymlink + ( symlinkBinaries ) import Paths_cabal_install (getBinDir) import Distribution.Simple.Compiler @@ -77,7 +78,8 @@ import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.Version ( Version, VersionRange(AnyVersion, ThisVersion) ) -import Distribution.Simple.Utils as Utils (notice, info, die) +import Distribution.Simple.Utils as Utils + ( notice, info, warn, die, intercalate ) import Distribution.System ( buildOS, buildArch ) import Distribution.Text @@ -157,8 +159,8 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta pkg mpath useLogFile writeInstallPlanBuildReports installPlan' writeInstallPlanBuildLog installPlan' + symlinkBinaries verbosity configFlags installFlags installPlan' printBuildFailures installPlan' - InstallSymlink.symlinkBinaries configFlags installFlags installPlan' where setupScriptOptions index = SetupScriptOptions { @@ -245,6 +247,32 @@ printDryRun verbosity plan = case unfoldr next plan of (pkg:_) -> Just (pkgid, InstallPlan.completed pkgid plan') where pkgid = packageId pkg +symlinkBinaries :: Verbosity + -> Cabal.ConfigFlags + -> InstallFlags + -> InstallPlan BuildResult -> IO () +symlinkBinaries verbosity configFlags installFlags plan = do + failed <- InstallSymlink.symlinkBinaries configFlags installFlags plan + case failed of + [] -> return () + [(_, exe, path)] -> + warn verbosity $ + "could not create a symlink in " ++ bindir ++ " for " + ++ exe ++ " because the file exists there already but is not " + ++ "managed by cabal. You can create a symlink for this executable " + ++ "manually if you wish. The executable file has been installed at " + ++ path + exes -> + warn verbosity $ + "could not create symlinks in " ++ bindir ++ " for " + ++ intercalate ", " [ exe | (_, exe, _) <- exes ] + ++ " because the files exist there already and are not " + ++ "managed by cabal. You can create symlinks for these executables " + ++ "manually if you wish. The executable files have been installed at " + ++ intercalate ", " [ path | (_, _, path) <- exes ] + where + bindir = Cabal.fromFlag (installSymlinkBinDir installFlags) + printBuildFailures :: InstallPlan BuildResult -> IO () printBuildFailures plan = case [ (pkg, reason) diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs index 5c79183..8233427 100644 --- a/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/Distribution/Client/InstallSymlink.hs @@ -46,7 +46,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Package - ( Package(packageId) ) + ( PackageIdentifier, Package(packageId) ) import Distribution.Compiler ( CompilerId(..) ) import qualified Distribution.PackageDescription as PackageDescription @@ -70,6 +70,8 @@ import System.IO.Error ( catch, isDoesNotExistError, ioError ) import Control.Exception ( assert ) +import Data.Maybe + ( catMaybes ) -- | We would like by default to install binaries into some location that is on -- the user's PATH. For per-user installations on Unix systems that basically @@ -93,23 +95,29 @@ import Control.Exception -- symlinkBinaries :: ConfigFlags -> InstallFlags - -> InstallPlan BuildResult -> IO () + -> InstallPlan BuildResult + -> IO [(PackageIdentifier, String, FilePath)] symlinkBinaries configFlags installFlags plan = case flagToMaybe (installSymlinkBinDir installFlags) of - Nothing -> return () + Nothing -> return [] Just symlinkBinDir -> do publicBinDir <- canonicalizePath symlinkBinDir - sequence_ + fmap catMaybes $ sequence [ let publicExeName = PackageDescription.exeName exe privateExeName = prefix ++ publicExeName ++ suffix - prefix = substTemplate pkg prefixTemplate - suffix = substTemplate pkg suffixTemplate + prefix = substTemplate pkgid prefixTemplate + suffix = substTemplate pkgid suffixTemplate in do privateBinDir <- pkgBinDir pkg - symlinkBinary - publicBinDir privateBinDir - publicExeName privateExeName + ok <- symlinkBinary + publicBinDir privateBinDir + publicExeName privateExeName + if ok + then return Nothing + else return (Just (pkgid, publicExeName, + privateBinDir </> privateExeName)) | InstallPlan.Installed cpkg <- InstallPlan.toList plan - , let pkg = pkgDescription cpkg + , let pkg = pkgDescription cpkg + pkgid = packageId pkg , exe <- PackageDescription.executables pkg , PackageDescription.buildable (PackageDescription.buildInfo exe) ] where @@ -137,9 +145,9 @@ symlinkBinaries configFlags installFlags plan = templateDirs canonicalizePath (InstallDirs.bindir absoluteDirs) - substTemplate pkg = InstallDirs.fromPathTemplate - . InstallDirs.substPathTemplate env - where env = InstallDirs.initialPathTemplateEnv (packageId pkg) compilerId + substTemplate pkgid = InstallDirs.fromPathTemplate + . InstallDirs.substPathTemplate env + where env = InstallDirs.initialPathTemplateEnv pkgid compilerId fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "") prefixTemplate = fromFlagTemplate (configProgPrefix configFlags) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
