% Copyright (C) 2002-2003 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \begin{code} {-# OPTIONS_GHC -cpp -fffi -fglasgow-exts #-} #include "gadts.h" module Darcs.SelectChanges ( with_selected_changes', with_selected_changes_to_files', with_selected_last_changes_to_files', with_selected_last_changes_reversed', with_selected_changes, with_selected_changes_to_files, with_selected_changes_reversed, with_selected_last_changes_to_files, with_selected_last_changes_to_files_reversed, with_selected_last_changes_reversed, view_changes, with_selected_patch_from_repo, ) where import System.IO import Data.List ( intersperse ) import Data.Maybe ( isJust, catMaybes ) import Data.Char ( toUpper ) import Control.Monad ( when ) import System.Exit ( exitWith, ExitCode(ExitSuccess) ) import English ( Noun(..), englishNum ) import Darcs.Hopefully ( PatchInfoAnd, hopefully, n2pia ) import Darcs.Repository ( Repository, read_repo, read_pending ) import Darcs.Patch ( RepoPatch, Patchy, Prim, summary, commute, fromPrims, invert, list_touched_files, anonymous ) import qualified Darcs.Patch ( thing, things ) import Darcs.Patch.Ordered ( FL(..), RL(..), (:<)(..), (:>)(..), (+>+), lengthFL, concatRL, mapFL_FL, spanFL, reverseFL, (+<+), mapFL ) import Darcs.Patch.Choices ( PatchChoices, patch_choices, patch_choices_tps, force_first, force_last, make_uncertain, tag, is_patch_first, separate_first_middle_from_last, separate_first_from_middle_last, separate_middle_last_from_first, select_all_middles, separate_last_from_first_middle, force_matching_last, force_matching_first, make_everything_later, TaggedPatch, tp_patch, ) import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching ) import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager ) import Darcs.SlurpDirectory ( Slurpy ) import Darcs.Match ( have_nonrange_match, match_a_patch, doesnt_not_match ) import Darcs.Flags ( DarcsFlag( DryRun, All, Summary, DontGrabDeps, Verbose ) ) import Darcs.Sealed ( Sealed(..) ) import Darcs.Utils ( askUser, promptCharFancy, without_buffering ) import Printer ( prefix, putDocLn ) #include "impossible.h" \end{code} \begin{code} type WithPatches p a = String -- jobname -> [DarcsFlag] -- opts -> Slurpy -- directory -> FL p -- patches to select among -> (FL p :> FL p -> IO a) -- job -> IO a -- result of running job -- | The only difference with 'WithPatches' is the [FilePath] argument type WithPatchesToFiles p a = String -- jobname -> [DarcsFlag] -- opts -> Slurpy -- directory -> [FilePath] -- files -> FL p -- patches to select among -> (FL p :> FL p -> IO a) -- job -> IO a -- result of running job with_selected_changes' :: WithPatches Prim a with_selected_changes_to_files' :: WithPatchesToFiles Prim a with_selected_last_changes_to_files' :: WithPatchesToFiles Prim a with_selected_last_changes_reversed' :: WithPatches Prim a with_selected_changes' = wasc First with_selected_changes_to_files' = wasc_ First with_selected_last_changes_to_files' = wasc_ Last with_selected_last_changes_reversed' = wasc LastReversed with_selected_changes :: RepoPatch p => WithPatches (PatchInfoAnd p) a with_selected_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a with_selected_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a with_selected_last_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a with_selected_last_changes_to_files_reversed :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a with_selected_last_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a with_selected_changes = wasc' First with_selected_changes_to_files = wasc_' First with_selected_changes_reversed = wasc' FirstReversed with_selected_last_changes_to_files = wasc_' Last with_selected_last_changes_to_files_reversed = wasc_' LastReversed with_selected_last_changes_reversed = wasc' LastReversed data WhichChanges = Last | LastReversed | First | FirstReversed deriving (Eq, Show) -- | wasc and wasc_ are just shorthand for with_any_selected_changes wasc :: Patchy p => WhichChanges -> WithPatches p a wasc mwch j o s = wasc_ mwch j o s [] wasc_ :: Patchy p => WhichChanges -> WithPatchesToFiles p a wasc_ = with_any_selected_changes wasc' :: RepoPatch p => WhichChanges -> WithPatches (PatchInfoAnd p) a wasc' mwch j o s = wasc_' mwch j o s [] wasc_' :: RepoPatch p => WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a wasc_' = with_any_selected_changes' with_any_selected_changes :: Patchy p => WhichChanges -> WithPatchesToFiles p a with_any_selected_changes wch jn opts s fs = with_any_selected_changes_ wch (patches_to_consider (Just wch) fs) jn opts s fs with_any_selected_changes' :: RepoPatch p => WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a with_any_selected_changes' wch jn opts s fs = with_any_selected_changes_ wch (patches_to_consider' (Just wch) fs opts) jn opts s fs view_changes :: RepoPatch p => [DarcsFlag] -> Slurpy -> [FilePath] -> FL (PatchInfoAnd p) -> IO () view_changes opts _ fp ps = without_buffering $ do text_view opts ps_len 0 NilRL init_tps init_pc return () where ps_to_consider :> _ = patches_to_consider' Nothing fp opts ps (init_pc, init_tps) = patch_choices_tps ps_to_consider ps_len = lengthFL init_tps \end{code} \begin{code} data KeyPress a = KeyPress { kp :: Char , kpHelp :: String } helpFor :: String -> [[KeyPress a]] -> String helpFor jobname options = unlines $ [ "How to use "++jobname++":" ] ++ (concat $ intersperse [""] $ map (map help) options) ++ [ "" , "?: show this help" , "" , ": accept the current default (which is capitalized)" ] where help i = kp i:(": "++kpHelp i) keysFor :: [[KeyPress a]] -> [Char] keysFor = concatMap (map kp) \end{code} \begin{code} with_selected_patch_from_repo :: RepoPatch p => String -> Repository p -> [DarcsFlag] -> Bool -> ((PatchInfoAnd p,[PatchInfoAnd p]) -> IO ()) -> IO () with_selected_patch_from_repo jn repository opts ignore_pending job = do Sealed p_s <- read_repo repository pend <- if ignore_pending then return NilFL else read_pending repository sp <- without_buffering $ wspfr jn (doesnt_not_match opts) (concatRL p_s) [n2pia $ anonymous $ fromPrims pend] case sp of Just (selected, s_and_pend) -> case (last s_and_pend, init s_and_pend) of (pend',skipped) -> case commute (pend' :> selected) of Just (selected' :> _) -> job (selected', skipped) Nothing -> impossible Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected." exitWith $ ExitSuccess wspfr :: RepoPatch p => String -> (PatchInfoAnd p -> Bool) -> RL (PatchInfoAnd p) -> [PatchInfoAnd p] -> IO (Maybe (PatchInfoAnd p, [PatchInfoAnd p])) wspfr _ _ NilRL _ = return Nothing wspfr jn matches (p:<:pps) skipped | not $ matches p = wspfr jn matches pps (p:skipped) | otherwise = case commute_by (skipped :< p) of Nothing -> do putStr "\nSkipping depended-upon patch:" printFriendly [] p wspfr jn matches pps (p:skipped) Just (p' :< skipped') -> do printFriendly [] p let repeat_this = wspfr jn matches (p:<:pps) skipped options = [[ KeyPress 'y' (jn++" this patch") , KeyPress 'n' ("don't "++jn++" it") , KeyPress 'v' "view this patch in full" , KeyPress 'p' "view this patch in full with pager" , KeyPress 'x' "view a summary of this patch" , KeyPress 'q' ("cancel "++jn) ]] let prompt = "Shall I "++jn++" this patch?" yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h" case yorn of 'y' -> return $ Just (p', skipped') 'n' -> wspfr jn matches pps (p:skipped) 'v' -> printPatch p >> repeat_this 'p' -> printPatchPager p >> repeat_this 'x' -> do putDocLn $ prefix " " $ summary p repeat_this 'q' -> do putStrLn $ jn_cap++" cancelled." exitWith $ ExitSuccess _ -> do putStrLn $ helpFor jn options repeat_this where jn_cap = (toUpper $ head jn) : tail jn commute_by :: Patchy p => [p] :< p -> Maybe (p :< [p]) commute_by ([] :< a) = Just (a :< []) commute_by (p:ps :< a) = case commute (a :> p) of Nothing -> Nothing Just (p':>a') -> case commute_by (ps :< a') of Nothing -> Nothing Just (a'' :< ps') -> Just (a'' :< p':ps') \end{code} \begin{code} with_any_selected_changes_ :: Patchy p => WhichChanges -> (FL p -> FL p :> FL p) -> WithPatchesToFiles p a with_any_selected_changes_ whichch p2c jobname opts _ _ ps job = if All `elem` opts || DryRun `elem` opts then job $ case whichch of LastReversed -> invert other_ps :> invert ps_to_consider FirstReversed -> invert other_ps :> invert ps_to_consider _ -> ps_to_consider :> other_ps else do pc <- without_buffering $ tentatively_text_select "" jobname (Noun "patch") whichch opts ps_len 0 NilRL init_tps init_pc job $ selected_patches whichch rejected_ps pc where ps_to_consider :> other_ps = p2c ps rejected_ps = if whichch == Last || whichch == FirstReversed then ps_to_consider else other_ps (init_pc, init_tps) = patch_choices_tps $ case whichch of Last -> other_ps FirstReversed -> other_ps _ -> ps_to_consider ps_len = lengthFL init_tps patches_to_consider :: Patchy p => Maybe WhichChanges -> [FilePath] -- ^ files -> FL p -- ^ patches -> (FL p :> FL p) patches_to_consider mwhichch fs ps = let ps' = if mwhichch == Just LastReversed || mwhichch == Just FirstReversed then invert ps else ps f = case mwhichch of Just Last -> separate_middle_last_from_first Just FirstReversed -> separate_middle_last_from_first _ -> separate_first_middle_from_last deal_with_fs = case mwhichch of Just Last -> select_not_touching fs Just FirstReversed -> select_not_touching fs _ -> deselect_not_touching fs in if null fs then if mwhichch == Just Last || mwhichch == Just FirstReversed then NilFL :> ps' else ps' :> NilFL else tp_patches $ f $ deal_with_fs $ patch_choices ps' patches_to_consider' :: RepoPatch p => Maybe WhichChanges -> [FilePath] -- ^ files -> [DarcsFlag] -- ^ opts -> FL (PatchInfoAnd p) -- ^ patches -> FL (PatchInfoAnd p) :> FL (PatchInfoAnd p) patches_to_consider' mwhichch fs opts ps = let ps' = if mwhichch == Just LastReversed || mwhichch == Just FirstReversed then invert ps else ps f = case mwhichch of Just Last -> separate_middle_last_from_first Just FirstReversed -> separate_middle_last_from_first _ -> separate_first_middle_from_last deal_with_fs = case mwhichch of Just Last -> select_not_touching fs Just FirstReversed -> select_not_touching fs _ -> deselect_not_touching fs deselect_unwanted pc = if have_nonrange_match opts then case mwhichch of Just Last -> bug "don't support patch matching with Last in wasp" Just FirstReversed -> bug "don't support patch matching with FirstReversed in wasp" _ -> if DontGrabDeps `elem` opts then force_matching_last (not.iswanted) pc else make_everything_later $ force_matching_first iswanted pc else pc iswanted = let maybe_invert = if mwhichch == Just LastReversed || mwhichch == Just FirstReversed then invert else id in (match_a_patch opts . hopefully . maybe_invert . tp_patch) in if null fs && not (have_nonrange_match opts) then if mwhichch == Just Last || mwhichch == Just FirstReversed then NilFL :> ps' else ps' :> NilFL else tp_patches $ f $ deal_with_fs $ deselect_unwanted $ patch_choices ps' -- | Returns the results of a patch selection user interaction selected_patches :: Patchy p => WhichChanges -> FL p -- ^ patches set aside -> PatchChoices p -> (FL p :> FL p) selected_patches whichch other_ps pc = case whichch of Last -> case separate_last_from_first_middle pc of xs :> ys -> other_ps +>+ mapFL_FL tp_patch xs :> mapFL_FL tp_patch ys First -> case separate_first_from_middle_last pc of xs :> ys -> mapFL_FL tp_patch xs :> mapFL_FL tp_patch ys +>+ other_ps LastReversed -> case separate_first_from_middle_last pc of xs :> ys -> invert (mapFL_FL tp_patch ys +>+ other_ps) :> invert (mapFL_FL tp_patch xs) FirstReversed -> case separate_last_from_first_middle pc of xs :> ys -> invert (mapFL_FL tp_patch ys) :> invert (other_ps +>+ mapFL_FL tp_patch xs) text_select :: Patchy p => String -> WhichChanges -> [DarcsFlag] -> Int -> Int -> RL (TaggedPatch p) -> FL (TaggedPatch p) -> PatchChoices p -> IO (PatchChoices p) text_select _ _ _ _ _ _ NilFL pc = return pc text_select jn whichch opts n_max n tps_done tps_todo@(tp:>:tps_todo') pc = do printFriendly opts viewp repeat_this -- prompt the user where do_next_action ja je = tentatively_text_select ja jn je whichch opts n_max (n+1) (tp:<:tps_done) tps_todo' do_next = do_next_action "" (Noun "patch") helper :: PatchChoices p -> p helper = undefined thing = Darcs.Patch.thing (helper pc) things = Darcs.Patch.things (helper pc) options_basic = [ KeyPress 'y' (jn++" this "++thing) , KeyPress 'n' ("don't "++jn++" it") , KeyPress 'w' ("wait and decide later, defaulting to no") ] options_file = [ KeyPress 's' ("don't "++jn++" the rest of the changes to this file") , KeyPress 'f' (jn++" the rest of the changes to this file") ] options_view = [ KeyPress 'v' ("view this "++thing++" in full") , KeyPress 'p' ("view this "++thing++" in full with pager") ] options_summary = [ KeyPress 'x' ("view a summary of this "++thing) ] options_quit = [ KeyPress 'd' (jn++" selected "++things++", skipping all the remaining "++things) , KeyPress 'a' (jn++" all the remaining "++things) , KeyPress 'q' ("cancel "++jn) ] options_nav = [ KeyPress 'j' ("skip to next "++thing) , KeyPress 'k' ("back up to previous "++thing) ] options = [options_basic] ++ (if is_single_file_patch then [options_file] else []) ++ [options_view ++ if Summary `elem` opts then [] else options_summary] ++ [options_quit] ++ [options_nav ] prompt = "Shall I "++jn++" this "++thing++"? " ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") " repeat_this = do yorn <- promptCharFancy prompt (keysFor options) (Just the_default) "?h" case yorn of 'y' -> do_next $ force_yes (tag tp) pc 'n' -> do_next $ force_no (tag tp) pc 'w' -> do_next $ make_uncertain (tag tp) pc 's' -> do_next_action "Skipped" (Noun "change") $ skip_file 'f' -> do_next_action "Included" (Noun "change") $ do_file 'v' -> printPatch viewp >> repeat_this 'p' -> printPatchPager viewp >> repeat_this 'x' -> do putDocLn $ prefix " " $ summary viewp repeat_this 'd' -> return pc 'a' -> do ask_confirmation return $ select_all_middles (whichch == Last || whichch == FirstReversed) pc 'q' -> do putStrLn $ jn_cap++" cancelled." exitWith $ ExitSuccess 'j' -> case tps_todo' of NilFL -> -- May as well work out the length now we have all -- the patches in memory text_select jn whichch opts n_max n tps_done tps_todo pc _ -> text_select jn whichch opts n_max (n+1) (tp:<:tps_done) tps_todo' pc 'k' -> case tps_done of NilRL -> repeat_this (tp':<:tps_done') -> text_select jn whichch opts n_max (n-1) tps_done' (tp':>:tps_todo) pc 'c' -> text_select jn whichch opts n_max n tps_done tps_todo pc _ -> do putStrLn $ helpFor jn options repeat_this force_yes = if whichch == Last || whichch == FirstReversed then force_last else force_first force_no = if whichch == Last || whichch == FirstReversed then force_first else force_last patches_to_skip = (tag tp:) $ catMaybes $ mapFL (\tp' -> if list_touched_files tp' == touched_files then Just (tag tp') else Nothing) tps_todo' skip_file = foldr force_no pc patches_to_skip do_file = foldr force_yes pc patches_to_skip the_default = get_default (whichch == Last || whichch == FirstReversed) $ is_patch_first tp pc jn_cap = (toUpper $ head jn) : tail jn touched_files = list_touched_files $ tp_patch tp is_single_file_patch = length touched_files == 1 viewp = if whichch == LastReversed || whichch == FirstReversed then invert (tp_patch tp) else tp_patch tp ask_confirmation = if jn `elem` ["unpull", "unrecord", "obliterate"] then do yorn <- askUser $ "Really " ++ jn ++ " all undecided patches? " case yorn of ('y':_) -> return () _ -> exitWith $ ExitSuccess else return () text_view :: Patchy p => [DarcsFlag] -> Int -> Int -> RL (TaggedPatch p) -> FL (TaggedPatch p) -> PatchChoices p -> IO (PatchChoices p) text_view _ _ _ _ NilFL _ = return $ patch_choices NilFL --return pc text_view opts n_max n tps_done tps_todo@(tp:>:tps_todo') pc = do printFriendly opts (tp_patch tp) putStr "\n" repeat_this -- prompt the user where prev_patch = case tps_done of NilRL -> repeat_this (tp':<:tps_done') -> text_view opts n_max (n-1) tps_done' (tp':>:tps_todo) pc next_patch = case tps_todo' of NilFL -> -- May as well work out the length now we have all -- the patches in memory text_view opts n_max n tps_done tps_todo' pc _ -> text_view opts n_max (n+1) (tp:<:tps_done) tps_todo' pc options_yn = [ KeyPress 'y' "view this patch and go to the next" , KeyPress 'n' "skip to the next patch" ] options_view = [ KeyPress 'v' "view this patch in full" , KeyPress 'p' "view this patch in fill with pager" ] options_summary = [ KeyPress 'x' "view a summary of this patch" ] options_nav = [ KeyPress 'q' ("quit view changes") , KeyPress 'k' "back up to previous patch" , KeyPress 'j' "skip to next patch" ] options = [ options_yn ] ++ [ options_view ++ if Summary `elem` opts then [] else options_summary ] ++ [ options_nav ] prompt = "Shall I view this patch? " ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ")" repeat_this = do yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h" case yorn of 'y' -> printPatch (tp_patch tp) >> next_patch 'n' -> next_patch 'v' -> printPatch (tp_patch tp) >> repeat_this 'p' -> printPatchPager (tp_patch tp) >> repeat_this 'x' -> do putDocLn $ prefix " " $ summary (tp_patch tp) repeat_this 'q' -> exitWith ExitSuccess 'k' -> prev_patch 'j' -> next_patch 'c' -> text_view opts n_max n tps_done tps_todo pc _ -> do putStrLn $ helpFor "view changes" options repeat_this tentatively_text_select :: Patchy p => String -> String -> Noun -> WhichChanges -> [DarcsFlag] -> Int -> Int -> RL (TaggedPatch p) -> FL (TaggedPatch p) -> PatchChoices p -> IO (PatchChoices p) tentatively_text_select _ _ _ _ _ _ _ _ NilFL pc = return pc tentatively_text_select jobaction jobname jobelement whichch opts n_max n ps_done ps_todo pc = do when (numSkipped > 0) show_skipped text_select jobname whichch opts n_max (n + numSkipped) (reverseFL skipped +<+ ps_done) unskipped pc where skipped :> unskipped = spanFL (\p -> isJust $ is_patch_first p pc) ps_todo numSkipped = lengthFL skipped show_skipped = do putStrLn $ _doing_ ++ _with_ ++ "." when (Verbose `elem` opts) $ showskippedpatch skipped where _doing_ = _action_ ++ " " ++ jobname _with_ = " of " ++ show numSkipped ++ " " ++ _elem_ "" _action_ = if (length jobaction) == 0 then "Skipped" else jobaction _elem_ = englishNum numSkipped jobelement showskippedpatch (tp:>:tps) = (putDocLn $ prefix " " $ summary (tp_patch tp)) >> showskippedpatch tps showskippedpatch NilFL = return () get_default :: Bool -> Maybe Bool -> Char get_default _ Nothing = 'w' get_default True (Just True) = 'n' get_default True (Just False) = 'y' get_default False (Just True) = 'y' get_default False (Just False) = 'n' \end{code} \begin{code} tp_patches :: (FL (TaggedPatch p) :> FL (TaggedPatch p)) C(x y) -> (FL p :> FL p) C(x y) tp_patches (x:>y) = mapFL_FL tp_patch x :> mapFL_FL tp_patch y \end{code}