diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index e5c72b87b34..c6cea3eeb76 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -157,7 +157,7 @@ newInstallOptions _ = "How to handle already existing symlinks." ninstOverwritePolicy (\v flags -> flags { ninstOverwritePolicy = v }) $ reqArg - "always|never" + "always|never|prompt" readOverwritePolicyFlag showOverwritePolicyFlag ] @@ -165,10 +165,13 @@ newInstallOptions _ = readOverwritePolicyFlag = ReadE $ \case "always" -> Right $ Flag AlwaysOverwrite "never" -> Right $ Flag NeverOverwrite - policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy" - showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"] - showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"] - showOverwritePolicyFlag NoFlag = [] + "prompt" -> Right $ Flag PromptOverwrite + _policy -> Left $ "Policy must be one of: always, never or prompt." + showOverwritePolicyFlag (Flag f) = pure $ case f of + AlwaysOverwrite -> "always" + NeverOverwrite -> "never" + PromptOverwrite -> "prompt" + showOverwritePolicyFlag NoFlag = [] installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags , HaddockFlags, TestFlags, NewInstallFlags @@ -700,7 +703,7 @@ symlinkBuiltPackage verbosity overwritePolicy <> "Use --overwrite-policy=always to overwrite." -- This shouldn't even be possible, but we keep it in case -- symlinking logic changes - AlwaysOverwrite -> "Symlinking '" <> prettyShow exe <> "' failed." + _ -> "Symlinking '" <> prettyShow exe <> "' failed." unless success $ die' verbosity errorMessage -- | Symlink a specific exe. diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs index 88d656f06e0..c3de56954a1 100644 --- a/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/Distribution/Client/InstallSymlink.hs @@ -28,7 +28,7 @@ import Distribution.Simple.Setup (ConfigFlags) import Distribution.Simple.Compiler import Distribution.System -data OverwritePolicy = NeverOverwrite | AlwaysOverwrite +data OverwritePolicy = NeverOverwrite | AlwaysOverwrite | PromptOverwrite deriving (Show, Eq) symlinkBinaries :: Platform -> Compiler @@ -92,9 +92,11 @@ import Distribution.Compat.Exception ( catchIO ) import Control.Exception ( assert ) import Data.Maybe - ( catMaybes ) + ( catMaybes, listToMaybe ) +import Control.Monad (when) +import Data.Char (toLower) -data OverwritePolicy = NeverOverwrite | AlwaysOverwrite +data OverwritePolicy = NeverOverwrite | AlwaysOverwrite | PromptOverwrite deriving (Show, Eq) -- | We would like by default to install binaries into some location that is on @@ -222,14 +224,28 @@ symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName OkToOverwrite -> rmLink >> mkLink >> return True NotOurFile -> case overwritePolicy of - NeverOverwrite -> return False - AlwaysOverwrite -> rmLink >> mkLink >> return True + NeverOverwrite -> return False + AlwaysOverwrite -> True <$ overwrite + PromptOverwrite -> maybeOverwrite where publicName' = display publicName relativeBindir = makeRelative publicBindir privateBindir mkLink = createSymbolicLink (relativeBindir privateName) (publicBindir publicName') rmLink = removeLink (publicBindir publicName') + overwrite = rmLink >> mkLink + maybeOverwrite :: IO Bool + maybeOverwrite = do + a <- prompt "Existing file found. Do you want to unlink that file? (y/n)" + a <$ when a overwrite + +prompt :: String -> IO Bool +prompt p = do + putStrLn p + l <- getLine + pure $ case listToMaybe l of + Nothing -> False + Just c -> toLower c == 'y' -- | Check a file path of a symlink that we would like to create to see if it -- is OK. For it to be OK to overwrite it must either not already exist yet or diff --git a/cabal-install/changelog b/cabal-install/changelog index 9d7b6f36e14..c184c315d67 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -20,6 +20,8 @@ 2.4.1.0 Mikhail Glushenkov November 2018 * Add message to alert user to potential package casing errors. (#5635) * new-clean no longer deletes dist-newstyle/src with `-s`. (#5699) +2.4.0.1 (current bugfix version) + * Add "prompt" strategy when symlinking binaries. * 'new-install' now warns when failing to symlink an exe (#5602) * Extend 'cabal init' support for 'cabal-version' selection (#5567) * 'new-sdist' now generates tarballs with file modification @@ -30,6 +32,7 @@ public lib. (#5379,#5604) * Fixed a Windows bug where cabal-install tried to copy files after moving them (#5631). + after moving them (#5631). * 'cabal v2-repl' now works for indefinite (in the Backpack sense) components. (#5619) * Set data dir environment variable for tarballs and remote repos (#5469) * Fix monolithic inplace build tool PATH (#5633)