diff --git a/src/Darcs/UI/PatchHeader.hs b/src/Darcs/UI/PatchHeader.hs index f2bd62a..75a200f 100644 --- a/src/Darcs/UI/PatchHeader.hs +++ b/src/Darcs/UI/PatchHeader.hs @@ -41,6 +41,7 @@ import Darcs.UI.External ( editFile ) import Darcs.UI.Flags ( getEasyAuthor, promptAuthor, getDate ) import Darcs.UI.Options ( Config, (?) ) import qualified Darcs.UI.Options.All as O +import Darcs.UI.Prompt ( promptYornorq ) import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) ) import Darcs.UI.SelectChanges ( askAboutDepends ) @@ -48,7 +49,7 @@ import qualified Darcs.Util.Diff as D ( DiffAlgorithm ) import Darcs.Util.English ( capitalize ) import Darcs.Util.Global ( darcsLastMessage ) import Darcs.Util.Path ( FilePathLike, toFilePath ) -import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar, promptYorn ) +import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar ) import Darcs.Util.Printer ( Doc, text, ($+$), vcat, prefixLines, renderString ) import qualified Darcs.Util.Ratified as Ratified ( hGetContents ) @@ -184,11 +185,12 @@ getLog m_name has_pipe log_file ask_long m_old chs = is_badname = isJust . just_a_badname - prompt_long_comment oldname = - do let verb = case m_old of Nothing -> "add a"; Just _ -> "edit the" - y <- promptYorn $ "Do you want to "++verb++" long comment?" - if y then get_log_using_editor oldname - else return (oldname, default_log, Nothing) + prompt_long_comment oldname = do + let verb = case m_old of { Nothing -> "add a"; Just _ -> "edit the" } + edit = get_log_using_editor oldname + no_edit = return (oldname, default_log, Nothing) + prompt = "Do you want to " ++ verb ++ " long comment?" + promptYornorq prompt (verb ++ " long comment") edit no_edit get_log_using_editor p = do let logf = darcsLastMessage diff --git a/src/Darcs/UI/Prompt.hs b/src/Darcs/UI/Prompt.hs index b1370b0..ec7002f 100644 --- a/src/Darcs/UI/Prompt.hs +++ b/src/Darcs/UI/Prompt.hs @@ -3,10 +3,12 @@ module Darcs.UI.Prompt ( PromptChoice(..) , PromptConfig(..) , runPrompt + , promptYornorq ) where import Darcs.Prelude import Data.List ( find, intercalate ) +import System.Exit ( exitSuccess ) import qualified Darcs.Util.Prompt as P data PromptChoice a = PromptChoice @@ -24,18 +26,23 @@ data PromptConfig a = PromptConfig } -- | Generate the help string from a verb and list of choice groups -helpFor :: String -> [[PromptChoice a]] -> String -helpFor jn choices = +helpFor :: String -> [[PromptChoice a]] -> Maybe Char -> String +helpFor jn choices def = unlines $ [ "How to use " ++ jn ++ ":" ] ++ intercalate [""] (map (map help . filter pcWhen) choices) ++ [ "" , "?: show this help" - , "" - , ": accept the current default (which is capitalized)" - ] + ] ++ defaultHelp where help i = pcKey i : (": " ++ pcHelp i) + defaultHelp = + case def of + Nothing -> [] + Just _ -> + [ "" + , ": accept the current default (which is capitalized)" + ] lookupAction :: Char -> [PromptChoice a] -> Maybe (IO a) lookupAction key choices = pcAction <$> find ((==key).pcKey) choices @@ -48,4 +55,17 @@ runPrompt pcfg@PromptConfig{..} = do P.PromptConfig pPrompt (map pcKey choices) [] Nothing "?h" case lookupAction key choices of Just action -> action - Nothing -> putStrLn (helpFor pVerb pChoices) >> runPrompt pcfg + Nothing -> putStrLn (helpFor pVerb pChoices pDefault) >> runPrompt pcfg + +-- | Prompt the user for a yes or no or cancel +promptYornorq :: String -> String -> IO a -> IO a -> IO a +promptYornorq prompt verb yes no = + runPrompt (PromptConfig prompt verb choices Nothing) + where + quit = putStrLn "Command cancelled." >> exitSuccess + choices = + [ [ PromptChoice 'y' True yes ("yes, do " ++ verb) + , PromptChoice 'n' True no ("no, don't " ++ verb) + , PromptChoice 'q' True quit "quit (cancel command)" + ] + ] diff --git a/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh b/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh new file mode 100644 index 0000000..4c41cac --- /dev/null +++ b/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash + +. lib +. sshlib + +init_remote_repo R + +rm -rf R +darcs clone --remote-darcs=xyzabc "${REMOTE}:${REMOTE_DIR}/R" --debug 2>LOG +grep '"ssh" .* "xyzabc"' LOG +not grep '"ssh" .* "darcs"' LOG