src/Darcs/SelectChanges.lhs

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