1 -- Copyright (C) 2002-2003 David Roundy 2 -- 3 -- This program is free software; you can redistribute it and/or modify 4 -- it under the terms of the GNU General Public License as published by 5 -- the Free Software Foundation; either version 2, or (at your option) 6 -- any later version. 7 -- 8 -- This program is distributed in the hope that it will be useful, 9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of 10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 -- GNU General Public License for more details. 12 -- 13 -- You should have received a copy of the GNU General Public License 14 -- along with this program; see the file COPYING. If not, write to 15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16 -- Boston, MA 02110-1301, USA. 17 18 {-# OPTIONS_GHC -fglasgow-exts #-} 19 {-# LANGUAGE CPP, ForeignFunctionInterface #-} 20 -- , ScopedTypeVariables, TypeOperators, PatternGuards #-} 21 22 #include "gadts.h" 23 24 module Darcs.SelectChanges ( with_selected_changes', 25 with_selected_changes_to_files', 26 with_selected_last_changes_to_files', 27 with_selected_last_changes_reversed', 28 with_selected_changes, 29 with_selected_changes_to_files, 30 with_selected_changes_reversed, 31 with_selected_last_changes_to_files, 32 with_selected_last_changes_to_files_reversed, 33 with_selected_last_changes_reversed, 34 view_changes, 35 with_selected_patch_from_repo, 36 ) where 37 import System.IO 38 import Data.List ( intersperse ) 39 import Data.Maybe ( catMaybes, isJust ) 40 import Data.Char ( toUpper ) 41 import Control.Monad ( when ) 42 import System.Exit ( exitWith, ExitCode(ExitSuccess) ) 43 44 import English ( Noun(..), englishNum ) 45 import Darcs.Arguments ( showFriendly ) 46 import Darcs.Hopefully ( PatchInfoAnd, hopefully ) 47 import Darcs.Repository ( Repository, read_repo ) 48 import Darcs.Patch ( RepoPatch, Patchy, Prim, summary, 49 invert, list_touched_files, 50 commuteFL ) 51 import qualified Darcs.Patch ( thing, things ) 52 import Darcs.Ordered ( FL(..), RL(..), (:>)(..), 53 (+>+), lengthFL, lengthRL, concatRL, mapFL_FL, 54 spanFL, reverseFL, (+<+), mapFL, 55 unsafeCoerceP ) 56 import Darcs.Patch.Choices ( PatchChoices, patch_choices, patch_choices_tps, 57 force_first, force_last, make_uncertain, tag, 58 get_choices, 59 separate_first_middle_from_last, 60 separate_first_from_middle_last, 61 patch_slot, 62 select_all_middles, 63 force_matching_last, 64 force_matching_first, make_everything_later, 65 TaggedPatch, tp_patch, Slot(..), 66 ) 67 import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching ) 68 import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager ) 69 import Darcs.Match ( have_nonrange_match, match_a_patch, match_a_patchread ) 70 import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies), isInteractive ) 71 import Darcs.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2 ) 72 import Darcs.Utils ( askUser, promptCharFancy ) 73 import Printer ( prefix, putDocLn ) 74 #include "impossible.h" 75 76 data WhichChanges = Last | LastReversed | First | FirstReversed deriving (Eq, Show) 77 78 type MatchCriterion p = FORALL(u v) WhichChanges -> [DarcsFlag] -> (p C(u v)) -> Bool 79 80 type WithPatches p a C(x y) = 81 String -- jobname 82 -> [DarcsFlag] -- opts 83 -> FL p C(x y) -- patches to select among 84 -> ((FL p :> FL p) C(x y) -> IO a) -- job 85 -> IO a -- result of running job 86 87 -- | The only difference with 'WithPatches' is the [FilePath] argument 88 type WithPatchesToFiles p a C(x y) = 89 String -- jobname 90 -> [DarcsFlag] -- opts 91 -> [FilePath] -- files 92 -> FL p C(x y) -- patches to select among 93 -> ((FL p :> FL p) C(x y) -> IO a) -- job 94 -> IO a -- result of running job 95 96 with_selected_changes' 97 :: WithPatches Prim a C(x y) 98 with_selected_changes_to_files' 99 :: WithPatchesToFiles Prim a C(x y) 100 with_selected_last_changes_to_files' 101 :: WithPatchesToFiles Prim a C(x y) 102 with_selected_last_changes_reversed' 103 :: WithPatches Prim a C(x y) 104 105 -- Common match criteria 106 triv :: MatchCriterion p 107 triv _ _ _ = True 108 109 iswanted :: Patchy p => MatchCriterion (PatchInfoAnd p) 110 iswanted First opts p = match_a_patch opts . hopefully $ p 111 iswanted LastReversed opts p = match_a_patch opts . hopefully . invert $ p 112 iswanted Last _ _ = bug "don't support patch matching with Last in wasp" 113 iswanted FirstReversed _ _ = bug "don't support patch matching with FirstReversed in wasp" 114 115 with_selected_changes' = wasc First triv 116 with_selected_changes_to_files' = wasc_ First triv 117 with_selected_last_changes_to_files' = wasc_ Last triv 118 with_selected_last_changes_reversed' = wasc LastReversed triv 119 120 with_selected_changes :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) 121 with_selected_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) 122 with_selected_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) 123 with_selected_last_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) 124 with_selected_last_changes_to_files_reversed :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y) 125 with_selected_last_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y) 126 127 with_selected_changes = wasc First iswanted 128 with_selected_changes_to_files = wasc_ First iswanted 129 with_selected_changes_reversed = wasc FirstReversed iswanted 130 with_selected_last_changes_to_files = wasc_ Last iswanted 131 with_selected_last_changes_to_files_reversed = wasc_ LastReversed iswanted 132 with_selected_last_changes_reversed = wasc LastReversed iswanted 133 134 -- | wasc and wasc_ are just shorthand for with_any_selected_changes 135 wasc :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatches p a C(x y) 136 wasc mwch crit j o = wasc_ mwch crit j o [] 137 wasc_ :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y) 138 wasc_ = with_any_selected_changes 139 140 with_any_selected_changes :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y) 141 with_any_selected_changes Last crit jn opts fs = 142 with_any_selected_changes_last 143 (patches_to_consider_last' fs opts crit) 144 crit jn opts fs 145 with_any_selected_changes First crit jn opts fs = 146 with_any_selected_changes_first 147 (patches_to_consider_first' fs opts crit) 148 crit jn opts fs 149 with_any_selected_changes FirstReversed crit jn opts fs = 150 with_any_selected_changes_first_reversed 151 (patches_to_consider_first_reversed' fs opts crit) 152 crit jn opts fs 153 with_any_selected_changes LastReversed crit jn opts fs = 154 with_any_selected_changes_last_reversed 155 (patches_to_consider_last_reversed' fs opts crit) 156 crit jn opts fs 157 158 159 view_changes :: RepoPatch p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO () 160 view_changes opts ps = do 161 text_view opts Nothing 0 NilRL init_tps init_pc 162 return () 163 where (init_pc, init_tps) = patch_choices_tps ps 164 165 data KeyPress a = KeyPress { kp :: Char 166 , kpHelp :: String } 167 168 helpFor :: String -> [[KeyPress a]] -> String 169 helpFor jobname options = 170 unlines $ [ "How to use "++jobname++":" ] 171 ++ (concat $ intersperse [""] $ map (map help) options) 172 ++ [ "" 173 , "?: show this help" 174 , "" 175 , "<Space>: accept the current default (which is capitalized)" 176 ] 177 where help i = kp i:(": "++kpHelp i) 178 179 keysFor :: [[KeyPress a]] -> [Char] 180 keysFor = concatMap (map kp) 181 182 with_selected_patch_from_repo :: forall p C(r u t). RepoPatch p => String -> Repository p C(r u t) -> [DarcsFlag] 183 -> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO () 184 with_selected_patch_from_repo jn repository opts job = do 185 p_s <- read_repo repository 186 sp <- wspfr jn (match_a_patchread opts) 187 (concatRL p_s) NilFL 188 case sp of 189 Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected) 190 Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected." 191 192 -- | This ensures that the selected patch commutes freely with the skipped patches, including pending 193 -- and also that the skipped sequences has an ending context that matches the recorded state, z, 194 -- of the repository. 195 wspfr :: RepoPatch p => String -> (FORALL(a b) (PatchInfoAnd p) C(a b) -> Bool) 196 -> RL (PatchInfoAnd p) C(x y) -> FL (PatchInfoAnd p) C(y u) 197 -> IO (Maybe (FlippedSeal (FL (PatchInfoAnd p) :> (PatchInfoAnd p)) C(u))) 198 wspfr _ _ NilRL _ = return Nothing 199 wspfr jn matches (p:<:pps) skipped 200 | not $ matches p = wspfr jn matches pps (p:>:skipped) 201 | otherwise = 202 case commuteFL (p :> skipped) of 203 Left _ -> do putStrLn "\nSkipping depended-upon patch:" 204 printFriendly [] p 205 wspfr jn matches pps (p:>:skipped) 206 Right (skipped' :> p') -> do 207 printFriendly [] p 208 let repeat_this = wspfr jn matches (p:<:pps) skipped 209 options = [[ KeyPress 'y' (jn++" this patch") 210 , KeyPress 'n' ("don't "++jn++" it") 211 , KeyPress 'v' "view this patch in full" 212 , KeyPress 'p' "view this patch in full with pager" 213 , KeyPress 'x' "view a summary of this patch" 214 , KeyPress 'q' ("cancel "++jn) 215 ]] 216 let prompt = "Shall I "++jn++" this patch?" 217 yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h" 218 case yorn of 219 'y' -> return $ Just $ flipSeal $ skipped' :> p' 220 'n' -> wspfr jn matches pps (p:>:skipped) 221 'v' -> printPatch p >> repeat_this 222 'p' -> printPatchPager p >> repeat_this 223 'x' -> do putDocLn $ prefix " " $ summary p 224 repeat_this 225 'q' -> do putStrLn $ jn_cap++" cancelled." 226 exitWith $ ExitSuccess 227 _ -> do putStrLn $ helpFor jn options 228 repeat_this 229 where jn_cap = (toUpper $ head jn) : tail jn 230 231 with_any_selected_changes_last :: forall p a C(x y). Patchy p 232 => (FL p C(x y) -> (FL p :> FL p) C(x y)) 233 -> MatchCriterion p 234 -> WithPatchesToFiles p a C(x y) 235 with_any_selected_changes_last p2c crit jobname opts _ ps job = 236 case p2c ps of 237 ps_to_consider :> other_ps -> 238 if not $ isInteractive opts 239 then job $ ps_to_consider :> other_ps 240 else do pc <- tentatively_text_select "" jobname (Noun "patch") Last crit 241 opts ps_len 0 NilRL init_tps init_pc 242 job $ selected_patches_last rejected_ps pc 243 where rejected_ps = ps_to_consider 244 ps_len = lengthFL init_tps 245 (init_pc, init_tps) = patch_choices_tps $ other_ps 246 247 with_any_selected_changes_first :: forall p a C(x y). Patchy p 248 => (FL p C(x y) -> (FL p :> FL p) C(x y)) 249 -> MatchCriterion p 250 -> WithPatchesToFiles p a C(x y) 251 with_any_selected_changes_first p2c crit jobname opts _ ps job = 252 case p2c ps of 253 ps_to_consider :> other_ps -> 254 if not $ isInteractive opts 255 then job $ ps_to_consider :> other_ps 256 else do pc <- tentatively_text_select "" jobname (Noun "patch") First crit 257 opts ps_len 0 NilRL init_tps init_pc 258 job $ selected_patches_first rejected_ps pc 259 where rejected_ps = other_ps 260 ps_len = lengthFL init_tps 261 (init_pc, init_tps) = patch_choices_tps $ ps_to_consider 262 263 with_any_selected_changes_first_reversed :: forall p a C(x y). Patchy p 264 => (FL p C(x y) -> (FL p :> FL p) C(y x)) 265 -> MatchCriterion p 266 -> WithPatchesToFiles p a C(x y) 267 with_any_selected_changes_first_reversed p2c crit jobname opts _ ps job = 268 case p2c ps of 269 ps_to_consider :> other_ps -> 270 if not $ isInteractive opts 271 then job $ invert other_ps :> invert ps_to_consider 272 else do pc <- tentatively_text_select "" jobname (Noun "patch") FirstReversed crit 273 opts ps_len 0 NilRL init_tps init_pc 274 job $ selected_patches_first_reversed rejected_ps pc 275 where rejected_ps = ps_to_consider 276 ps_len = lengthFL init_tps 277 (init_pc, init_tps) = patch_choices_tps other_ps 278 279 with_any_selected_changes_last_reversed :: forall p a C(x y). Patchy p 280 => (FL p C(x y) -> (FL p :> FL p) C(y x)) 281 -> MatchCriterion p 282 -> WithPatchesToFiles p a C(x y) 283 with_any_selected_changes_last_reversed p2c crit jobname opts _ ps job = 284 case p2c ps of 285 ps_to_consider :> other_ps -> 286 if not $ isInteractive opts 287 then job $ invert other_ps :> invert ps_to_consider 288 else do pc <- tentatively_text_select "" jobname (Noun "patch") LastReversed crit 289 opts ps_len 0 NilRL init_tps init_pc 290 job $ selected_patches_last_reversed rejected_ps pc 291 where rejected_ps = other_ps 292 ps_len = lengthFL init_tps 293 (init_pc, init_tps) = patch_choices_tps ps_to_consider 294 295 296 patches_to_consider_first' :: Patchy p 297 => [FilePath] -- ^ files 298 -> [DarcsFlag] -- ^ opts 299 -> MatchCriterion p 300 -> FL p C(x y) -- ^ patches 301 -> (FL p :> FL p) C(x y) 302 patches_to_consider_first' fs opts crit ps = 303 let deselect_unwanted pc = 304 if have_nonrange_match opts 305 then if DontGrabDeps `elem` opts 306 then force_matching_last (not.iswanted_) pc 307 else make_everything_later $ force_matching_first iswanted_ pc 308 else pc 309 iswanted_ = crit First opts . tp_patch 310 in if null fs && not (have_nonrange_match opts) 311 then ps :> NilFL 312 else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs 313 $ deselect_unwanted $ patch_choices ps 314 315 patches_to_consider_last' :: Patchy p 316 => [FilePath] -- ^ files 317 -> [DarcsFlag] -- ^ opts 318 -> MatchCriterion p 319 -> FL p C(x y) -- ^ patches 320 -> (FL p :> FL p) C(x y) 321 patches_to_consider_last' fs opts crit ps = 322 let deselect_unwanted pc = 323 if have_nonrange_match opts 324 then if DontGrabDeps `elem` opts 325 then force_matching_last (not.iswanted_) pc 326 else make_everything_later $ force_matching_first iswanted_ pc 327 else pc 328 iswanted_ = crit Last opts . tp_patch 329 in if null fs && not (have_nonrange_match opts) 330 then NilFL :> ps 331 else case get_choices $ select_not_touching fs $ deselect_unwanted $ patch_choices ps of 332 fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc 333 334 patches_to_consider_first_reversed' :: Patchy p 335 => [FilePath] -- ^ files 336 -> [DarcsFlag] -- ^ opts 337 -> MatchCriterion p 338 -> FL p C(x y) -- ^ patches 339 -> (FL p :> FL p) C(y x) 340 patches_to_consider_first_reversed' fs opts crit ps = 341 let deselect_unwanted pc = 342 if have_nonrange_match opts 343 then if DontGrabDeps `elem` opts 344 then force_matching_last (not.iswanted_) pc 345 else make_everything_later $ force_matching_first iswanted_ pc 346 else pc 347 iswanted_ = crit FirstReversed opts . tp_patch 348 in if null fs && not (have_nonrange_match opts) 349 then NilFL :> (invert ps) 350 else case get_choices $ select_not_touching fs $ deselect_unwanted $ patch_choices $ invert ps of 351 fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc 352 353 patches_to_consider_last_reversed' :: Patchy p 354 => [FilePath] -- ^ files 355 -> [DarcsFlag] -- ^ opts 356 -> MatchCriterion p 357 -> FL p C(x y) -- ^ patches 358 -> (FL p :> FL p) C(y x) 359 patches_to_consider_last_reversed' fs opts crit ps = 360 let deselect_unwanted pc = 361 if have_nonrange_match opts 362 then if DontGrabDeps `elem` opts 363 then force_matching_last (not.iswanted_) pc 364 else make_everything_later $ force_matching_first iswanted_ pc 365 else pc 366 iswanted_ = crit LastReversed opts . tp_patch 367 in 368 if null fs && not (have_nonrange_match opts) 369 then (invert ps) :> NilFL 370 else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs 371 $ deselect_unwanted $ patch_choices $ invert ps 372 373 -- | Returns the results of a patch selection user interaction 374 selected_patches_last :: Patchy p => FL p C(x y) -> PatchChoices p C(y z) 375 -> (FL p :> FL p) C(x z) 376 selected_patches_last other_ps pc = 377 case get_choices pc of 378 fc :> mc :> lc -> other_ps +>+ mapFL_FL tp_patch (fc +>+ mc) :> mapFL_FL tp_patch lc 379 380 selected_patches_first :: Patchy p => FL p C(y z) -> PatchChoices p C(x y) 381 -> (FL p :> FL p) C(x z) 382 selected_patches_first other_ps pc = 383 case separate_first_from_middle_last pc of 384 xs :> ys -> mapFL_FL tp_patch xs :> mapFL_FL tp_patch ys +>+ other_ps 385 386 selected_patches_last_reversed :: Patchy p => FL p C(y x) -> PatchChoices p C(z y) 387 -> (FL p :> FL p) C(x z) 388 selected_patches_last_reversed other_ps pc = 389 case separate_first_from_middle_last pc of 390 xs :> ys -> invert (mapFL_FL tp_patch ys +>+ other_ps) :> invert (mapFL_FL tp_patch xs) 391 392 selected_patches_first_reversed :: Patchy p => FL p C(z y) -> PatchChoices p C(y x) 393 -> (FL p :> FL p) C(x z) 394 selected_patches_first_reversed other_ps pc = 395 case get_choices pc of 396 fc :> mc :> lc -> invert (mapFL_FL tp_patch lc) :> invert (other_ps +>+ mapFL_FL tp_patch (fc +>+ mc)) 397 398 text_select :: forall p C(x y z). Patchy p => String -> WhichChanges 399 -> MatchCriterion p -> [DarcsFlag] -> Int -> Int 400 -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z) -> PatchChoices p C(x z) 401 -> IO ((PatchChoices p) C(x z)) 402 403 text_select _ _ _ _ _ _ _ NilFL pc = return pc 404 text_select jn whichch crit opts n_max n 405 tps_done tps_todo@(tp:>:tps_todo') pc = do 406 (printFriendly opts) `unseal2` viewp 407 repeat_this -- prompt the user 408 where 409 do_next_action ja je = tentatively_text_select ja jn je whichch crit opts 410 n_max 411 (n+1) (tp:<:tps_done) tps_todo' 412 do_next = do_next_action "" (Noun "patch") 413 helper :: PatchChoices p C(a b) -> p C(a b) 414 helper = undefined 415 thing = Darcs.Patch.thing (helper pc) 416 things = Darcs.Patch.things (helper pc) 417 options_basic = 418 [ KeyPress 'y' (jn++" this "++thing) 419 , KeyPress 'n' ("don't "++jn++" it") 420 , KeyPress 'w' ("wait and decide later, defaulting to no") ] 421 options_file = 422 [ KeyPress 's' ("don't "++jn++" the rest of the changes to this file") 423 , KeyPress 'f' (jn++" the rest of the changes to this file") ] 424 options_view = 425 [ KeyPress 'v' ("view this "++thing++" in full") 426 , KeyPress 'p' ("view this "++thing++" in full with pager") 427 , KeyPress 'l' ("list all selected "++things) ] 428 options_summary = 429 [ KeyPress 'x' ("view a summary of this "++thing) ] 430 options_quit = 431 [ KeyPress 'd' (jn++" selected "++things++", skipping all the remaining "++things) 432 , KeyPress 'a' (jn++" all the remaining "++things) 433 , KeyPress 'q' ("cancel "++jn) ] 434 options_nav = 435 [ KeyPress 'j' ("skip to next "++thing) 436 , KeyPress 'k' ("back up to previous "++thing) ] 437 options = [options_basic] 438 ++ (if is_single_file_patch then [options_file] else []) 439 ++ [options_view ++ 440 if Summary `elem` opts then [] else options_summary] 441 ++ [options_quit] 442 ++ [options_nav ] 443 prompt = "Shall I "++jn++" this "++thing++"? " 444 ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") " 445 repeat_this :: IO ((PatchChoices p) C(x z)) 446 repeat_this = do 447 yorn <- promptCharFancy prompt (keysFor options) (Just the_default) "?h" 448 case yorn of 449 'y' -> do_next $ force_yes (tag tp) pc 450 'n' -> do_next $ force_no (tag tp) pc 451 'w' -> do_next $ make_uncertain (tag tp) pc 452 's' -> do_next_action "Skipped" (Noun "change") $ skip_file 453 'f' -> do_next_action "Included" (Noun "change") $ do_file 454 'v' -> printPatch `unseal2` viewp >> repeat_this 455 'p' -> printPatchPager `unseal2` viewp >> repeat_this 456 'l' -> do let selected = case get_choices pc of 457 (first_chs:>_:>last_chs) -> 458 if whichch == Last || whichch == FirstReversed 459 then map_patches last_chs 460 else map_patches first_chs 461 map_patches = mapFL (\a -> 462 (showFriendly opts) `unseal2` (seal2 $ tp_patch a)) 463 putStrLn $ "---- Already selected "++things++" ----" 464 mapM_ putDocLn $ selected 465 putStrLn $ "---- end of already selected "++things++" ----" 466 (printFriendly opts) `unseal2` viewp 467 repeat_this 468 'x' -> do (putDocLn . prefix " " . summary) `unseal2` viewp 469 repeat_this 470 'd' -> return pc 471 'a' -> do ask_confirmation 472 return $ select_all_middles (whichch == Last || whichch == FirstReversed) pc 473 'q' -> do putStrLn $ jn_cap++" cancelled." 474 exitWith $ ExitSuccess 475 'j' -> case tps_todo' of 476 NilFL -> -- May as well work out the length now we have all 477 -- the patches in memory 478 text_select jn whichch crit opts 479 n_max n tps_done tps_todo pc 480 _ -> text_select jn whichch crit opts 481 n_max (n+1) (tp:<:tps_done) tps_todo' pc 482 'k' -> case tps_done of 483 NilRL -> repeat_this 484 (tp':<:tps_done') -> 485 text_select jn whichch crit opts 486 n_max (n-1) tps_done' (tp':>:tps_todo) pc 487 'c' -> text_select jn whichch crit opts 488 n_max n tps_done tps_todo pc 489 _ -> do putStrLn $ helpFor jn options 490 repeat_this 491 force_yes = if whichch == Last || whichch == FirstReversed then force_last else force_first 492 force_no = if whichch == Last || whichch == FirstReversed then force_first else force_last 493 patches_to_skip = (tag tp:) $ catMaybes 494 $ mapFL (\tp' -> if list_touched_files tp' == touched_files 495 then Just (tag tp') 496 else Nothing) tps_todo' 497 skip_file = foldr force_no pc patches_to_skip 498 do_file = foldr force_yes pc patches_to_skip 499 the_default = get_default (whichch == Last || whichch == FirstReversed) $ patch_slot tp pc 500 jn_cap = (toUpper $ head jn) : tail jn 501 touched_files = list_touched_files $ tp_patch tp 502 is_single_file_patch = length touched_files == 1 503 viewp = if whichch == LastReversed || whichch == FirstReversed then seal2 $ invert (tp_patch tp) else seal2 $ tp_patch tp 504 ask_confirmation = 505 if jn `elem` ["unpull", "unrecord", "obliterate"] 506 then do yorn <- askUser $ "Really " ++ jn ++ " all undecided patches? " 507 case yorn of 508 ('y':_) -> return () 509 _ -> exitWith $ ExitSuccess 510 else return () 511 512 text_view :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Maybe Int -> Int 513 -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y u) -> PatchChoices p C(r s) 514 -> IO ((PatchChoices p) C(r s)) 515 text_view _ _ _ _ NilFL _ = return $ patch_choices $ unsafeCoerceP NilFL --return pc 516 text_view opts n_max n 517 tps_done tps_todo@(tp:>:tps_todo') pc = do 518 printFriendly opts (tp_patch tp) 519 putStr "\n" 520 repeat_this -- prompt the user 521 where 522 prev_patch :: IO ((PatchChoices p) C(r s)) 523 prev_patch = case tps_done of 524 NilRL -> repeat_this 525 (tp':<:tps_done') -> 526 text_view opts 527 n_max (n-1) tps_done' (tp':>:tps_todo) pc 528 next_patch :: IO ((PatchChoices p) C(r s)) 529 next_patch = case tps_todo' of 530 NilFL -> -- May as well work out the length now we have all 531 -- the patches in memory 532 text_view opts n_max 533 n tps_done NilFL pc 534 _ -> text_view opts n_max 535 (n+1) (tp:<:tps_done) tps_todo' pc 536 options_yn = 537 [ KeyPress 'y' "view this patch and go to the next" 538 , KeyPress 'n' "skip to the next patch" ] 539 options_view = 540 [ KeyPress 'v' "view this patch in full" 541 , KeyPress 'p' "view this patch in full with pager" ] 542 options_summary = 543 [ KeyPress 'x' "view a summary of this patch" ] 544 options_nav = 545 [ KeyPress 'q' ("quit view changes") 546 , KeyPress 'k' "back up to previous patch" 547 , KeyPress 'j' "skip to next patch" 548 , KeyPress 'c' "count total patch number" ] 549 options = [ options_yn ] 550 ++ [ options_view ++ 551 if Summary `elem` opts then [] else options_summary ] 552 ++ [ options_nav ] 553 prompt = "Shall I view this patch? " 554 ++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")" 555 repeat_this :: IO ((PatchChoices p) C(r s)) 556 repeat_this = do 557 yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h" 558 case yorn of 559 'y' -> printPatch (tp_patch tp) >> next_patch 560 'n' -> next_patch 561 'v' -> printPatch (tp_patch tp) >> repeat_this 562 'p' -> printPatchPager (tp_patch tp) >> repeat_this 563 'x' -> do putDocLn $ prefix " " $ summary (tp_patch tp) 564 repeat_this 565 'q' -> exitWith ExitSuccess 566 'k' -> prev_patch 567 'j' -> next_patch 568 'c' -> text_view opts 569 count_n_max n tps_done tps_todo pc 570 _ -> do putStrLn $ helpFor "view changes" options 571 repeat_this 572 count_n_max | isJust n_max = n_max 573 | otherwise = Just $ lengthFL tps_todo + lengthRL tps_done 574 tentatively_text_select :: Patchy p => String -> String -> Noun -> WhichChanges 575 -> MatchCriterion p -> [DarcsFlag] 576 -> Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z) 577 -> PatchChoices p C(x z) 578 -> IO ((PatchChoices p) C(x z)) 579 tentatively_text_select _ _ _ _ _ _ _ _ _ NilFL pc = return pc 580 tentatively_text_select jobaction jobname jobelement whichch crit 581 opts n_max n ps_done ps_todo pc = 582 case spanFL (\p -> decided $ patch_slot p pc) ps_todo of 583 skipped :> unskipped -> do 584 when (numSkipped > 0) show_skipped 585 let (boringThenInteresting) = 586 if DontPromptForDependencies `elem` opts 587 then spanFL (not.(crit whichch opts).tp_patch) unskipped 588 else NilFL :> unskipped 589 case boringThenInteresting of 590 boring :> interesting -> do 591 let numNotConsidered = lengthFL boring + numSkipped 592 text_select jobname whichch crit opts n_max (n + numNotConsidered) 593 (reverseFL boring +<+ reverseFL skipped +<+ ps_done) interesting pc 594 where 595 numSkipped = lengthFL skipped 596 show_skipped = do putStrLn $ _doing_ ++ _with_ ++ "." 597 when (Verbose `elem` opts) $ showskippedpatch skipped 598 where 599 _doing_ = _action_ ++ " " ++ jobname 600 _with_ = " of " ++ show numSkipped ++ " " ++ _elem_ "" 601 _action_ = if (length jobaction) == 0 then "Skipped" else jobaction 602 _elem_ = englishNum numSkipped jobelement 603 showskippedpatch :: Patchy p => FL (TaggedPatch p) C(y t) -> IO () 604 showskippedpatch (tp:>:tps) = (putDocLn $ prefix " " $ summary (tp_patch tp)) >> showskippedpatch tps 605 showskippedpatch NilFL = return () 606 607 decided :: Slot -> Bool 608 decided InMiddle = False 609 decided _ = True 610 611 get_default :: Bool -> Slot -> Char 612 get_default _ InMiddle = 'w' 613 get_default True InFirst = 'n' 614 get_default True InLast = 'y' 615 get_default False InFirst = 'y' 616 get_default False InLast = 'n' 617 618 tp_patches :: (FL (TaggedPatch p) :> FL (TaggedPatch p)) C(x y) 619 -> (FL p :> FL p) C(x y) 620 tp_patches (x:>y) = mapFL_FL tp_patch x :> mapFL_FL tp_patch y