#include "gadts.h"
module Darcs.SelectChanges ( with_selected_changes',
with_selected_changes_to_files',
with_selected_last_changes_to_files',
with_selected_last_changes_reversed',
with_selected_changes,
with_selected_changes_to_files,
with_selected_changes_reversed,
with_selected_last_changes_to_files,
with_selected_last_changes_to_files_reversed,
with_selected_last_changes_reversed,
view_changes,
with_selected_patch_from_repo,
filterOutConflicts,
) where
import System.IO
import Data.List ( intersperse )
import Data.Maybe ( catMaybes, isJust )
import Data.Char ( toUpper )
import Control.Monad ( when )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import English ( Noun(..), englishNum )
import Darcs.Arguments ( showFriendly )
import Darcs.Hopefully ( PatchInfoAnd, hopefully, n2pia )
import Darcs.Repository ( Repository, read_repo, unrecordedChanges )
import Darcs.Patch ( RepoPatch, Patchy, Prim, summary,
invert, listTouchedFiles,
commuteFL, fromPrims, anonymous )
import qualified Darcs.Patch ( thing, things )
import Darcs.Patch.Split ( Splitter(..) )
import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (:||:)(..),
(+>+), lengthFL, lengthRL, concatRL, mapFL_FL,
spanFL, reverseFL, (+<+), mapFL,
unsafeCoerceP )
import Darcs.Patch.Choices ( PatchChoices, patchChoices, patchChoicesTps,
patchChoicesTpsSub,
forceFirst, forceLast, makeUncertain, tag,
getChoices,
separateFirstMiddleFromLast,
separateFirstFromMiddleLast,
patchSlot,
selectAllMiddles,
forceMatchingLast,
forceMatchingFirst, makeEverythingLater,
TaggedPatch, tpPatch, Slot(..),
substitute,
)
import Darcs.Patch.Permutations ( partitionConflictingFL, selfCommuter, commuterIdRL )
import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching )
import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager )
import Darcs.Match ( haveNonrangeMatch, matchAPatch, matchAPatchread )
import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies, SkipConflicts), isInteractive )
import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2, Sealed(..) )
import Darcs.Utils ( askUser, promptCharFancy )
import Darcs.Lock ( editText )
import Printer ( prefix, putDocLn )
#include "impossible.h"
data WhichChanges = Last | LastReversed | First | FirstReversed deriving (Eq, Show)
type MatchCriterion p = FORALL(u v) WhichChanges -> [DarcsFlag] -> (p C(u v)) -> Bool
type WithPatches p a C(x y) =
String
-> [DarcsFlag]
-> Maybe (Splitter p)
-> FL p C(x y)
-> ((FL p :> FL p) C(x y) -> IO a)
-> IO a
type WithPatchesToFiles p a C(x y) =
String
-> [DarcsFlag]
-> Maybe (Splitter p)
-> [FilePath]
-> FL p C(x y)
-> ((FL p :> FL p) C(x y) -> IO a)
-> IO a
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)
triv :: MatchCriterion p
triv _ _ _ = True
iswanted :: Patchy p => MatchCriterion (PatchInfoAnd p)
iswanted First opts p = matchAPatch opts . hopefully $ p
iswanted LastReversed opts p = matchAPatch opts . hopefully . invert $ p
iswanted Last _ _ = bug "don't support patch matching with Last in wasp"
iswanted FirstReversed _ _ = bug "don't support patch matching with FirstReversed in wasp"
with_selected_changes' = wasc First triv
with_selected_changes_to_files' = wasc_ First triv
with_selected_last_changes_to_files' = wasc_ Last triv
with_selected_last_changes_reversed' = wasc LastReversed triv
with_selected_changes :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y)
with_selected_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y)
with_selected_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y)
with_selected_last_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y)
with_selected_last_changes_to_files_reversed :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a C(x y)
with_selected_last_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a C(x y)
with_selected_changes = wasc First iswanted
with_selected_changes_to_files = wasc_ First iswanted
with_selected_changes_reversed = wasc FirstReversed iswanted
with_selected_last_changes_to_files = wasc_ Last iswanted
with_selected_last_changes_to_files_reversed = wasc_ LastReversed iswanted
with_selected_last_changes_reversed = wasc LastReversed iswanted
wasc :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatches p a C(x y)
wasc mwch crit j o spl = wasc_ mwch crit j o spl []
wasc_ :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y)
wasc_ = with_any_selected_changes
with_any_selected_changes :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y)
with_any_selected_changes Last crit jn opts splitter fs =
with_any_selected_changes_last
(patches_to_consider_last' fs opts crit)
crit jn opts splitter fs
with_any_selected_changes First crit jn opts splitter fs =
with_any_selected_changes_first
(patches_to_consider_first' fs opts crit)
crit jn opts splitter fs
with_any_selected_changes FirstReversed crit jn opts splitter fs =
with_any_selected_changes_first_reversed
(patches_to_consider_first_reversed' fs opts crit)
crit jn opts splitter fs
with_any_selected_changes LastReversed crit jn opts splitter fs =
with_any_selected_changes_last_reversed
(patches_to_consider_last_reversed' fs opts crit)
crit jn opts splitter fs
view_changes :: RepoPatch p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()
view_changes opts ps = do
text_view opts Nothing 0 NilRL init_tps init_pc
return ()
where (init_pc, init_tps) = patchChoicesTps ps
data KeyPress a = KeyPress { kp :: Char
, kpHelp :: String }
helpFor :: String -> [[KeyPress a]] -> String
helpFor jobname options =
unlines $ [ "How to use "++jobname++":" ]
++ (concat $ intersperse [""] $ map (map help) options)
++ [ ""
, "?: show this help"
, ""
, "<Space>: accept the current default (which is capitalized)"
]
where help i = kp i:(": "++kpHelp i)
keysFor :: [[KeyPress a]] -> [Char]
keysFor = concatMap (map kp)
with_selected_patch_from_repo :: forall p C(r u t). RepoPatch p => String -> Repository p C(r u t) -> [DarcsFlag]
-> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO ()
with_selected_patch_from_repo jn repository opts job = do
p_s <- read_repo repository
sp <- wspfr jn (matchAPatchread opts)
(concatRL p_s) NilFL
case sp of
Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected)
Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected."
wspfr :: RepoPatch p => String -> (FORALL(a b) (PatchInfoAnd p) C(a b) -> Bool)
-> RL (PatchInfoAnd p) C(x y) -> FL (PatchInfoAnd p) C(y u)
-> IO (Maybe (FlippedSeal (FL (PatchInfoAnd p) :> (PatchInfoAnd p)) C(u)))
wspfr _ _ NilRL _ = return Nothing
wspfr jn matches (p:<:pps) skipped
| not $ matches p = wspfr jn matches pps (p:>:skipped)
| otherwise =
case commuteFL (p :> skipped) of
Left _ -> do putStrLn "\nSkipping depended-upon patch:"
printFriendly [] p
wspfr jn matches pps (p:>:skipped)
Right (skipped' :> p') -> do
printFriendly [] p
let repeat_this = wspfr jn matches (p:<:pps) skipped
options = [[ KeyPress 'y' (jn++" this patch")
, KeyPress 'n' ("don't "++jn++" it")
, KeyPress 'v' "view this patch in full"
, KeyPress 'p' "view this patch in full with pager"
, KeyPress 'x' "view a summary of this patch"
, KeyPress 'q' ("cancel "++jn)
]]
let prompt = "Shall I "++jn++" this patch?"
yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h"
case yorn of
'y' -> return $ Just $ flipSeal $ skipped' :> p'
'n' -> wspfr jn matches pps (p:>:skipped)
'v' -> printPatch p >> repeat_this
'p' -> printPatchPager p >> repeat_this
'x' -> do putDocLn $ prefix " " $ summary p
repeat_this
'q' -> do putStrLn $ jn_cap++" cancelled."
exitWith $ ExitSuccess
_ -> do putStrLn $ helpFor jn options
repeat_this
where jn_cap = (toUpper $ head jn) : tail jn
canonizeWith :: Maybe (Splitter p) -> (FL p :> FL p) C(x y) -> (FL p :> FL p) C(x y)
canonizeWith Nothing xy = xy
canonizeWith (Just spl) (x :> y) = canonizeSplit spl x :> canonizeSplit spl y
with_any_selected_changes_last :: forall p a C(x y). Patchy p
=> (FL p C(x y) -> (FL p :> FL p) C(x y))
-> MatchCriterion p
-> WithPatchesToFiles p a C(x y)
with_any_selected_changes_last p2c crit jobname opts splitter _ ps job =
case p2c ps of
ps_to_consider :> other_ps ->
if not $ isInteractive opts
then job $ ps_to_consider :> other_ps
else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") Last crit
opts ps_len 0 NilRL init_tps init_pc
job $ canonizeWith splitter $ selected_patches_last rejected_ps pc
where rejected_ps = ps_to_consider
ps_len = lengthFL init_tps
(init_pc, init_tps) = patchChoicesTps $ other_ps
with_any_selected_changes_first :: forall p a C(x y). Patchy p
=> (FL p C(x y) -> (FL p :> FL p) C(x y))
-> MatchCriterion p
-> WithPatchesToFiles p a C(x y)
with_any_selected_changes_first p2c crit jobname opts splitter _ ps job =
case p2c ps of
ps_to_consider :> other_ps ->
if not $ isInteractive opts
then job $ ps_to_consider :> other_ps
else do pc <- tentatively_text_select splitter "" jobname (Noun "patch") First crit
opts ps_len 0 NilRL init_tps init_pc
job $ canonizeWith splitter $ selected_patches_first rejected_ps pc
where rejected_ps = other_ps
ps_len = lengthFL init_tps
(init_pc, init_tps) = patchChoicesTps $ ps_to_consider
with_any_selected_changes_first_reversed :: forall p a C(x y). Patchy p
=> (FL p C(x y) -> (FL p :> FL p) C(y x))
-> MatchCriterion p
-> WithPatchesToFiles p a C(x y)
with_any_selected_changes_first_reversed p2c crit jobname opts splitter _ ps job =
case p2c ps of
ps_to_consider :> other_ps ->
if not $ isInteractive opts
then job $ invert other_ps :> invert ps_to_consider
else do pc <- tentatively_text_select splitter
"" jobname (Noun "patch") FirstReversed crit
opts ps_len 0 NilRL init_tps init_pc
job $ canonizeWith splitter $ selected_patches_first_reversed rejected_ps pc
where rejected_ps = ps_to_consider
ps_len = lengthFL init_tps
(init_pc, init_tps) = patchChoicesTps other_ps
with_any_selected_changes_last_reversed :: forall p a C(x y). Patchy p
=> (FL p C(x y) -> (FL p :> FL p) C(y x))
-> MatchCriterion p
-> WithPatchesToFiles p a C(x y)
with_any_selected_changes_last_reversed p2c crit jobname opts splitter _ ps job =
case p2c ps of
ps_to_consider :> other_ps ->
if not $ isInteractive opts
then job $ invert other_ps :> invert ps_to_consider
else do pc <- tentatively_text_select splitter
"" jobname (Noun "patch") LastReversed crit
opts ps_len 0 NilRL init_tps init_pc
job $ canonizeWith splitter $ selected_patches_last_reversed rejected_ps pc
where rejected_ps = other_ps
ps_len = lengthFL init_tps
(init_pc, init_tps) = patchChoicesTps ps_to_consider
patches_to_consider_first' :: Patchy p
=> [FilePath]
-> [DarcsFlag]
-> MatchCriterion p
-> FL p C(x y)
-> (FL p :> FL p) C(x y)
patches_to_consider_first' fs opts crit ps =
let deselect_unwanted pc =
if haveNonrangeMatch opts
then if DontGrabDeps `elem` opts
then forceMatchingLast (not.iswanted_) pc
else makeEverythingLater $ forceMatchingFirst iswanted_ pc
else pc
iswanted_ = crit First opts . tpPatch
in if null fs && not (haveNonrangeMatch opts)
then ps :> NilFL
else tp_patches $ separateFirstMiddleFromLast $ deselect_not_touching fs
$ deselect_unwanted $ patchChoices ps
patches_to_consider_last' :: Patchy p
=> [FilePath]
-> [DarcsFlag]
-> MatchCriterion p
-> FL p C(x y)
-> (FL p :> FL p) C(x y)
patches_to_consider_last' fs opts crit ps =
let deselect_unwanted pc =
if haveNonrangeMatch opts
then if DontGrabDeps `elem` opts
then forceMatchingLast (not.iswanted_) pc
else makeEverythingLater $ forceMatchingFirst iswanted_ pc
else pc
iswanted_ = crit Last opts . tpPatch
in if null fs && not (haveNonrangeMatch opts)
then NilFL :> ps
else case getChoices $ select_not_touching fs $ deselect_unwanted $ patchChoices ps of
fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc
patches_to_consider_first_reversed' :: Patchy p
=> [FilePath]
-> [DarcsFlag]
-> MatchCriterion p
-> FL p C(x y)
-> (FL p :> FL p) C(y x)
patches_to_consider_first_reversed' fs opts crit ps =
let deselect_unwanted pc =
if haveNonrangeMatch opts
then if DontGrabDeps `elem` opts
then forceMatchingLast (not.iswanted_) pc
else makeEverythingLater $ forceMatchingFirst iswanted_ pc
else pc
iswanted_ = crit FirstReversed opts . tpPatch
in if null fs && not (haveNonrangeMatch opts)
then NilFL :> (invert ps)
else case getChoices $ select_not_touching fs $ deselect_unwanted $ patchChoices $ invert ps of
fc :> mc :> lc -> tp_patches $ fc :> mc +>+ lc
patches_to_consider_last_reversed' :: Patchy p
=> [FilePath]
-> [DarcsFlag]
-> MatchCriterion p
-> FL p C(x y)
-> (FL p :> FL p) C(y x)
patches_to_consider_last_reversed' fs opts crit ps =
let deselect_unwanted pc =
if haveNonrangeMatch opts
then if DontGrabDeps `elem` opts
then forceMatchingLast (not.iswanted_) pc
else makeEverythingLater $ forceMatchingFirst iswanted_ pc
else pc
iswanted_ = crit LastReversed opts . tpPatch
in
if null fs && not (haveNonrangeMatch opts)
then (invert ps) :> NilFL
else tp_patches $ separateFirstMiddleFromLast $ deselect_not_touching fs
$ deselect_unwanted $ patchChoices $ invert ps
selected_patches_last :: Patchy p => FL p C(x y) -> PatchChoices p C(y z)
-> (FL p :> FL p) C(x z)
selected_patches_last other_ps pc =
case getChoices pc of
fc :> mc :> lc -> other_ps +>+ mapFL_FL tpPatch (fc +>+ mc) :> mapFL_FL tpPatch lc
selected_patches_first :: Patchy p => FL p C(y z) -> PatchChoices p C(x y)
-> (FL p :> FL p) C(x z)
selected_patches_first other_ps pc =
case separateFirstFromMiddleLast pc of
xs :> ys -> mapFL_FL tpPatch xs :> mapFL_FL tpPatch ys +>+ other_ps
selected_patches_last_reversed :: Patchy p => FL p C(y x) -> PatchChoices p C(z y)
-> (FL p :> FL p) C(x z)
selected_patches_last_reversed other_ps pc =
case separateFirstFromMiddleLast pc of
xs :> ys -> invert (mapFL_FL tpPatch ys +>+ other_ps) :> invert (mapFL_FL tpPatch xs)
selected_patches_first_reversed :: Patchy p => FL p C(z y) -> PatchChoices p C(y x)
-> (FL p :> FL p) C(x z)
selected_patches_first_reversed other_ps pc =
case getChoices pc of
fc :> mc :> lc -> invert (mapFL_FL tpPatch lc) :> invert (other_ps +>+ mapFL_FL tpPatch (fc +>+ mc))
text_select :: forall p C(x y z). Patchy p => Maybe (Splitter p) -> String -> WhichChanges
-> MatchCriterion p -> [DarcsFlag] -> Int -> Int
-> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z) -> PatchChoices p C(x z)
-> IO ((PatchChoices p) C(x z))
text_select _ _ _ _ _ _ _ _ NilFL pc = return pc
text_select splitter jn whichch crit opts n_max n
tps_done tps_todo@(tp:>:tps_todo') pc = do
(printFriendly opts) `unseal2` viewp
repeat_this
where
do_next_action ja je = tentatively_text_select splitter ja jn je whichch crit opts
n_max
(n+1) (tp:<:tps_done) tps_todo'
do_next = do_next_action "" (Noun "patch")
helper :: PatchChoices p C(a b) -> p C(a b)
helper = undefined
thing = Darcs.Patch.thing (helper pc)
things = Darcs.Patch.things (helper pc)
split = splitter >>= flip applySplitter (tpPatch tp)
options_basic =
[ KeyPress 'y' (jn++" this "++thing)
, KeyPress 'n' ("don't "++jn++" it")
, KeyPress 'w' ("wait and decide later, defaulting to no") ]
options_file =
[ KeyPress 's' ("don't "++jn++" the rest of the changes to this file")
, KeyPress 'f' (jn++" the rest of the changes to this file") ]
options_view =
[ KeyPress 'v' ("view this "++thing++" in full")
, KeyPress 'p' ("view this "++thing++" in full with pager")
, KeyPress 'l' ("list all selected "++things) ]
options_summary =
[ KeyPress 'x' ("view a summary of this "++thing) ]
options_quit =
[ KeyPress 'd' (jn++" selected "++things++", skipping all the remaining "++things)
, KeyPress 'a' (jn++" all the remaining "++things)
, KeyPress 'q' ("cancel "++jn) ]
options_nav =
[ KeyPress 'j' ("skip to next "++thing)
, KeyPress 'k' ("back up to previous "++thing) ]
options_split
| Just _ <- split
= [ KeyPress 'e' ("interactively edit this "++thing) ]
| otherwise = []
options = [options_basic]
++ [options_split]
++ (if is_single_file_patch then [options_file] else [])
++ [options_view ++
if Summary `elem` opts then [] else options_summary]
++ [options_quit]
++ [options_nav ]
prompt = "Shall I "++jn++" this "++thing++"? "
++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") "
repeat_this :: IO ((PatchChoices p) C(x z))
repeat_this = do
yorn <- promptCharFancy prompt (keysFor options) (Just the_default) "?h"
case yorn of
'y' -> do_next $ force_yes (tag tp) pc
'n' -> do_next $ force_no (tag tp) pc
'w' -> do_next $ makeUncertain (tag tp) pc
'e' | Just (text, parse) <- split
-> do newText <- editText "darcs-patch-edit" text
case parse newText of
Nothing -> repeat_this
Just ps -> do let tps_new = snd $ patchChoicesTpsSub (Just (tag tp)) ps
text_select splitter
jn whichch crit opts (n_max + lengthFL tps_new 1) n
tps_done (tps_new+>+tps_todo')
(substitute (seal2 (tp :||: tps_new)) pc)
's' -> do_next_action "Skipped" (Noun "change") $ skip_file
'f' -> do_next_action "Included" (Noun "change") $ do_file
'v' -> printPatch `unseal2` viewp >> repeat_this
'p' -> printPatchPager `unseal2` viewp >> repeat_this
'l' -> do let selected = case getChoices pc of
(first_chs:>_:>last_chs) ->
if whichch == Last || whichch == FirstReversed
then map_patches last_chs
else map_patches first_chs
map_patches = mapFL (\a ->
(showFriendly opts) `unseal2` (seal2 $ tpPatch a))
putStrLn $ "---- Already selected "++things++" ----"
mapM_ putDocLn $ selected
putStrLn $ "---- end of already selected "++things++" ----"
(printFriendly opts) `unseal2` viewp
repeat_this
'x' -> do (putDocLn . prefix " " . summary) `unseal2` viewp
repeat_this
'd' -> return pc
'a' -> do ask_confirmation
return $ selectAllMiddles (whichch == Last || whichch == FirstReversed) pc
'q' -> do putStrLn $ jn_cap++" cancelled."
exitWith $ ExitSuccess
'j' -> case tps_todo' of
NilFL ->
text_select splitter jn whichch crit opts
n_max n tps_done tps_todo pc
_ -> text_select splitter jn whichch crit opts
n_max (n+1) (tp:<:tps_done) tps_todo' pc
'k' -> case tps_done of
NilRL -> repeat_this
(tp':<:tps_done') ->
text_select splitter jn whichch crit opts
n_max (n1) tps_done' (tp':>:tps_todo) pc
'c' -> text_select splitter jn whichch crit opts
n_max n tps_done tps_todo pc
_ -> do putStrLn $ helpFor jn options
repeat_this
force_yes = if whichch == Last || whichch == FirstReversed then forceLast else forceFirst
force_no = if whichch == Last || whichch == FirstReversed then forceFirst else forceLast
patches_to_skip = (tag tp:) $ catMaybes
$ mapFL (\tp' -> if listTouchedFiles tp' == touched_files
then Just (tag tp')
else Nothing) tps_todo'
skip_file = foldr force_no pc patches_to_skip
do_file = foldr force_yes pc patches_to_skip
the_default = get_default (whichch == Last || whichch == FirstReversed) $ patchSlot tp pc
jn_cap = (toUpper $ head jn) : tail jn
touched_files = listTouchedFiles $ tpPatch tp
is_single_file_patch = length touched_files == 1
viewp = if whichch == LastReversed || whichch == FirstReversed then seal2 $ invert (tpPatch tp) else seal2 $ tpPatch tp
ask_confirmation =
if jn `elem` ["unpull", "unrecord", "obliterate"]
then do yorn <- askUser $ "Really " ++ jn ++ " all undecided patches? "
case yorn of
('y':_) -> return ()
_ -> exitWith $ ExitSuccess
else return ()
text_view :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Maybe Int -> Int
-> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y u) -> PatchChoices p C(r s)
-> IO ((PatchChoices p) C(r s))
text_view _ _ _ _ NilFL _ = return $ patchChoices $ unsafeCoerceP NilFL
text_view opts n_max n
tps_done tps_todo@(tp:>:tps_todo') pc = do
printFriendly opts (tpPatch tp)
putStr "\n"
repeat_this
where
prev_patch :: IO ((PatchChoices p) C(r s))
prev_patch = case tps_done of
NilRL -> repeat_this
(tp':<:tps_done') ->
text_view opts
n_max (n1) tps_done' (tp':>:tps_todo) pc
next_patch :: IO ((PatchChoices p) C(r s))
next_patch = case tps_todo' of
NilFL ->
text_view opts n_max
n tps_done NilFL pc
_ -> text_view opts n_max
(n+1) (tp:<:tps_done) tps_todo' pc
options_yn =
[ KeyPress 'y' "view this patch and go to the next"
, KeyPress 'n' "skip to the next patch" ]
options_view =
[ KeyPress 'v' "view this patch in full"
, KeyPress 'p' "view this patch in full with pager" ]
options_summary =
[ KeyPress 'x' "view a summary of this patch" ]
options_nav =
[ KeyPress 'q' ("quit view changes")
, KeyPress 'k' "back up to previous patch"
, KeyPress 'j' "skip to next patch"
, KeyPress 'c' "count total patch number" ]
options = [ options_yn ]
++ [ options_view ++
if Summary `elem` opts then [] else options_summary ]
++ [ options_nav ]
prompt = "Shall I view this patch? "
++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")"
repeat_this :: IO ((PatchChoices p) C(r s))
repeat_this = do
yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h"
case yorn of
'y' -> printPatch (tpPatch tp) >> next_patch
'n' -> next_patch
'v' -> printPatch (tpPatch tp) >> repeat_this
'p' -> printPatchPager (tpPatch tp) >> repeat_this
'x' -> do putDocLn $ prefix " " $ summary (tpPatch tp)
repeat_this
'q' -> exitWith ExitSuccess
'k' -> prev_patch
'j' -> next_patch
'c' -> text_view opts
count_n_max n tps_done tps_todo pc
_ -> do putStrLn $ helpFor "view changes" options
repeat_this
count_n_max | isJust n_max = n_max
| otherwise = Just $ lengthFL tps_todo + lengthRL tps_done
tentatively_text_select :: Patchy p => Maybe (Splitter p) -> String -> String -> Noun -> WhichChanges
-> MatchCriterion p -> [DarcsFlag]
-> Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z)
-> PatchChoices p C(x z)
-> IO ((PatchChoices p) C(x z))
tentatively_text_select _ _ _ _ _ _ _ _ _ _ NilFL pc = return pc
tentatively_text_select splitter jobaction jobname jobelement whichch crit
opts n_max n ps_done ps_todo pc =
case spanFL (\p -> decided $ patchSlot p pc) ps_todo of
skipped :> unskipped -> do
when (numSkipped > 0) show_skipped
let (boringThenInteresting) =
if DontPromptForDependencies `elem` opts
then spanFL (not.(crit whichch opts).tpPatch) unskipped
else NilFL :> unskipped
case boringThenInteresting of
boring :> interesting -> do
let numNotConsidered = lengthFL boring + numSkipped
text_select splitter jobname whichch crit opts n_max (n + numNotConsidered)
(reverseFL boring +<+ reverseFL skipped +<+ ps_done) interesting pc
where
numSkipped = lengthFL skipped
show_skipped = do putStrLn $ _doing_ ++ _with_ ++ "."
when (Verbose `elem` opts) $ showskippedpatch skipped
where
_doing_ = _action_ ++ " " ++ jobname
_with_ = " of " ++ show numSkipped ++ " " ++ _elem_ ""
_action_ = if (length jobaction) == 0 then "Skipped" else jobaction
_elem_ = englishNum numSkipped jobelement
showskippedpatch :: Patchy p => FL (TaggedPatch p) C(y t) -> IO ()
showskippedpatch (tp:>:tps) = (putDocLn $ prefix " " $ summary (tpPatch tp)) >> showskippedpatch tps
showskippedpatch NilFL = return ()
decided :: Slot -> Bool
decided InMiddle = False
decided _ = True
get_default :: Bool -> Slot -> Char
get_default _ InMiddle = 'w'
get_default True InFirst = 'n'
get_default True InLast = 'y'
get_default False InFirst = 'y'
get_default False InLast = 'n'
tp_patches :: (FL (TaggedPatch p) :> FL (TaggedPatch p)) C(x y)
-> (FL p :> FL p) C(x y)
tp_patches (x:>y) = mapFL_FL tpPatch x :> mapFL_FL tpPatch y
filterOutConflicts :: RepoPatch p
=> [DarcsFlag]
-> RL (PatchInfoAnd p) C(x r)
-> Repository p C(r u t)
-> FL (PatchInfoAnd p) C(x z)
-> IO (Bool, Sealed (FL (PatchInfoAnd p) C(x)))
filterOutConflicts opts us repository them
| SkipConflicts `elem` opts
= do let commuter = commuterIdRL selfCommuter
unrec <- fmap n2pia . (anonymous . fromPrims) =<< unrecordedChanges [] repository []
them' :> rest <- return $ partitionConflictingFL commuter them (unrec :<: us)
return (check rest, Sealed them')
| otherwise
= return (False, Sealed them)
where check :: FL p C(a b) -> Bool
check NilFL = False
check _ = True