%  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 ( 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,
                     commuteFL )
import qualified Darcs.Patch ( thing, things )
import Darcs.Ordered ( FL(..), RL(..), (:>)(..), EqCheck(..), MyEq(..),
                       (+>+), lengthFL, concatRL, mapFL_FL,
                       spanFL, reverseFL, (+<+), mapFL,
                       unsafeCoerceP, reverseRL )
import Darcs.Patch.Choices ( PatchChoices, patch_choices, patch_choices_tps,
                             force_first, force_last, make_uncertain, tag,
                      get_choices,
                      separate_first_middle_from_last,
                      separate_first_from_middle_last,
                      patch_slot,
                      select_all_middles,
                      force_matching_last,
                      force_matching_first, make_everything_later,
                             TaggedPatch, tp_patch, Slot(..),
                    )
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(..), FlippedSeal(..), seal, flipSeal, seal2, unseal2 )
import Darcs.Utils ( askUser, promptCharFancy, without_buffering )
import Printer ( prefix, putDocLn )
#include "impossible.h"
\end{code}

\begin{code}

type WithPatches p a C(x y) =
        String              -- jobname
     -> [DarcsFlag]         -- opts
     -> Slurpy              -- directory
     -> 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
     -> Slurpy              -- directory
     -> [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)

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 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
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 C(x y)
wasc mwch j o s = wasc_ mwch j o s []
wasc_ :: Patchy p => WhichChanges -> WithPatchesToFiles p a C(x y)
wasc_ = with_any_selected_changes

wasc'
  :: RepoPatch p => WhichChanges -> WithPatches (PatchInfoAnd p) a C(x y)
wasc' mwch j o s = wasc_' mwch j o s []
wasc_'
  :: RepoPatch p => WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a C(x y)
wasc_' = with_any_selected_changes'

with_any_selected_changes :: Patchy p => WhichChanges -> WithPatchesToFiles p a C(x y)
with_any_selected_changes Last jn opts s fs =
    with_any_selected_changes_last (patches_to_consider_last fs) jn opts s fs
with_any_selected_changes First jn opts s fs =
    with_any_selected_changes_first (patches_to_consider_first fs) jn opts s fs
with_any_selected_changes FirstReversed jn opts s fs =
    with_any_selected_changes_first_reversed (patches_to_consider_first_reversed fs) jn opts s fs
with_any_selected_changes LastReversed jn opts s fs =
    with_any_selected_changes_last_reversed (patches_to_consider_last_reversed fs) jn opts s fs


with_any_selected_changes'
  :: RepoPatch p => WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a C(x y)
with_any_selected_changes' Last jn opts s fs =
    with_any_selected_changes_last (patches_to_consider_last' fs opts) jn opts s fs
with_any_selected_changes' First jn opts s fs =
    with_any_selected_changes_first (patches_to_consider_first' fs opts) jn opts s fs
with_any_selected_changes' FirstReversed jn opts s fs =
    with_any_selected_changes_first_reversed (patches_to_consider_first_reversed' fs opts) jn opts s fs
with_any_selected_changes' LastReversed jn opts s fs =
    with_any_selected_changes_last_reversed (patches_to_consider_last_reversed' fs opts) jn opts s fs

view_changes :: RepoPatch p => [DarcsFlag] -> Slurpy -> [FilePath] -> FL (PatchInfoAnd p) C(x y) -> IO ()
view_changes opts _ fp ps =
  case patches_to_consider_nothing' fp opts ps of
  ps_to_consider :> _ -> vc ps_to_consider
 where
       vc :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO ()
       vc p = without_buffering $ do text_view opts ps_len 0 NilRL init_tps init_pc
                                     return ()
        where (init_pc, init_tps) = patch_choices_tps p
              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"
               , ""
               , "<Space>: 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 :: forall p C(r u t). RepoPatch p => String -> Repository p C(r u t) -> [DarcsFlag] -> Bool
                              -> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO ()
with_selected_patch_from_repo jn repository opts ignore_pending job = do
    p_s <- read_repo repository
    Sealed pend <- if ignore_pending
                   then return $ seal (NilFL :: FL Prim C(r r))
                   else read_pending repository
    let pend_ = n2pia $ anonymous $ fromPrims pend
    sp <- without_buffering $ wspfr jn (doesnt_not_match opts)
                              (concatRL p_s) NilFL pend_
    case sp of
     Just (FlippedSeal (s_and_pend :> selected)) ->
        case reverseFL s_and_pend of
          pend' :<: skipped ->
           -- Due to the way wspfr always leaves the pending as the last patch
           -- in the s_and_pend portion of it's return value, this test should
           -- always be true and it tells the type system that pend_ and pend'
           -- are equal and hence have the same contexts.
           case commute (pend' :> selected) of
             Just (selected' :> pend'') | IsEq <- pend_ =/\= pend'' ->
                                                  job (reverseRL skipped :> selected')
             _ -> impossible
          NilRL -> impossible
     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 z) -> (PatchInfoAnd p) C(z u)
      -> IO (Maybe (FlippedSeal (FL (PatchInfoAnd p) :> (PatchInfoAnd p)) C(u)))
wspfr _ _ NilRL _ _ = return Nothing
wspfr jn matches (p:<:pps) skipped pend
    | not $ matches p = wspfr jn matches pps (p:>:skipped) pend
    | otherwise =
    case commuteFL (p :> skipped +>+ (pend :>: NilFL)) of
    Left _  -> do putStr "\nSkipping depended-upon patch:"
                  printFriendly [] p
                  wspfr jn matches pps (p:>:skipped) pend
    Right (skipped' :> p') -> do
      printFriendly [] p
      let repeat_this  = wspfr jn matches (p:<:pps) skipped pend
          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) pend
        '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
\end{code}

\begin{code}
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))
                               -> WithPatchesToFiles p a C(x y)
with_any_selected_changes_last p2c jobname opts _ _ ps job =
 case p2c ps of
 ps_to_consider :> other_ps ->
         if All `elem` opts || DryRun `elem` opts
         then job $ ps_to_consider :> other_ps
         else do pc <- without_buffering $
                       tentatively_text_select "" jobname (Noun "patch") Last
                                              opts ps_len 0 NilRL init_tps init_pc
                 job $ selected_patches_last rejected_ps pc
         where rejected_ps = ps_to_consider
               ps_len = lengthFL init_tps
               (init_pc, init_tps) = patch_choices_tps $ 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))
                                -> WithPatchesToFiles p a C(x y)
with_any_selected_changes_first p2c jobname opts _ _ ps job =
 case p2c ps of
 ps_to_consider :> other_ps ->
         if All `elem` opts || DryRun `elem` opts
         then job $ ps_to_consider :> other_ps
         else do pc <- without_buffering $
                       tentatively_text_select "" jobname (Noun "patch") First
                                              opts ps_len 0 NilRL init_tps init_pc
                 job $ selected_patches_first rejected_ps pc
         where rejected_ps = other_ps
               ps_len = lengthFL init_tps
               (init_pc, init_tps) = patch_choices_tps $ 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))
                                -> WithPatchesToFiles p a C(x y)
with_any_selected_changes_first_reversed p2c jobname opts _ _ ps job =
 case p2c ps of
 ps_to_consider :> other_ps ->
         if All `elem` opts || DryRun `elem` opts
         then job $ invert other_ps :> invert ps_to_consider
         else do pc <- without_buffering $
                       tentatively_text_select "" jobname (Noun "patch") FirstReversed
                                             opts ps_len 0 NilRL init_tps init_pc
                 job $ selected_patches_first_reversed rejected_ps pc
         where rejected_ps = ps_to_consider
               ps_len = lengthFL init_tps
               (init_pc, init_tps) = patch_choices_tps 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))
                                -> WithPatchesToFiles p a C(x y)
with_any_selected_changes_last_reversed p2c jobname opts _ _ ps job =
 case p2c ps of
 ps_to_consider :> other_ps ->
         if All `elem` opts || DryRun `elem` opts
         then job $ invert other_ps :> invert ps_to_consider
         else do pc <- without_buffering $
                       tentatively_text_select "" jobname (Noun "patch") LastReversed
                                             opts ps_len 0 NilRL init_tps init_pc
                 job $ selected_patches_last_reversed rejected_ps pc
         where rejected_ps = other_ps
               ps_len = lengthFL init_tps
               (init_pc, init_tps) = patch_choices_tps ps_to_consider

patches_to_consider_last :: Patchy p
                    => [FilePath]  -- ^ files
                    -> FL p C(x y) -- ^ patches
                    -> (FL p :> FL p) C(x y)
patches_to_consider_last [] ps = NilFL :> ps
patches_to_consider_last fs ps =
 case get_choices $ select_not_touching fs $ patch_choices ps of
  fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc

patches_to_consider_first :: Patchy p
                    => [FilePath]  -- ^ files
                    -> FL p C(x y) -- ^ patches
                    -> (FL p :> FL p) C(x y)
patches_to_consider_first [] ps = ps :> NilFL
patches_to_consider_first fs ps =
  tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs
             $ patch_choices $ ps

patches_to_consider_first_reversed :: Patchy p
                    => [FilePath]  -- ^ files
                    -> FL p C(x y) -- ^ patches
                    -> (FL p :> FL p) C(y x)
patches_to_consider_first_reversed [] ps = NilFL :> (invert ps)
patches_to_consider_first_reversed fs ps =
 case get_choices $ select_not_touching fs $ patch_choices $ invert ps of
  fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc

patches_to_consider_last_reversed :: Patchy p
                    => [FilePath]  -- ^ files
                    -> FL p C(x y) -- ^ patches
                    -> (FL p :> FL p) C(y x)
patches_to_consider_last_reversed [] ps = NilFL :> (invert ps)
patches_to_consider_last_reversed fs ps =
  tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs
             $ patch_choices $ (invert ps)

patches_to_consider_first' :: RepoPatch p
                     => [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches
                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(x y)
patches_to_consider_first' fs opts ps =
  let deselect_unwanted pc =
        if have_nonrange_match opts
        then if DontGrabDeps `elem` opts
                  then force_matching_last (not.iswanted) pc
                  else make_everything_later $ force_matching_first iswanted pc
        else pc
      iswanted = match_a_patch opts . hopefully . tp_patch
  in if null fs && not (have_nonrange_match opts)
     then ps :> NilFL
     else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs
                     $ deselect_unwanted $ patch_choices ps

patches_to_consider_last' :: RepoPatch p
                     => [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches
                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(x y)
patches_to_consider_last' fs opts ps =
  let deselect_unwanted pc =
        if have_nonrange_match opts
        then bug "don't support patch matching with Last in wasp"
        else pc
  in if null fs && not (have_nonrange_match opts)
     then NilFL :> ps
     else case get_choices $ select_not_touching fs $ deselect_unwanted $ patch_choices ps of
           fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc

patches_to_consider_first_reversed' :: RepoPatch p
                     => [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches
                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(y x)
patches_to_consider_first_reversed' fs opts ps =
  let deselect_unwanted pc =
        if have_nonrange_match opts
        then bug "don't support patch matching with FirstReversed in wasp"
        else pc
  in if null fs && not (have_nonrange_match opts)
     then NilFL :> (invert ps)
     else case get_choices $ select_not_touching fs $ deselect_unwanted $ patch_choices $ invert ps of
           fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc

patches_to_consider_last_reversed' :: RepoPatch p
                     => [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches
                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(y x)
patches_to_consider_last_reversed' fs opts ps =
  let deselect_unwanted pc =
        if have_nonrange_match opts
        then if DontGrabDeps `elem` opts
             then force_matching_last (not.iswanted) pc
             else make_everything_later $ force_matching_first iswanted pc
        else pc
      iswanted = match_a_patch opts . hopefully . invert . tp_patch
  in if null fs && not (have_nonrange_match opts)
     then (invert ps) :> NilFL
     else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs
                     $ deselect_unwanted $ patch_choices $ invert ps

patches_to_consider_nothing' :: RepoPatch p
                     => [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches
                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(x y)
patches_to_consider_nothing' fs opts ps =
  let deselect_unwanted pc =
        if have_nonrange_match opts
        then if DontGrabDeps `elem` opts
             then force_matching_last (not.iswanted) pc
             else make_everything_later $ force_matching_first iswanted pc
        else pc
      iswanted = match_a_patch opts . hopefully . tp_patch
  in if null fs && not (have_nonrange_match opts)
     then ps :> NilFL
     else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs
                     $ deselect_unwanted $ patch_choices 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 get_choices pc of
   fc :> mc :> lc -> other_ps +>+ mapFL_FL tp_patch (fc +>+ mc) :> mapFL_FL tp_patch 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 separate_first_from_middle_last pc of
  xs :> ys -> mapFL_FL tp_patch xs :> mapFL_FL tp_patch 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 separate_first_from_middle_last pc of
  xs :> ys -> invert (mapFL_FL tp_patch ys +>+ other_ps) :> invert (mapFL_FL tp_patch 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 get_choices pc of
  fc :> mc :> lc -> invert (mapFL_FL tp_patch lc) :> invert (other_ps +>+ mapFL_FL tp_patch (fc +>+ mc))

text_select :: forall p C(x y z). Patchy p => String -> WhichChanges -> [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 jn whichch 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 ja jn je whichch 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)
        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 :: 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 $ 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 `unseal2` viewp >> repeat_this
            'p' -> printPatchPager `unseal2` viewp >> repeat_this
            'x' -> do (putDocLn . prefix "    " . summary) `unseal2` 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) $ patch_slot 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 seal2 $ invert (tp_patch tp) else seal2 $ 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 :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> 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 $ patch_choices $ unsafeCoerceP 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 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" ]
        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 :: IO ((PatchChoices p) C(r s))
        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) 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 jobaction jobname jobelement whichch opts n_max n ps_done
                        ps_todo pc =
  case spanFL (\p -> decided $ patch_slot p pc) ps_todo of
  skipped :> unskipped -> do
   when (numSkipped > 0) show_skipped
   text_select jobname whichch opts n_max (n + numSkipped)
     (reverseFL skipped +<+ ps_done) unskipped 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 (tp_patch 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'
\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}
