-- 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. {-# OPTIONS_GHC -fglasgow-exts #-} {-# LANGUAGE CPP, ForeignFunctionInterface #-} -- , ScopedTypeVariables, TypeOperators, PatternGuards #-} #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, filterOutConflicts, ) where import System.IO import Data.List ( intersperse ) import Data.Maybe ( catMaybes, isJust ) import Data.Char ( toUpper ) import Control.Monad ( when ) import System.Exit ( exitWith, ExitCode(ExitSuccess) ) import English ( Noun(..), englishNum ) import Darcs.Arguments ( showFriendly ) import Darcs.Hopefully ( PatchInfoAnd, hopefully, n2pia ) import Darcs.Repository ( Repository, read_repo, unrecordedChanges ) import Darcs.Patch ( RepoPatch, Patchy, Prim, summary, invert, listTouchedFiles, commuteFL, fromPrims, anonymous ) import qualified Darcs.Patch ( thing, things ) import Darcs.Patch.Split ( Splitter(..) ) import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (:||:)(..), (+>+), lengthFL, lengthRL, concatRL, mapFL_FL, spanFL, reverseFL, (+<+), mapFL, unsafeCoerceP ) import Darcs.Patch.Choices ( PatchChoices, patchChoices, patchChoicesTps, patchChoicesTpsSub, forceFirst, forceLast, makeUncertain, tag, getChoices, separateFirstMiddleFromLast, separateFirstFromMiddleLast, patchSlot, selectAllMiddles, forceMatchingLast, forceMatchingFirst, makeEverythingLater, TaggedPatch, tpPatch, Slot(..), substitute, ) import Darcs.Patch.Permutations ( partitionConflictingFL, selfCommuter, commuterIdRL ) import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching ) import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager ) import Darcs.Match ( haveNonrangeMatch, matchAPatch, matchAPatchread ) import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies, SkipConflicts), isInteractive ) import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2, Sealed(..) ) import Darcs.Utils ( askUser, promptCharFancy ) import Darcs.Lock ( editText ) import Printer ( prefix, putDocLn ) #include "impossible.h" data WhichChanges = Last | LastReversed | First | FirstReversed deriving (Eq, Show) type MatchCriterion p = FORALL(u v) WhichChanges -> [DarcsFlag] -> (p C(u v)) -> Bool type WithPatches p a C(x y) = String -- jobname -> [DarcsFlag] -- opts -> Maybe (Splitter p) -- for interactive editing -> FL p C(x y) -- patches to select among -> ((FL p :> FL p) C(x y) -> IO a) -- job -> IO a -- result of running job -- | The only difference with 'WithPatches' is the [FilePath] argument type WithPatchesToFiles p a C(x y) = String -- jobname -> [DarcsFlag] -- opts -> Maybe (Splitter p) -- for interactive editing -> [FilePath] -- files -> FL p C(x y) -- patches to select among -> ((FL p :> FL p) C(x y) -> IO a) -- job -> IO a -- result of running job with_selected_changes' :: WithPatches Prim a C(x y) with_selected_changes_to_files' :: WithPatchesToFiles Prim a C(x y) with_selected_last_changes_to_files' :: WithPatchesToFiles Prim a C(x y) with_selected_last_changes_reversed' :: WithPatches Prim a C(x y) -- Common match criteria triv :: MatchCriterion p triv _ _ _ = True iswanted :: Patchy p => MatchCriterion (PatchInfoAnd p) iswanted First opts p = matchAPatch opts . hopefully $ p iswanted LastReversed opts p = matchAPatch opts . hopefully . invert $ p iswanted Last _ _ = bug "don't support patch matching with Last in wasp" iswanted FirstReversed _ _ = bug "don't support patch matching with FirstReversed in wasp" with_selected_changes' = wasc First triv with_selected_changes_to_files' = wasc_ First triv with_selected_last_changes_to_files' = wasc_ Last triv with_selected_last_changes_reversed' = wasc LastReversed triv with_selected_changes :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) with_selected_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) with_selected_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) with_selected_last_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) with_selected_last_changes_to_files_reversed :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) with_selected_last_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) with_selected_changes = wasc First iswanted with_selected_changes_to_files = wasc_ First iswanted with_selected_changes_reversed = wasc FirstReversed iswanted with_selected_last_changes_to_files = wasc_ Last iswanted with_selected_last_changes_to_files_reversed = wasc_ LastReversed iswanted with_selected_last_changes_reversed = wasc LastReversed iswanted -- | wasc and wasc_ are just shorthand for with_any_selected_changes wasc :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatches p a C(x y) wasc mwch crit j o spl = wasc_ mwch crit j o spl [] wasc_ :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y) wasc_ = with_any_selected_changes with_any_selected_changes :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y) with_any_selected_changes Last crit jn opts splitter fs = with_any_selected_changes_last (patches_to_consider_last' fs opts crit) crit jn opts splitter fs with_any_selected_changes First crit jn opts splitter fs = with_any_selected_changes_first (patches_to_consider_first' fs opts crit) crit jn opts splitter fs with_any_selected_changes FirstReversed crit jn opts splitter fs = with_any_selected_changes_first_reversed (patches_to_consider_first_reversed' fs opts crit) crit jn opts splitter fs with_any_selected_changes LastReversed crit jn opts splitter fs = with_any_selected_changes_last_reversed (patches_to_consider_last_reversed' fs opts crit) crit jn opts splitter fs view_changes :: RepoPatch p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO () view_changes opts ps = do text_view opts Nothing 0 NilRL init_tps init_pc return () where (init_pc, init_tps) = patchChoicesTps ps 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) with_selected_patch_from_repo :: forall p C(r u t). RepoPatch p => String -> Repository p C(r u t) -> [DarcsFlag] -> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO () with_selected_patch_from_repo jn repository opts job = do p_s <- read_repo repository sp <- wspfr jn (matchAPatchread opts) (concatRL p_s) NilFL case sp of Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected) Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected." -- | This ensures that the selected patch commutes freely with the skipped patches, including pending -- and also that the skipped sequences has an ending context that matches the recorded state, z, -- of the repository. wspfr :: RepoPatch p => String -> (FORALL(a b) (PatchInfoAnd p) C(a b) -> Bool) -> RL (PatchInfoAnd p) C(x y) -> FL (PatchInfoAnd p) C(y u) -> IO (Maybe (FlippedSeal (FL (PatchInfoAnd p) :> (PatchInfoAnd p)) C(u))) wspfr _ _ NilRL _ = return Nothing wspfr jn matches (p:<:pps) skipped | not $ matches p = wspfr jn matches pps (p:>:skipped) | otherwise = case commuteFL (p :> skipped) of Left _ -> do putStrLn "\nSkipping depended-upon patch:" printFriendly [] p wspfr jn matches pps (p:>:skipped) Right (skipped' :> p') -> 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 $ flipSeal $ skipped' :> p' '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 -- After selecting with a splitter, the results may not be canonical canonizeWith :: Maybe (Splitter p) -> (FL p :> FL p) C(x y) -> (FL p :> FL p) C(x y) canonizeWith Nothing xy = xy canonizeWith (Just spl) (x :> y) = canonizeSplit spl x :> canonizeSplit spl y with_any_selected_changes_last :: forall p a C(x y). Patchy p => (FL p C(x y) -> (FL p :> FL p) C(x y)) -> MatchCriterion p -> WithPatchesToFiles p a C(x y) with_any_selected_changes_last p2c crit jobname opts splitter _ ps job = case p2c ps of ps_to_consider :> other_ps -> if not $ isInteractive opts then job $ ps_to_consider :> other_ps else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") Last crit opts ps_len 0 NilRL init_tps init_pc job $ canonizeWith splitter $ selected_patches_last rejected_ps pc where rejected_ps = ps_to_consider ps_len = lengthFL init_tps (init_pc, init_tps) = patchChoicesTps $ other_ps with_any_selected_changes_first :: forall p a C(x y). Patchy p => (FL p C(x y) -> (FL p :> FL p) C(x y)) -> MatchCriterion p -> WithPatchesToFiles p a C(x y) with_any_selected_changes_first p2c crit jobname opts splitter _ ps job = case p2c ps of ps_to_consider :> other_ps -> if not $ isInteractive opts then job $ ps_to_consider :> other_ps else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") First crit opts ps_len 0 NilRL init_tps init_pc job $ canonizeWith splitter $ selected_patches_first rejected_ps pc where rejected_ps = other_ps ps_len = lengthFL init_tps (init_pc, init_tps) = patchChoicesTps $ ps_to_consider with_any_selected_changes_first_reversed :: forall p a C(x y). Patchy p => (FL p C(x y) -> (FL p :> FL p) C(y x)) -> MatchCriterion p -> WithPatchesToFiles p a C(x y) with_any_selected_changes_first_reversed p2c crit jobname opts splitter _ ps job = case p2c ps of ps_to_consider :> other_ps -> if not $ isInteractive opts then job $ invert other_ps :> invert ps_to_consider else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") FirstReversed crit opts ps_len 0 NilRL init_tps init_pc job $ canonizeWith splitter $ selected_patches_first_reversed rejected_ps pc where rejected_ps = ps_to_consider ps_len = lengthFL init_tps (init_pc, init_tps) = patchChoicesTps other_ps with_any_selected_changes_last_reversed :: forall p a C(x y). Patchy p => (FL p C(x y) -> (FL p :> FL p) C(y x)) -> MatchCriterion p -> WithPatchesToFiles p a C(x y) with_any_selected_changes_last_reversed p2c crit jobname opts splitter _ ps job = case p2c ps of ps_to_consider :> other_ps -> if not $ isInteractive opts then job $ invert other_ps :> invert ps_to_consider else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") LastReversed crit opts ps_len 0 NilRL init_tps init_pc job $ canonizeWith splitter $ selected_patches_last_reversed rejected_ps pc where rejected_ps = other_ps ps_len = lengthFL init_tps (init_pc, init_tps) = patchChoicesTps ps_to_consider patches_to_consider_first' :: Patchy p => [FilePath] -- ^ files -> [DarcsFlag] -- ^ opts -> MatchCriterion p -> FL p C(x y) -- ^ patches -> (FL p :> FL p) C(x y) patches_to_consider_first' fs opts crit ps = let deselect_unwanted pc = if haveNonrangeMatch opts then if DontGrabDeps `elem` opts then forceMatchingLast (not.iswanted_) pc else makeEverythingLater $ forceMatchingFirst iswanted_ pc else pc iswanted_ = crit First opts . tpPatch in if null fs && not (haveNonrangeMatch opts) then ps :> NilFL else tp_patches $ separateFirstMiddleFromLast $ deselect_not_touching fs $ deselect_unwanted $ patchChoices ps patches_to_consider_last' :: Patchy p => [FilePath] -- ^ files -> [DarcsFlag] -- ^ opts -> MatchCriterion p -> FL p C(x y) -- ^ patches -> (FL p :> FL p) C(x y) patches_to_consider_last' fs opts crit ps = let deselect_unwanted pc = if haveNonrangeMatch opts then if DontGrabDeps `elem` opts then forceMatchingLast (not.iswanted_) pc else makeEverythingLater $ forceMatchingFirst iswanted_ pc else pc iswanted_ = crit Last opts . tpPatch in if null fs && not (haveNonrangeMatch opts) then NilFL :> ps else case getChoices $ select_not_touching fs $ deselect_unwanted $ patchChoices ps of fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc patches_to_consider_first_reversed' :: Patchy p => [FilePath] -- ^ files -> [DarcsFlag] -- ^ opts -> MatchCriterion p -> FL p C(x y) -- ^ patches -> (FL p :> FL p) C(y x) patches_to_consider_first_reversed' fs opts crit ps = let deselect_unwanted pc = if haveNonrangeMatch opts then if DontGrabDeps `elem` opts then forceMatchingLast (not.iswanted_) pc else makeEverythingLater $ forceMatchingFirst iswanted_ pc else pc iswanted_ = crit FirstReversed opts . tpPatch in if null fs && not (haveNonrangeMatch opts) then NilFL :> (invert ps) else case getChoices $ select_not_touching fs $ deselect_unwanted $ patchChoices $ invert ps of fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc patches_to_consider_last_reversed' :: Patchy p => [FilePath] -- ^ files -> [DarcsFlag] -- ^ opts -> MatchCriterion p -> FL p C(x y) -- ^ patches -> (FL p :> FL p) C(y x) patches_to_consider_last_reversed' fs opts crit ps = let deselect_unwanted pc = if haveNonrangeMatch opts then if DontGrabDeps `elem` opts then forceMatchingLast (not.iswanted_) pc else makeEverythingLater $ forceMatchingFirst iswanted_ pc else pc iswanted_ = crit LastReversed opts . tpPatch in if null fs && not (haveNonrangeMatch opts) then (invert ps) :> NilFL else tp_patches $ separateFirstMiddleFromLast $ deselect_not_touching fs $ deselect_unwanted $ patchChoices $ invert ps -- | Returns the results of a patch selection user interaction selected_patches_last :: Patchy p => FL p C(x y) -> PatchChoices p C(y z) -> (FL p :> FL p) C(x z) selected_patches_last other_ps pc = case getChoices pc of fc :> mc :> lc -> other_ps +>+ mapFL_FL tpPatch (fc +>+ mc) :> mapFL_FL tpPatch lc selected_patches_first :: Patchy p => FL p C(y z) -> PatchChoices p C(x y) -> (FL p :> FL p) C(x z) selected_patches_first other_ps pc = case separateFirstFromMiddleLast pc of xs :> ys -> mapFL_FL tpPatch xs :> mapFL_FL tpPatch ys +>+ other_ps selected_patches_last_reversed :: Patchy p => FL p C(y x) -> PatchChoices p C(z y) -> (FL p :> FL p) C(x z) selected_patches_last_reversed other_ps pc = case separateFirstFromMiddleLast pc of xs :> ys -> invert (mapFL_FL tpPatch ys +>+ other_ps) :> invert (mapFL_FL tpPatch xs) selected_patches_first_reversed :: Patchy p => FL p C(z y) -> PatchChoices p C(y x) -> (FL p :> FL p) C(x z) selected_patches_first_reversed other_ps pc = case getChoices pc of fc :> mc :> lc -> invert (mapFL_FL tpPatch lc) :> invert (other_ps +>+ mapFL_FL tpPatch (fc +>+ mc)) text_select :: forall p C(x y z). Patchy p => Maybe (Splitter p) -> String -> WhichChanges -> MatchCriterion p -> [DarcsFlag] -> Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z) -> PatchChoices p C(x z) -> IO ((PatchChoices p) C(x z)) text_select _ _ _ _ _ _ _ _ NilFL pc = return pc text_select splitter jn whichch crit opts n_max n tps_done tps_todo@(tp:>:tps_todo') pc = do (printFriendly opts) `unseal2` viewp repeat_this -- prompt the user where do_next_action ja je = tentatively_text_select splitter ja jn je whichch crit opts n_max (n+1) (tp:<:tps_done) tps_todo' do_next = do_next_action "" (Noun "patch") helper :: PatchChoices p C(a b) -> p C(a b) helper = undefined thing = Darcs.Patch.thing (helper pc) things = Darcs.Patch.things (helper pc) split = splitter >>= flip applySplitter (tpPatch tp) 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") , KeyPress 'l' ("list all selected "++things) ] 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_split | Just _ <- split = [ KeyPress 'e' ("interactively edit this "++thing) ] | otherwise = [] options = [options_basic] ++ [options_split] ++ (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 :: IO ((PatchChoices p) C(x z)) 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 $ makeUncertain (tag tp) pc 'e' | Just (text, parse) <- split -> do newText <- editText "darcs-patch-edit" text case parse newText of Nothing -> repeat_this Just ps -> do let tps_new = snd $ patchChoicesTpsSub (Just (tag tp)) ps text_select splitter jn whichch crit opts (n_max + lengthFL tps_new - 1) n tps_done (tps_new+>+tps_todo') (substitute (seal2 (tp :||: tps_new)) pc) 's' -> do_next_action "Skipped" (Noun "change") $ skip_file 'f' -> do_next_action "Included" (Noun "change") $ do_file 'v' -> printPatch `unseal2` viewp >> repeat_this 'p' -> printPatchPager `unseal2` viewp >> repeat_this 'l' -> do let selected = case getChoices pc of (first_chs:>_:>last_chs) -> if whichch == Last || whichch == FirstReversed then map_patches last_chs else map_patches first_chs map_patches = mapFL (\a -> (showFriendly opts) `unseal2` (seal2 $ tpPatch a)) putStrLn $ "---- Already selected "++things++" ----" mapM_ putDocLn $ selected putStrLn $ "---- end of already selected "++things++" ----" (printFriendly opts) `unseal2` viewp repeat_this 'x' -> do (putDocLn . prefix " " . summary) `unseal2` viewp repeat_this 'd' -> return pc 'a' -> do ask_confirmation return $ selectAllMiddles (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 splitter jn whichch crit opts n_max n tps_done tps_todo pc _ -> text_select splitter jn whichch crit opts n_max (n+1) (tp:<:tps_done) tps_todo' pc 'k' -> case tps_done of NilRL -> repeat_this (tp':<:tps_done') -> text_select splitter jn whichch crit opts n_max (n-1) tps_done' (tp':>:tps_todo) pc 'c' -> text_select splitter jn whichch crit opts n_max n tps_done tps_todo pc _ -> do putStrLn $ helpFor jn options repeat_this force_yes = if whichch == Last || whichch == FirstReversed then forceLast else forceFirst force_no = if whichch == Last || whichch == FirstReversed then forceFirst else forceLast patches_to_skip = (tag tp:) $ catMaybes $ mapFL (\tp' -> if listTouchedFiles 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) $ patchSlot tp pc jn_cap = (toUpper $ head jn) : tail jn touched_files = listTouchedFiles $ tpPatch tp is_single_file_patch = length touched_files == 1 viewp = if whichch == LastReversed || whichch == FirstReversed then seal2 $ invert (tpPatch tp) else seal2 $ tpPatch 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 :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Maybe Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y u) -> PatchChoices p C(r s) -> IO ((PatchChoices p) C(r s)) text_view _ _ _ _ NilFL _ = return $ patchChoices $ unsafeCoerceP NilFL --return pc text_view opts n_max n tps_done tps_todo@(tp:>:tps_todo') pc = do printFriendly opts (tpPatch tp) putStr "\n" repeat_this -- prompt the user where prev_patch :: IO ((PatchChoices p) C(r s)) 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 :: IO ((PatchChoices p) C(r s)) 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 NilFL 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 full 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" , KeyPress 'c' "count total patch number" ] options = [ options_yn ] ++ [ options_view ++ if Summary `elem` opts then [] else options_summary ] ++ [ options_nav ] prompt = "Shall I view this patch? " ++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")" repeat_this :: IO ((PatchChoices p) C(r s)) repeat_this = do yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h" case yorn of 'y' -> printPatch (tpPatch tp) >> next_patch 'n' -> next_patch 'v' -> printPatch (tpPatch tp) >> repeat_this 'p' -> printPatchPager (tpPatch tp) >> repeat_this 'x' -> do putDocLn $ prefix " " $ summary (tpPatch tp) repeat_this 'q' -> exitWith ExitSuccess 'k' -> prev_patch 'j' -> next_patch 'c' -> text_view opts count_n_max n tps_done tps_todo pc _ -> do putStrLn $ helpFor "view changes" options repeat_this count_n_max | isJust n_max = n_max | otherwise = Just $ lengthFL tps_todo + lengthRL tps_done tentatively_text_select :: Patchy p => Maybe (Splitter p) -> String -> String -> Noun -> WhichChanges -> MatchCriterion p -> [DarcsFlag] -> Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z) -> PatchChoices p C(x z) -> IO ((PatchChoices p) C(x z)) tentatively_text_select _ _ _ _ _ _ _ _ _ _ NilFL pc = return pc tentatively_text_select splitter jobaction jobname jobelement whichch crit opts n_max n ps_done ps_todo pc = case spanFL (\p -> decided $ patchSlot p pc) ps_todo of skipped :> unskipped -> do when (numSkipped > 0) show_skipped let (boringThenInteresting) = if DontPromptForDependencies `elem` opts then spanFL (not.(crit whichch opts).tpPatch) unskipped else NilFL :> unskipped case boringThenInteresting of boring :> interesting -> do let numNotConsidered = lengthFL boring + numSkipped text_select splitter jobname whichch crit opts n_max (n + numNotConsidered) (reverseFL boring +<+ reverseFL skipped +<+ ps_done) interesting pc where 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 :: Patchy p => FL (TaggedPatch p) C(y t) -> IO () showskippedpatch (tp:>:tps) = (putDocLn $ prefix " " $ summary (tpPatch tp)) >> showskippedpatch tps showskippedpatch NilFL = return () decided :: Slot -> Bool decided InMiddle = False decided _ = True get_default :: Bool -> Slot -> Char get_default _ InMiddle = 'w' get_default True InFirst = 'n' get_default True InLast = 'y' get_default False InFirst = 'y' get_default False InLast = 'n' tp_patches :: (FL (TaggedPatch p) :> FL (TaggedPatch p)) C(x y) -> (FL p :> FL p) C(x y) tp_patches (x:>y) = mapFL_FL tpPatch x :> mapFL_FL tpPatch y -- |Optionally remove any patches (+dependencies) from a sequence that -- conflict with the recorded or unrecorded changes in a repo filterOutConflicts :: RepoPatch p => [DarcsFlag] -- ^Command-line options. Only 'SkipConflicts' is -- significant; filtering will happen iff it is present -> RL (PatchInfoAnd p) C(x r) -- ^Recorded patches from repository, starting from -- same context as the patches to filter -> Repository p C(r u t) -- ^Repository itself, used for grabbing unrecorded changes -> FL (PatchInfoAnd p) C(x z) -- ^Patches to filter -> IO (Bool, Sealed (FL (PatchInfoAnd p) C(x))) -- ^(True iff any patches were removed, possibly filtered patches) filterOutConflicts opts us repository them | SkipConflicts `elem` opts = do let commuter = commuterIdRL selfCommuter unrec <- fmap n2pia . (anonymous . fromPrims) =<< unrecordedChanges [] repository [] them' :> rest <- return $ partitionConflictingFL commuter them (unrec :<: us) return (check rest, Sealed them') | otherwise = return (False, Sealed them) where check :: FL p C(a b) -> Bool check NilFL = False check _ = True