-- 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.

{-# LANGUAGE RecordWildCards #-}
module Darcs.UI.SelectChanges
    ( -- * Working with changes
      WhichChanges(..)
    , viewChanges
    , withSelectedPatchFromList
    , runSelection
    , runInvertibleSelection
    , selectionConfigPrim
    , selectionConfigGeneric
    , selectionConfig
    , SelectionConfig(allowSkipAll)
    -- * Interactive selection utils
    , PatchSelectionOptions(..)
    , InteractiveSelectionM
    , InteractiveSelectionState(..)
    , initialSelectionState
    -- ** Navigating the patchset
    , currentPatch
    , skipMundane
    , skipOne
    , backOne
    , backAll
    -- ** Decisions
    , decide
    , decideWholeFile
    -- ** Prompts and queries
    , isSingleFile
    , currentFile
    , promptUser
    , prompt
    , KeyPress(..)
    , keysFor
    , helpFor
    , askAboutDepends
    ) where

import Darcs.Prelude

import Control.Monad ( liftM, unless, when, (>=>) )
import Control.Monad.Identity ( Identity (..) )
import Control.Monad.Reader
    ( ReaderT
    , asks
    , runReaderT
    )
import Control.Monad.State
    ( StateT, execStateT, gets
    , modify, runStateT, state
    )
import Control.Monad.Trans ( liftIO )
import Data.List ( intercalate, union, (\\) )
import Data.Maybe ( isJust )
import System.Exit ( exitSuccess )

import Darcs.Patch
    ( RepoPatch, PrimOf
    , commuteFL, invert
    , listTouchedFiles
    )
import qualified Darcs.Patch ( thing, things )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Choices
    ( PatchChoices, Slot (..), LabelledPatch
    , forceFirst, forceLast, forceMatchingFirst
    , forceMatchingLast, getChoices
    , makeEverythingLater, makeEverythingSooner
    , forceMiddle, patchChoices
    , patchSlot
    , refineChoices, selectAllMiddles
    , separateFirstFromMiddleLast
    , substitute, label, unLabel
    , labelPatches
    )
import Darcs.Patch.Commute ( Commute )
import Darcs.Patch.Ident ( Ident(..), PatchId )
import Darcs.Patch.Info ( PatchInfo )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.Invert ( Invert )
import Darcs.Patch.Invertible
import Darcs.Patch.Match
    ( Matchable
    , MatchableRP
    , haveNonrangeMatch
    , matchAPatch
    )
import Darcs.Patch.Named ( adddeps, anonymous )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, n2pia )
import Darcs.Patch.Permutations ( commuteWhatWeCanRL )
import Darcs.Patch.Show ( ShowPatch, ShowContextPatch )
import Darcs.Patch.Split ( Splitter(..) )
import Darcs.Patch.TouchesFiles ( selectNotTouching, deselectNotTouching )
import Darcs.Patch.Witnesses.Ordered
    ( (:>) (..), (:||:) (..), FL (..)
    , RL (..), filterFL, lengthFL, mapFL
    , mapFL_FL, spanFL, spanFL_M
    , (+>+), (+<<+)
    , reverseFL, reverseRL
    )
import Darcs.Patch.Witnesses.Sealed
    ( FlippedSeal (..), Sealed2 (..)
    , seal2, unseal2
    )
import Darcs.Patch.Witnesses.WZipper
    ( FZipper (..), focus, jokers, left, right
    , rightmost, toEnd, toStart
    )
import Darcs.UI.External ( editText )
import Darcs.UI.Options.All
    ( Verbosity(..), WithSummary(..)
    , SelectDeps(..), MatchFlag )
import Darcs.UI.PrintPatch
    ( printContent
    , printContentWithPager
    , printFriendly
    , printSummary
    , showFriendly
    )
import Darcs.Util.English ( Noun (..), englishNum, capitalize )
import Darcs.Util.Path ( AnchoredPath )
import Darcs.Util.Printer ( putDocLnWith, greenText, vcat )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Prompt ( PromptConfig (..), promptYorn, promptChar )
import Darcs.Util.Tree ( Tree )


-- | When asking about patches, we either ask about them in
-- oldest-first or newest first (with respect to the current ordering
-- of the repository), and we either want an initial segment or a
-- final segment of the poset of patches.
--
-- 'First': ask for an initial
-- segment, first patches first (default for all pull-like commands)
--
-- 'FirstReversed': ask for an initial segment, last patches first
-- (used to ask about dependencies in record, and for pull-like
-- commands with the @--reverse@ flag).
--
-- 'LastReversed': ask for a final segment, last patches first. (default
-- for unpull-like commands, except for selecting *primitive* patches in
-- rollback)
--
-- 'Last': ask for a final segment, first patches first. (used for selecting
-- primitive patches in rollback, and for unpull-like commands with the
-- @--reverse@ flag
--
-- IOW: First = initial segment
--      Last = final segment
--      Reversed = start with the newest patch instead of oldest
-- As usual, terminology is not, ahem, very intuitive.
data WhichChanges = Last | LastReversed | First | FirstReversed deriving (WhichChanges -> WhichChanges -> Bool
(WhichChanges -> WhichChanges -> Bool)
-> (WhichChanges -> WhichChanges -> Bool) -> Eq WhichChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhichChanges -> WhichChanges -> Bool
== :: WhichChanges -> WhichChanges -> Bool
$c/= :: WhichChanges -> WhichChanges -> Bool
/= :: WhichChanges -> WhichChanges -> Bool
Eq, Int -> WhichChanges -> ShowS
[WhichChanges] -> ShowS
WhichChanges -> String
(Int -> WhichChanges -> ShowS)
-> (WhichChanges -> String)
-> ([WhichChanges] -> ShowS)
-> Show WhichChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhichChanges -> ShowS
showsPrec :: Int -> WhichChanges -> ShowS
$cshow :: WhichChanges -> String
show :: WhichChanges -> String
$cshowList :: [WhichChanges] -> ShowS
showList :: [WhichChanges] -> ShowS
Show)

-- | A 'WhichChanges' is 'backward' if the segment of patches we ask for
-- is at the opposite end of where we start to present them.
backward :: WhichChanges -> Bool
backward :: WhichChanges -> Bool
backward WhichChanges
w = WhichChanges
w WhichChanges -> WhichChanges -> Bool
forall a. Eq a => a -> a -> Bool
== WhichChanges
Last Bool -> Bool -> Bool
|| WhichChanges
w WhichChanges -> WhichChanges -> Bool
forall a. Eq a => a -> a -> Bool
== WhichChanges
FirstReversed

-- | A 'WhichChanges' is reversed if the order in which patches are presented
-- is latest (or newest) patch first.
reversed :: WhichChanges -> Bool
reversed :: WhichChanges -> Bool
reversed WhichChanges
w = WhichChanges
w WhichChanges -> WhichChanges -> Bool
forall a. Eq a => a -> a -> Bool
== WhichChanges
LastReversed Bool -> Bool -> Bool
|| WhichChanges
w WhichChanges -> WhichChanges -> Bool
forall a. Eq a => a -> a -> Bool
== WhichChanges
FirstReversed

-- | The type of the function we use to filter patches when @--match@ is
-- given.
data MatchCriterion p = MatchCriterion
   { forall (p :: * -> * -> *). MatchCriterion p -> Bool
mcHasNonrange :: Bool
   , forall (p :: * -> * -> *).
MatchCriterion p -> forall wA wB. p wA wB -> Bool
mcFunction :: forall wA wB. p wA wB -> Bool
   }

data PatchSelectionOptions = PatchSelectionOptions
  { PatchSelectionOptions -> Verbosity
verbosity :: Verbosity
  , PatchSelectionOptions -> [MatchFlag]
matchFlags :: [MatchFlag]
  , PatchSelectionOptions -> Bool
interactive :: Bool
  , PatchSelectionOptions -> SelectDeps
selectDeps :: SelectDeps
  , PatchSelectionOptions -> WithSummary
withSummary :: WithSummary
  }

-- | All the static settings for selecting patches.
data SelectionConfig p =
  PSC { forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts :: PatchSelectionOptions
      , forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
splitter :: Maybe (Splitter p)
      , forall (p :: * -> * -> *).
SelectionConfig p -> Maybe [AnchoredPath]
files :: Maybe [AnchoredPath]
      , forall (p :: * -> * -> *). SelectionConfig p -> MatchCriterion p
matchCriterion :: MatchCriterion p
      , forall (p :: * -> * -> *). SelectionConfig p -> String
jobname :: String
      , forall (p :: * -> * -> *). SelectionConfig p -> Bool
allowSkipAll :: Bool
      , forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges :: WhichChanges
      }

-- | A 'SelectionConfig' for selecting 'Prim' patches.
selectionConfigPrim :: WhichChanges
                    -> String
                    -> PatchSelectionOptions
                    -> Maybe (Splitter prim)
                    -> Maybe [AnchoredPath]
                    -> SelectionConfig prim
selectionConfigPrim :: forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> SelectionConfig prim
selectionConfigPrim WhichChanges
whch String
jn PatchSelectionOptions
o Maybe (Splitter prim)
spl Maybe [AnchoredPath]
fs =
 PSC { opts :: PatchSelectionOptions
opts = PatchSelectionOptions
o
     , splitter :: Maybe (Splitter prim)
splitter = Maybe (Splitter prim)
spl
     , files :: Maybe [AnchoredPath]
files = Maybe [AnchoredPath]
fs
     , matchCriterion :: MatchCriterion prim
matchCriterion = MatchCriterion prim
forall (p :: * -> * -> *). MatchCriterion p
triv
     , jobname :: String
jobname = String
jn
     , allowSkipAll :: Bool
allowSkipAll = Bool
True
     , whichChanges :: WhichChanges
whichChanges = WhichChanges
whch
     }

-- | A 'SelectionConfig' for selecting full ('Matchable') patches
selectionConfig :: Matchable p
                 => WhichChanges
                 -> String
                 -> PatchSelectionOptions
                 -> Maybe (Splitter p)
                 -> Maybe [AnchoredPath]
                 -> SelectionConfig p
selectionConfig :: forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
whch String
jn PatchSelectionOptions
o Maybe (Splitter p)
spl Maybe [AnchoredPath]
fs =
 PSC { opts :: PatchSelectionOptions
opts = PatchSelectionOptions
o
     , splitter :: Maybe (Splitter p)
splitter = Maybe (Splitter p)
spl
     , files :: Maybe [AnchoredPath]
files = Maybe [AnchoredPath]
fs
     , matchCriterion :: MatchCriterion p
matchCriterion = (forall wX wY. p wX wY -> Sealed2 p)
-> [MatchFlag] -> MatchCriterion p
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> [MatchFlag] -> MatchCriterion q
iswanted p wX wY -> Sealed2 p
forall wX wY. p wX wY -> Sealed2 p
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 (PatchSelectionOptions -> [MatchFlag]
matchFlags PatchSelectionOptions
o)
     , jobname :: String
jobname = String
jn
     , allowSkipAll :: Bool
allowSkipAll = Bool
True
     , whichChanges :: WhichChanges
whichChanges = WhichChanges
whch
     }

-- | A generic 'SelectionConfig'.
selectionConfigGeneric :: Matchable p
                       => (forall wX wY . q wX wY -> Sealed2 p)
                       -> WhichChanges
                       -> String
                       -> PatchSelectionOptions
                       -> Maybe [AnchoredPath]
                       -> SelectionConfig q
selectionConfigGeneric :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric forall wX wY. q wX wY -> Sealed2 p
extract WhichChanges
whch String
jn PatchSelectionOptions
o Maybe [AnchoredPath]
fs =
 PSC { opts :: PatchSelectionOptions
opts = PatchSelectionOptions
o
     , splitter :: Maybe (Splitter q)
splitter = Maybe (Splitter q)
forall a. Maybe a
Nothing
     , files :: Maybe [AnchoredPath]
files = Maybe [AnchoredPath]
fs
     , matchCriterion :: MatchCriterion q
matchCriterion = (forall wX wY. q wX wY -> Sealed2 p)
-> [MatchFlag] -> MatchCriterion q
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> [MatchFlag] -> MatchCriterion q
iswanted q wX wY -> Sealed2 p
forall wX wY. q wX wY -> Sealed2 p
extract (PatchSelectionOptions -> [MatchFlag]
matchFlags PatchSelectionOptions
o)
     , jobname :: String
jobname = String
jn
     , allowSkipAll :: Bool
allowSkipAll = Bool
True
     , whichChanges :: WhichChanges
whichChanges = WhichChanges
whch
     }

-- | The dynamic parameters for interactive selection of patches.
data InteractiveSelectionState p wX wY =
 ISC { forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> Int
total :: Int                           -- ^ total number of patches
     , forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> Int
current :: Int                         -- ^ number of already-seen patches
     , forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps :: FZipper (LabelledPatch p) wX wY -- ^ the patches we offer
     , forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices :: PatchChoices p wX wY        -- ^ the user's choices
     }

type PatchSelectionM p a = ReaderT (SelectionConfig p) a

type InteractiveSelectionM p wX wY a =
    StateT (InteractiveSelectionState p wX wY)
           (PatchSelectionM p IO) a

-- Common match criteria

-- | For commands without @--match@, 'triv' matches all patches
triv :: MatchCriterion p
triv :: forall (p :: * -> * -> *). MatchCriterion p
triv = MatchCriterion { mcHasNonrange :: Bool
mcHasNonrange = Bool
False, mcFunction :: forall wA wB. p wA wB -> Bool
mcFunction = \ p wA wB
_ -> Bool
True }

-- | 'iswanted' selects patches according to the given match flags
iswanted :: Matchable p
         => (forall wX wY . q wX wY -> Sealed2 p)
         -> [MatchFlag]
         -> MatchCriterion q
iswanted :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> [MatchFlag] -> MatchCriterion q
iswanted forall wX wY. q wX wY -> Sealed2 p
extract [MatchFlag]
mflags = MatchCriterion
    { mcHasNonrange :: Bool
mcHasNonrange = [MatchFlag] -> Bool
haveNonrangeMatch [MatchFlag]
mflags
    , mcFunction :: forall wA wB. q wA wB -> Bool
mcFunction = (forall wX wY. p wX wY -> Bool) -> Sealed2 p -> Bool
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 ([MatchFlag] -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
mflags) (Sealed2 p -> Bool) -> (q wA wB -> Sealed2 p) -> q wA wB -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q wA wB -> Sealed2 p
forall wX wY. q wX wY -> Sealed2 p
extract
    }

-- | Run a 'PatchSelection' action in the given 'SelectionConfig',
-- without assuming that patches are invertible.
runSelection :: ( MatchableRP p, ShowPatch p, ShowContextPatch p
                , ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)
                )
             => FL p wX wY
             -> SelectionConfig p
             -> IO ((FL p :> FL p) wX wY)
runSelection :: forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL p wX wY
_ PSC { splitter :: forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
splitter = Just Splitter p
_ } =
  -- a Splitter makes sense for prim patches only and these are invertible anyway
  String -> IO ((:>) (FL p) (FL p) wX wY)
forall a. HasCallStack => String -> a
error String
"cannot use runSelection with Splitter"
runSelection FL p wX wY
ps PSC { matchCriterion :: forall (p :: * -> * -> *). SelectionConfig p -> MatchCriterion p
matchCriterion = MatchCriterion p
mc, Bool
String
Maybe [AnchoredPath]
Maybe (Splitter p)
PatchSelectionOptions
WhichChanges
allowSkipAll :: forall (p :: * -> * -> *). SelectionConfig p -> Bool
opts :: forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
splitter :: forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
files :: forall (p :: * -> * -> *).
SelectionConfig p -> Maybe [AnchoredPath]
jobname :: forall (p :: * -> * -> *). SelectionConfig p -> String
whichChanges :: forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
opts :: PatchSelectionOptions
splitter :: Maybe (Splitter p)
files :: Maybe [AnchoredPath]
jobname :: String
allowSkipAll :: Bool
whichChanges :: WhichChanges
.. } = do
    (:>) (FL (Invertible p)) (FL (Invertible p)) wX wY
-> (:>) (FL p) (FL p) wX wY
forall {b :: * -> * -> *} {b :: * -> * -> *} {wX} {wY}.
(:>) (FL (Invertible b)) (FL (Invertible b)) wX wY
-> (:>) (FL b) (FL b) wX wY
unwrapOutput ((:>) (FL (Invertible p)) (FL (Invertible p)) wX wY
 -> (:>) (FL p) (FL p) wX wY)
-> IO ((:>) (FL (Invertible p)) (FL (Invertible p)) wX wY)
-> IO ((:>) (FL p) (FL p) wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FL (Invertible p) wX wY
-> SelectionConfig (Invertible p)
-> IO ((:>) (FL (Invertible p)) (FL (Invertible p)) wX wY)
forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection (FL p wX wY -> FL (Invertible p) wX wY
forall {a :: * -> * -> *} {wX} {wZ}.
FL a wX wZ -> FL (Invertible a) wX wZ
wrapInput FL p wX wY
ps) SelectionConfig (Invertible p)
ictx
  where
    convertMC :: MatchCriterion p -> MatchCriterion (Invertible p)
    convertMC :: forall (p :: * -> * -> *).
MatchCriterion p -> MatchCriterion (Invertible p)
convertMC MatchCriterion { mcFunction :: forall (p :: * -> * -> *).
MatchCriterion p -> forall wA wB. p wA wB -> Bool
mcFunction = forall wA wB. p wA wB -> Bool
mcf, Bool
mcHasNonrange :: forall (p :: * -> * -> *). MatchCriterion p -> Bool
mcHasNonrange :: Bool
.. } =
      MatchCriterion { mcFunction :: forall wA wB. Invertible p wA wB -> Bool
mcFunction = (forall wA wB. p wA wB -> Bool) -> Invertible p wA wB -> Bool
forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible p wA wB -> Bool
forall wA wB. p wA wB -> Bool
mcf, Bool
mcHasNonrange :: Bool
mcHasNonrange :: Bool
.. }
    ictx :: SelectionConfig (Invertible p)
ictx = PSC { matchCriterion :: MatchCriterion (Invertible p)
matchCriterion = MatchCriterion p -> MatchCriterion (Invertible p)
forall (p :: * -> * -> *).
MatchCriterion p -> MatchCriterion (Invertible p)
convertMC MatchCriterion p
mc, splitter :: Maybe (Splitter (Invertible p))
splitter = Maybe (Splitter (Invertible p))
forall a. Maybe a
Nothing, Bool
String
Maybe [AnchoredPath]
PatchSelectionOptions
WhichChanges
allowSkipAll :: Bool
opts :: PatchSelectionOptions
files :: Maybe [AnchoredPath]
jobname :: String
whichChanges :: WhichChanges
opts :: PatchSelectionOptions
files :: Maybe [AnchoredPath]
jobname :: String
allowSkipAll :: Bool
whichChanges :: WhichChanges
.. }
    wrapInput :: FL a wX wZ -> FL (Invertible a) wX wZ
wrapInput = (forall wW wY. a wW wY -> Invertible a wW wY)
-> FL a wX wZ -> FL (Invertible a) wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL a wW wY -> Invertible a wW wY
forall wW wY. a wW wY -> Invertible a wW wY
forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
mkInvertible
    unwrapOutput :: (:>) (FL (Invertible b)) (FL (Invertible b)) wX wY
-> (:>) (FL b) (FL b) wX wY
unwrapOutput (FL (Invertible b) wX wZ
xs :> FL (Invertible b) wZ wY
ys) =
      (forall wW wY. Invertible b wW wY -> b wW wY)
-> FL (Invertible b) wX wZ -> FL b wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL Invertible b wW wY -> b wW wY
forall wW wY. Invertible b wW wY -> b wW wY
forall (p :: * -> * -> *) wX wY. Invertible p wX wY -> p wX wY
fromPositiveInvertible FL (Invertible b) wX wZ
xs FL b wX wZ -> FL b wZ wY -> (:>) (FL b) (FL b) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wW wY. Invertible b wW wY -> b wW wY)
-> FL (Invertible b) wZ wY -> FL b wZ wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL Invertible b wW wY -> b wW wY
forall wW wY. Invertible b wW wY -> b wW wY
forall (p :: * -> * -> *) wX wY. Invertible p wX wY -> p wX wY
fromPositiveInvertible FL (Invertible b) wZ wY
ys

-- | Run a 'PatchSelection' action in the given 'SelectionConfig',
-- assuming patches are invertible.
runInvertibleSelection :: forall p wX wY .
                          ( Invert p, MatchableRP p, ShowPatch p
                          , ShowContextPatch p, ApplyState p ~ Tree
                          )
                       => FL p wX wY
                       -> SelectionConfig p
                       -> IO ((FL p :> FL p) wX wY)
runInvertibleSelection :: forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection FL p wX wY
ps SelectionConfig p
psc = ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
-> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (FL p wX wY
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
forall {wY} {wX}.
FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
selection FL p wX wY
ps) SelectionConfig p
psc where
  selection :: FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
selection
    | WhichChanges -> Bool
reversed WhichChanges
whch = ((:>) (FL p) (FL p) wX wY -> (:>) (FL p) (FL p) wY wX)
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
forall a b.
(a -> b)
-> ReaderT (SelectionConfig p) IO a
-> ReaderT (SelectionConfig p) IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:>) (FL p) (FL p) wX wY -> (:>) (FL p) (FL p) wY wX
forall wX wY. (:>) (FL p) (FL p) wX wY -> (:>) (FL p) (FL p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
 -> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX))
-> (FL p wY wX
    -> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY))
-> FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL p wX wY
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
forall {wY} {wX}.
FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
doit (FL p wX wY
 -> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY))
-> (FL p wY wX -> FL p wX wY)
-> FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL p wY wX -> FL p wX wY
forall wX wY. FL p wX wY -> FL p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert
    | Bool
otherwise = FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
forall {wY} {wX}.
FL p wY wX
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wY wX)
doit
  -- efficiency note: we should first filterUnwanted to apply matchers,
  -- as this often requires to read only metadata; then filterNotTouching
  -- applies path restrictions which needs to read patch contents
  doit :: FL p wA wB
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wA wB)
doit =
    (PatchChoices p wA wB -> (:>) (FL p) (FL p) wA wB)
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wA wB)
forall a b.
(a -> b)
-> ReaderT (SelectionConfig p) IO a
-> ReaderT (SelectionConfig p) IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((:>) (FL p) (FL p) wA wB -> (:>) (FL p) (FL p) wA wB
forall wA wB. (:>) (FL p) (FL p) wA wB -> (:>) (FL p) (FL p) wA wB
canonizeAfterSplitter ((:>) (FL p) (FL p) wA wB -> (:>) (FL p) (FL p) wA wB)
-> (PatchChoices p wA wB -> (:>) (FL p) (FL p) wA wB)
-> PatchChoices p wA wB
-> (:>) (FL p) (FL p) wA wB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wA wB -> (:>) (FL p) (FL p) wA wB
forall wA wB. PatchChoices p wA wB -> (:>) (FL p) (FL p) wA wB
selectedPatches) (ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
 -> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wA wB))
-> (FL p wA wB
    -> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB))
-> FL p wA wB
-> ReaderT (SelectionConfig p) IO ((:>) (FL p) (FL p) wA wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    PatchChoices p wA wB
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
forall wA wB.
PatchChoices p wA wB -> PatchSelectionM p IO (PatchChoices p wA wB)
selectChanges (PatchChoices p wA wB
 -> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB))
-> (FL p wA wB -> PatchChoices p wA wB)
-> FL p wA wB
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
filterNotTouching (PatchChoices p wA wB -> PatchChoices p wA wB)
-> (FL p wA wB -> PatchChoices p wA wB)
-> FL p wA wB
-> PatchChoices p wA wB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
filterUnwanted (PatchChoices p wA wB -> PatchChoices p wA wB)
-> (FL p wA wB -> PatchChoices p wA wB)
-> FL p wA wB
-> PatchChoices p wA wB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL p wA wB -> PatchChoices p wA wB
forall (p :: * -> * -> *) wX wY. FL p wX wY -> PatchChoices p wX wY
patchChoices

  -- configuration
  whch :: WhichChanges
whch = SelectionConfig p -> WhichChanges
forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges SelectionConfig p
psc
  fs :: Maybe [AnchoredPath]
fs = SelectionConfig p -> Maybe [AnchoredPath]
forall (p :: * -> * -> *).
SelectionConfig p -> Maybe [AnchoredPath]
files SelectionConfig p
psc
  os :: PatchSelectionOptions
os = SelectionConfig p -> PatchSelectionOptions
forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts SelectionConfig p
psc
  crit :: MatchCriterion p
crit = SelectionConfig p -> MatchCriterion p
forall (p :: * -> * -> *). SelectionConfig p -> MatchCriterion p
matchCriterion SelectionConfig p
psc
  mspl :: Maybe (Splitter p)
mspl = SelectionConfig p -> Maybe (Splitter p)
forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
splitter SelectionConfig p
psc

  -- after selecting with a splitter, the results may not be canonical
  canonizeAfterSplitter :: (FL p :> FL p) wA wB -> (FL p :> FL p) wA wB
  canonizeAfterSplitter :: forall wA wB. (:>) (FL p) (FL p) wA wB -> (:>) (FL p) (FL p) wA wB
canonizeAfterSplitter (FL p wA wZ
x :> FL p wZ wB
y) =
    let
      canonizeIfNeeded :: FL p wX wY -> FL p wX wY
canonizeIfNeeded =
        case Maybe (Splitter p)
mspl of
          Just Splitter p
s -> Splitter p -> forall wX wY. FL p wX wY -> FL p wX wY
forall (p :: * -> * -> *).
Splitter p -> forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit Splitter p
s
          Maybe (Splitter p)
Nothing -> FL p wX wY -> FL p wX wY
forall a. a -> a
id
    in FL p wA wZ -> FL p wA wZ
forall wX wY. FL p wX wY -> FL p wX wY
canonizeIfNeeded FL p wA wZ
x FL p wA wZ -> FL p wZ wB -> (:>) (FL p) (FL p) wA wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wZ wB -> FL p wZ wB
forall wX wY. FL p wX wY -> FL p wX wY
canonizeIfNeeded FL p wZ wB
y

  -- retrieve the results of patch selection
  selectedPatches :: PatchChoices p wA wB -> (FL p :> FL p) wA wB
  selectedPatches :: forall wA wB. PatchChoices p wA wB -> (:>) (FL p) (FL p) wA wB
selectedPatches PatchChoices p wA wB
pc
    | WhichChanges -> Bool
backward WhichChanges
whch =
        case PatchChoices p wA wB
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wA
     wB
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wX
     wY
getChoices PatchChoices p wA wB
pc of
          FL (LabelledPatch p) wA wZ
fc :> FL (LabelledPatch p) wZ wZ
mc :> FL (LabelledPatch p) wZ wB
lc -> (forall wW wY. LabelledPatch p wW wY -> p wW wY)
-> FL (LabelledPatch p) wA wZ -> FL p wA wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL LabelledPatch p wW wY -> p wW wY
forall wW wY. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel (FL (LabelledPatch p) wA wZ
fc FL (LabelledPatch p) wA wZ
-> FL (LabelledPatch p) wZ wZ -> FL (LabelledPatch p) wA wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (LabelledPatch p) wZ wZ
mc) FL p wA wZ -> FL p wZ wB -> (:>) (FL p) (FL p) wA wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wW wY. LabelledPatch p wW wY -> p wW wY)
-> FL (LabelledPatch p) wZ wB -> FL p wZ wB
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL LabelledPatch p wW wY -> p wW wY
forall wW wY. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel FL (LabelledPatch p) wZ wB
lc
    | Bool
otherwise =
        case PatchChoices p wA wB
-> (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wA wB
forall (p :: * -> * -> *) wX wZ.
PatchChoices p wX wZ
-> (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wX wZ
separateFirstFromMiddleLast PatchChoices p wA wB
pc of
          FL (LabelledPatch p) wA wZ
xs :> FL (LabelledPatch p) wZ wB
ys -> (forall wW wY. LabelledPatch p wW wY -> p wW wY)
-> FL (LabelledPatch p) wA wZ -> FL p wA wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL LabelledPatch p wW wY -> p wW wY
forall wW wY. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel FL (LabelledPatch p) wA wZ
xs FL p wA wZ -> FL p wZ wB -> (:>) (FL p) (FL p) wA wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wW wY. LabelledPatch p wW wY -> p wW wY)
-> FL (LabelledPatch p) wZ wB -> FL p wZ wB
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL LabelledPatch p wW wY -> p wW wY
forall wW wY. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel FL (LabelledPatch p) wZ wB
ys

  selectChanges :: PatchChoices p wA wB
                -> PatchSelectionM p IO (PatchChoices p wA wB)
  selectChanges :: forall wA wB.
PatchChoices p wA wB -> PatchSelectionM p IO (PatchChoices p wA wB)
selectChanges
    | PatchSelectionOptions -> Bool
interactive PatchSelectionOptions
os = (forall wU wV.
 FL (LabelledPatch p) wU wV
 -> PatchChoices p wU wV
 -> ReaderT (SelectionConfig p) IO (PatchChoices p wU wV))
-> PatchChoices p wA wB
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Commute p, Monad m) =>
(forall wU wV.
 FL (LabelledPatch p) wU wV
 -> PatchChoices p wU wV -> m (PatchChoices p wU wV))
-> PatchChoices p wX wY -> m (PatchChoices p wX wY)
refineChoices FL (LabelledPatch p) wU wV
-> PatchChoices p wU wV
-> PatchSelectionM p IO (PatchChoices p wU wV)
forall wU wV.
FL (LabelledPatch p) wU wV
-> PatchChoices p wU wV
-> ReaderT (SelectionConfig p) IO (PatchChoices p wU wV)
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, ShowPatch p, ShowContextPatch p,
 PatchInspect p, ApplyState p ~ Tree) =>
FL (LabelledPatch p) wX wY
-> PatchChoices p wX wY
-> PatchSelectionM p IO (PatchChoices p wX wY)
textSelect
    | Bool
otherwise      = PatchChoices p wA wB
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
forall a. a -> ReaderT (SelectionConfig p) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchChoices p wA wB
 -> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB))
-> (PatchChoices p wA wB -> PatchChoices p wA wB)
-> PatchChoices p wA wB
-> ReaderT (SelectionConfig p) IO (PatchChoices p wA wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
promote

  promote :: PatchChoices p wX wY -> PatchChoices p wX wY
promote
    | WhichChanges -> Bool
backward WhichChanges
whch = PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
PatchChoices p wX wY -> PatchChoices p wX wY
makeEverythingLater
    | Bool
otherwise     = PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY -> PatchChoices p wX wY
makeEverythingSooner
  demote :: PatchChoices p wX wY -> PatchChoices p wX wY
demote
    | WhichChanges -> Bool
backward WhichChanges
whch = PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY -> PatchChoices p wX wY
makeEverythingSooner
    | Bool
otherwise     = PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
PatchChoices p wX wY -> PatchChoices p wX wY
makeEverythingLater

  filterNotTouching :: PatchChoices p wX wY -> PatchChoices p wX wY
filterNotTouching
    | WhichChanges -> Bool
backward WhichChanges
whch = Maybe [AnchoredPath]
-> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [AnchoredPath]
-> PatchChoices p wX wY -> PatchChoices p wX wY
selectNotTouching Maybe [AnchoredPath]
fs
    | Bool
otherwise     = Maybe [AnchoredPath]
-> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [AnchoredPath]
-> PatchChoices p wX wY -> PatchChoices p wX wY
deselectNotTouching Maybe [AnchoredPath]
fs

  -- when using @--match@, remove unmatched patches
  -- not depended upon by matched patches
  filterUnwanted :: PatchChoices p wA wB -> PatchChoices p wA wB
  filterUnwanted :: forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
filterUnwanted
    | MatchCriterion p -> Bool
forall (p :: * -> * -> *). MatchCriterion p -> Bool
mcHasNonrange MatchCriterion p
crit =
        case PatchSelectionOptions -> SelectDeps
selectDeps PatchSelectionOptions
os of
          SelectDeps
NoDeps -> PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
deselectUnwanted
          SelectDeps
_      -> PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
demote (PatchChoices p wA wB -> PatchChoices p wA wB)
-> (PatchChoices p wA wB -> PatchChoices p wA wB)
-> PatchChoices p wA wB
-> PatchChoices p wA wB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wA wB -> PatchChoices p wA wB
forall {wX} {wY}. PatchChoices p wX wY -> PatchChoices p wX wY
selectWanted
    | Bool
otherwise = PatchChoices p wA wB -> PatchChoices p wA wB
forall a. a -> a
id

  selectWanted :: PatchChoices p wA wB -> PatchChoices p wA wB
selectWanted
    | WhichChanges -> Bool
backward WhichChanges
whch = (forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forall (p :: * -> * -> *) wA wB.
Commute p =>
(forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forceMatchingLast LabelledPatch p wX wY -> Bool
forall wX wY. LabelledPatch p wX wY -> Bool
iswanted_
    | Bool
otherwise     = (forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forall (p :: * -> * -> *) wA wB.
Commute p =>
(forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forceMatchingFirst LabelledPatch p wX wY -> Bool
forall wX wY. LabelledPatch p wX wY -> Bool
iswanted_
  deselectUnwanted :: PatchChoices p wA wB -> PatchChoices p wA wB
deselectUnwanted
    | WhichChanges -> Bool
backward WhichChanges
whch = (forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forall (p :: * -> * -> *) wA wB.
Commute p =>
(forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forceMatchingFirst (Bool -> Bool
not (Bool -> Bool)
-> (LabelledPatch p wX wY -> Bool) -> LabelledPatch p wX wY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wX wY -> Bool
forall wX wY. LabelledPatch p wX wY -> Bool
iswanted_)
    | Bool
otherwise     = (forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forall (p :: * -> * -> *) wA wB.
Commute p =>
(forall wX wY. LabelledPatch p wX wY -> Bool)
-> PatchChoices p wA wB -> PatchChoices p wA wB
forceMatchingLast (Bool -> Bool
not (Bool -> Bool)
-> (LabelledPatch p wX wY -> Bool) -> LabelledPatch p wX wY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wX wY -> Bool
forall wX wY. LabelledPatch p wX wY -> Bool
iswanted_)
  iswanted_ :: LabelledPatch p wA wB -> Bool
iswanted_ = MatchCriterion p -> forall wA wB. p wA wB -> Bool
forall (p :: * -> * -> *).
MatchCriterion p -> forall wA wB. p wA wB -> Bool
mcFunction MatchCriterion p
crit (p wA wB -> Bool)
-> (LabelledPatch p wA wB -> p wA wB)
-> LabelledPatch p wA wB
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wA wB -> p wA wB
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel

  {- end of runInvertibleSelection -}

-- | The equivalent of 'runSelection' for the @darcs log@ command
viewChanges :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
            => PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges :: forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges PatchSelectionOptions
ps_opts = PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
ps_opts Maybe Int
forall a. Maybe a
Nothing Int
0 []

-- | The type of the answers to a "shall I [wiggle] that [foo]?" question
-- They are found in a [[KeyPress]] bunch, each list representing a set of
-- answers which belong together
data KeyPress = KeyPress { KeyPress -> Char
kp     :: Char
                           , KeyPress -> String
kpHelp :: String }

-- | Generates the help for a set of basic and advanced 'KeyPress' groups.
helpFor :: String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor :: String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor String
jn [[KeyPress]]
basicKeypresses [[KeyPress]]
advancedKeyPresses =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"How to use "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
":" ]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] (([KeyPress] -> [String]) -> [[KeyPress]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((KeyPress -> String) -> [KeyPress] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map KeyPress -> String
help) [[KeyPress]]
keypresses)
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
""
               , String
"?: show this help"
               , String
""
               , String
"<Space>: accept the current default (which is capitalized)"
               ]
  where help :: KeyPress -> String
help KeyPress
i = KeyPress -> Char
kp KeyPress
iChar -> ShowS
forall a. a -> [a] -> [a]
:(String
": "String -> ShowS
forall a. [a] -> [a] -> [a]
++KeyPress -> String
kpHelp KeyPress
i)
        keypresses :: [[KeyPress]]
keypresses = [[KeyPress]]
basicKeypresses [[KeyPress]] -> [[KeyPress]] -> [[KeyPress]]
forall a. [a] -> [a] -> [a]
++ [[KeyPress]]
advancedKeyPresses

-- | The keys used by a list of 'keyPress' groups.
keysFor :: [[KeyPress]] -> [Char]
keysFor :: [[KeyPress]] -> String
keysFor = ([KeyPress] -> String) -> [[KeyPress]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((KeyPress -> Char) -> [KeyPress] -> String
forall a b. (a -> b) -> [a] -> [b]
map KeyPress -> Char
kp)

-- | The function for selecting a patch to amend record. Read at your own risks.
withSelectedPatchFromList
    :: (Commute p, Matchable p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
    => String   -- name of calling command (always "amend" as of now)
    -> RL p wX wY
    -> PatchSelectionOptions
    -> ((RL p :> p) wX wY -> IO ())
    -> IO ()
withSelectedPatchFromList :: forall (p :: * -> * -> *) wX wY.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> RL p wX wY
-> PatchSelectionOptions
-> ((:>) (RL p) p wX wY -> IO ())
-> IO ()
withSelectedPatchFromList String
jn RL p wX wY
patches PatchSelectionOptions
o (:>) (RL p) p wX wY -> IO ()
job = do
    Maybe ((:>) (RL p) p wX wY)
sp <- String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wY
-> IO (Maybe ((:>) (RL p) p wX wY))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn ([MatchFlag] -> p wA wB -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch ([MatchFlag] -> p wA wB -> Bool) -> [MatchFlag] -> p wA wB -> Bool
forall a b. (a -> b) -> a -> b
$ PatchSelectionOptions -> [MatchFlag]
matchFlags PatchSelectionOptions
o) RL p wX wY
patches FL (WithSkipped p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
    case Maybe ((:>) (RL p) p wX wY)
sp of
        Just (RL p wX wZ
skipped :> p wZ wY
selected') -> (:>) (RL p) p wX wY -> IO ()
job (RL p wX wZ
skipped RL p wX wZ -> p wZ wY -> (:>) (RL p) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
selected')
        Maybe ((:>) (RL p) p wX wY)
Nothing ->
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cancelling " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" since no patch was selected."

data SkippedReason = SkippedAutomatically | SkippedManually

data WithSkipped p wX wY = WithSkipped
    { forall (p :: * -> * -> *) wX wY.
WithSkipped p wX wY -> SkippedReason
_skippedReason :: SkippedReason
    , forall (p :: * -> * -> *) wX wY. WithSkipped p wX wY -> p wX wY
skippedPatch :: p wX wY
    }

-- | 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 :: forall p wX wY wZ.
         (Commute p, Matchable p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
      => String
      -> (forall wA wB . p wA wB -> Bool)
      -> RL p wX wY
      -> FL (WithSkipped p) wY wZ
      -> IO (Maybe ((RL p :> p) wX wZ))
wspfr :: forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
_ forall wA wB. p wA wB -> Bool
_ RL p wX wY
NilRL FL (WithSkipped p) wY wZ
_ = Maybe ((:>) (RL p) p wX wZ) -> IO (Maybe ((:>) (RL p) p wX wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ((:>) (RL p) p wX wZ)
forall a. Maybe a
Nothing
wspfr String
jn forall wA wB. p wA wB -> Bool
matches remaining :: RL p wX wY
remaining@(RL p wX wY
pps:<:p wY wY
p) FL (WithSkipped p) wY wZ
skipped
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ p wY wY -> Bool
forall wA wB. p wA wB -> Bool
matches p wY wY
p = String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn p wA wB -> Bool
forall wA wB. p wA wB -> Bool
matches RL p wX wY
pps
                            (SkippedReason -> p wY wY -> WithSkipped p wY wY
forall (p :: * -> * -> *) wX wY.
SkippedReason -> p wX wY -> WithSkipped p wX wY
WithSkipped SkippedReason
SkippedAutomatically p wY wY
p WithSkipped p wY wY
-> FL (WithSkipped p) wY wZ -> FL (WithSkipped p) wY wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WithSkipped p) wY wZ
skipped)
    | Bool
otherwise =
    case (:>) p (FL p) wY wZ -> Maybe ((:>) (FL p) p wY wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (p wY wY
p p wY wY -> FL p wY wZ -> (:>) p (FL p) wY wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wW wY. WithSkipped p wW wY -> p wW wY)
-> FL (WithSkipped p) wY wZ -> FL p wY wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL WithSkipped p wW wY -> p wW wY
forall wW wY. WithSkipped p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. WithSkipped p wX wY -> p wX wY
skippedPatch FL (WithSkipped p) wY wZ
skipped) of
    Maybe ((:>) (FL p) p wY wZ)
Nothing -> do String -> IO ()
putStrLn String
"\nSkipping depended-upon patch:"
                  p wY wY -> IO ()
forall {wX} {wY}. p wX wY -> IO ()
defaultPrintFriendly p wY wY
p
                  String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn p wA wB -> Bool
forall wA wB. p wA wB -> Bool
matches RL p wX wY
pps (SkippedReason -> p wY wY -> WithSkipped p wY wY
forall (p :: * -> * -> *) wX wY.
SkippedReason -> p wX wY -> WithSkipped p wX wY
WithSkipped SkippedReason
SkippedAutomatically p wY wY
p WithSkipped p wY wY
-> FL (WithSkipped p) wY wZ -> FL (WithSkipped p) wY wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WithSkipped p) wY wZ
skipped)

    Just (FL p wY wZ
skipped' :> p wZ wZ
p') -> do
        p wY wY -> IO ()
forall {wX} {wY}. p wX wY -> IO ()
defaultPrintFriendly p wY wY
p
        let repeatThis :: IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis = do
              Char
yorn <- PromptConfig -> IO Char
promptChar
                    PromptConfig { pPrompt :: String
pPrompt = String
prompt'
                                 , pBasicCharacters :: String
pBasicCharacters = [[KeyPress]] -> String
keysFor [[KeyPress]]
basicOptions
                                 , pAdvancedCharacters :: String
pAdvancedCharacters = [[KeyPress]] -> String
keysFor [[KeyPress]]
advancedOptions
                                 , pDefault :: Maybe Char
pDefault = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n'
                                 , pHelp :: String
pHelp = String
"?h" }
              case Char
yorn of
                Char
'y' -> Maybe ((:>) (RL p) p wX wZ) -> IO (Maybe ((:>) (RL p) p wX wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((:>) (RL p) p wX wZ) -> IO (Maybe ((:>) (RL p) p wX wZ)))
-> Maybe ((:>) (RL p) p wX wZ) -> IO (Maybe ((:>) (RL p) p wX wZ))
forall a b. (a -> b) -> a -> b
$ (:>) (RL p) p wX wZ -> Maybe ((:>) (RL p) p wX wZ)
forall a. a -> Maybe a
Just ((:>) (RL p) p wX wZ -> Maybe ((:>) (RL p) p wX wZ))
-> (:>) (RL p) p wX wZ -> Maybe ((:>) (RL p) p wX wZ)
forall a b. (a -> b) -> a -> b
$ (RL p wX wY
pps RL p wX wY -> FL p wY wZ -> RL p wX wZ
forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> RL p wX wZ
+<<+ FL p wY wZ
skipped') RL p wX wZ -> p wZ wZ -> (:>) (RL p) p wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wZ
p'
                Char
'n' -> IO (Maybe ((:>) (RL p) p wX wZ))
nextPatch
                Char
'j' -> IO (Maybe ((:>) (RL p) p wX wZ))
nextPatch
                Char
'k' -> RL p wX wY
-> FL (WithSkipped p) wY wZ -> IO (Maybe ((:>) (RL p) p wX wZ))
forall wA wB wC.
RL p wA wB
-> FL (WithSkipped p) wB wC -> IO (Maybe ((:>) (RL p) p wA wC))
previousPatch RL p wX wY
remaining FL (WithSkipped p) wY wZ
skipped
                Char
'v' -> p wY wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContent p wY wY
p IO ()
-> IO (Maybe ((:>) (RL p) p wX wZ))
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
                Char
'p' -> p wY wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContentWithPager p wY wY
p IO ()
-> IO (Maybe ((:>) (RL p) p wX wZ))
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
                Char
'x' -> do p wY wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printSummary p wY wY
p
                          IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
                Char
'r' -> p wY wY -> IO ()
forall {wX} {wY}. p wX wY -> IO ()
defaultPrintFriendly p wY wY
p IO ()
-> IO (Maybe ((:>) (RL p) p wX wZ))
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
                Char
'q' -> do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (ShowS
capitalize String
jn) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cancelled."
                          IO (Maybe ((:>) (RL p) p wX wZ))
forall a. IO a
exitSuccess
                Char
_   -> do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor String
jn [[KeyPress]]
basicOptions [[KeyPress]]
advancedOptions
                          IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
        IO (Maybe ((:>) (RL p) p wX wZ))
repeatThis
  where prompt' :: String
prompt' = String
"Shall I " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" this patch?"
        nextPatch :: IO (Maybe ((:>) (RL p) p wX wZ))
nextPatch = String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn p wA wB -> Bool
forall wA wB. p wA wB -> Bool
matches RL p wX wY
pps (SkippedReason -> p wY wY -> WithSkipped p wY wY
forall (p :: * -> * -> *) wX wY.
SkippedReason -> p wX wY -> WithSkipped p wX wY
WithSkipped SkippedReason
SkippedManually p wY wY
pWithSkipped p wY wY
-> FL (WithSkipped p) wY wZ -> FL (WithSkipped p) wY wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (WithSkipped p) wY wZ
skipped)
        previousPatch :: RL p wA wB
                      -> FL (WithSkipped p) wB wC
                      -> IO (Maybe ((RL p :> p) wA wC))
        previousPatch :: forall wA wB wC.
RL p wA wB
-> FL (WithSkipped p) wB wC -> IO (Maybe ((:>) (RL p) p wA wC))
previousPatch RL p wA wB
remaining' FL (WithSkipped p) wB wC
NilFL = String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wA wB
-> FL (WithSkipped p) wB wC
-> IO (Maybe ((:>) (RL p) p wA wC))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn p wA wB -> Bool
forall wA wB. p wA wB -> Bool
matches RL p wA wB
remaining' FL (WithSkipped p) wB wB
FL (WithSkipped p) wB wC
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
        previousPatch RL p wA wB
remaining' (WithSkipped SkippedReason
sk p wB wY
prev :>: FL (WithSkipped p) wY wC
skipped'') =
            case SkippedReason
sk of
                SkippedReason
SkippedManually -> String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wA wY
-> FL (WithSkipped p) wY wC
-> IO (Maybe ((:>) (RL p) p wA wC))
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree) =>
String
-> (forall wA wB. p wA wB -> Bool)
-> RL p wX wY
-> FL (WithSkipped p) wY wZ
-> IO (Maybe ((:>) (RL p) p wX wZ))
wspfr String
jn p wA wB -> Bool
forall wA wB. p wA wB -> Bool
matches (RL p wA wB
remaining' RL p wA wB -> p wB wY -> RL p wA wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: p wB wY
prev) FL (WithSkipped p) wY wC
skipped''
                SkippedReason
SkippedAutomatically -> RL p wA wY
-> FL (WithSkipped p) wY wC -> IO (Maybe ((:>) (RL p) p wA wC))
forall wA wB wC.
RL p wA wB
-> FL (WithSkipped p) wB wC -> IO (Maybe ((:>) (RL p) p wA wC))
previousPatch (RL p wA wB
remaining' RL p wA wB -> p wB wY -> RL p wA wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: p wB wY
prev) FL (WithSkipped p) wY wC
skipped''
        basicOptions :: [[KeyPress]]
basicOptions =
                    [[ Char -> String -> KeyPress
KeyPress Char
'y' (String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" this patch")
                     , Char -> String -> KeyPress
KeyPress Char
'n' (String
"don't " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" it")
                     , Char -> String -> KeyPress
KeyPress Char
'j' String
"skip to next patch"
                     , Char -> String -> KeyPress
KeyPress Char
'k' String
"back up to previous patch"
                    ]]
        advancedOptions :: [[KeyPress]]
advancedOptions =
                    [[ Char -> String -> KeyPress
KeyPress Char
'v' String
"view this patch in full"
                     , Char -> String -> KeyPress
KeyPress Char
'p' String
"view this patch in full with pager"
                     , Char -> String -> KeyPress
KeyPress Char
'x' String
"view a summary of this patch"
                     , Char -> String -> KeyPress
KeyPress Char
'r' String
"view this patch"
                     , Char -> String -> KeyPress
KeyPress Char
'q' (String
"cancel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn)
                    ]]
        defaultPrintFriendly :: p wX wY -> IO ()
defaultPrintFriendly =
          Verbosity -> WithSummary -> p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly Verbosity
NormalVerbosity WithSummary
NoSummary

-- | Runs a function on the underlying @PatchChoices@ object
liftChoices :: StateT (PatchChoices p wX wY) Identity a
            -> InteractiveSelectionM p wX wY a
liftChoices :: forall (p :: * -> * -> *) wX wY a.
StateT (PatchChoices p wX wY) Identity a
-> InteractiveSelectionM p wX wY a
liftChoices StateT (PatchChoices p wX wY) Identity a
act = do
  PatchChoices p wX wY
ch <- (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices
  let (a
result, PatchChoices p wX wY
_) = Identity (a, PatchChoices p wX wY) -> (a, PatchChoices p wX wY)
forall a. Identity a -> a
runIdentity (Identity (a, PatchChoices p wX wY) -> (a, PatchChoices p wX wY))
-> Identity (a, PatchChoices p wX wY) -> (a, PatchChoices p wX wY)
forall a b. (a -> b) -> a -> b
$ StateT (PatchChoices p wX wY) Identity a
-> PatchChoices p wX wY -> Identity (a, PatchChoices p wX wY)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (PatchChoices p wX wY) Identity a
act PatchChoices p wX wY
ch
  (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc {choices = ch} -- Should this be ch or the result of runState?
  a -> InteractiveSelectionM p wX wY a
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | @justDone n@ notes that @n@ patches have just been processed
justDone :: Int -> InteractiveSelectionM p wX wY ()
justDone :: forall (p :: * -> * -> *) wX wY.
Int -> InteractiveSelectionM p wX wY ()
justDone Int
n = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc{ current = current isc + n}

initialSelectionState :: FL (LabelledPatch p) wX wY
                      -> PatchChoices p wX wY
                      -> InteractiveSelectionState p wX wY
initialSelectionState :: forall (p :: * -> * -> *) wX wY.
FL (LabelledPatch p) wX wY
-> PatchChoices p wX wY -> InteractiveSelectionState p wX wY
initialSelectionState FL (LabelledPatch p) wX wY
lps PatchChoices p wX wY
pcs =
  ISC { total :: Int
total = FL (LabelledPatch p) wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (LabelledPatch p) wX wY
lps
      , current :: Int
current = Int
0
      , lps :: FZipper (LabelledPatch p) wX wY
lps = RL (LabelledPatch p) wX wX
-> FL (LabelledPatch p) wX wY -> FZipper (LabelledPatch p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> FL a wY wZ -> FZipper a wX wZ
FZipper RL (LabelledPatch p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL FL (LabelledPatch p) wX wY
lps
      , choices :: PatchChoices p wX wY
choices = PatchChoices p wX wY
pcs
      }

-- | The actual interactive selection process.
textSelect :: ( Commute p, Invert p, ShowPatch p, ShowContextPatch p
              , PatchInspect p, ApplyState p ~ Tree )
           => FL (LabelledPatch p) wX wY
           -> PatchChoices p wX wY
           -> PatchSelectionM p IO (PatchChoices p wX wY)
textSelect :: forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, ShowPatch p, ShowContextPatch p,
 PatchInspect p, ApplyState p ~ Tree) =>
FL (LabelledPatch p) wX wY
-> PatchChoices p wX wY
-> PatchSelectionM p IO (PatchChoices p wX wY)
textSelect FL (LabelledPatch p) wX wY
lps' PatchChoices p wX wY
pcs =
  InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> ReaderT
     (SelectionConfig p) IO (InteractiveSelectionState p wX wY)
-> ReaderT (SelectionConfig p) IO (PatchChoices p wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
-> InteractiveSelectionState p wX wY
-> ReaderT
     (SelectionConfig p) IO (InteractiveSelectionState p wX wY)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
skipMundane StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
forall a b.
StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  a
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     b
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
forall a b.
StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  a
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     b
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
textSelectIfAny)
      (FL (LabelledPatch p) wX wY
-> PatchChoices p wX wY -> InteractiveSelectionState p wX wY
forall (p :: * -> * -> *) wX wY.
FL (LabelledPatch p) wX wY
-> PatchChoices p wX wY -> InteractiveSelectionState p wX wY
initialSelectionState FL (LabelledPatch p) wX wY
lps' PatchChoices p wX wY
pcs)
  where
    textSelectIfAny :: StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
textSelectIfAny = do
      FZipper (LabelledPatch p) wX wY
z <- (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps
      Bool
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FZipper (LabelledPatch p) wX wY -> Bool
forall (p :: * -> * -> *) wX wY. FZipper p wX wY -> Bool
rightmost FZipper (LabelledPatch p) wX wY
z) (StateT
   (InteractiveSelectionState p wX wY)
   (ReaderT (SelectionConfig p) IO)
   ()
 -> StateT
      (InteractiveSelectionState p wX wY)
      (ReaderT (SelectionConfig p) IO)
      ())
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
-> StateT
     (InteractiveSelectionState p wX wY)
     (ReaderT (SelectionConfig p) IO)
     ()
forall a b. (a -> b) -> a -> b
$ StateT
  (InteractiveSelectionState p wX wY)
  (ReaderT (SelectionConfig p) IO)
  ()
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, ShowPatch p, ShowContextPatch p,
 PatchInspect p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
textSelect'

textSelect' :: ( Commute p, Invert p, ShowPatch p, ShowContextPatch p
               , PatchInspect p, ApplyState p ~ Tree )
            => InteractiveSelectionM p wX wY ()
textSelect' :: forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, ShowPatch p, ShowContextPatch p,
 PatchInspect p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
textSelect' = do
  FZipper (LabelledPatch p) wX wY
z <- (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps
  Bool
done <- if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FZipper (LabelledPatch p) wX wY -> Bool
forall (p :: * -> * -> *) wX wY. FZipper p wX wY -> Bool
rightmost FZipper (LabelledPatch p) wX wY
z
           then InteractiveSelectionM p wX wY Bool
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p, PatchInspect p) =>
InteractiveSelectionM p wX wY Bool
textSelectOne
           else InteractiveSelectionM p wX wY Bool
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY Bool
lastQuestion
  Bool
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
done (InteractiveSelectionM p wX wY ()
 -> InteractiveSelectionM p wX wY ())
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, ShowPatch p, ShowContextPatch p,
 PatchInspect p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
textSelect'

optionsBasic :: String -> String -> [KeyPress]
optionsBasic :: String -> String -> [KeyPress]
optionsBasic String
jn String
aThing =
    [ Char -> String -> KeyPress
KeyPress Char
'y' (String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThing)
    , Char -> String -> KeyPress
KeyPress Char
'n' (String
"don't "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" it")
    , Char -> String -> KeyPress
KeyPress Char
'w' String
"wait and decide later, defaulting to no" ]

optionsFile :: String -> [KeyPress]
optionsFile :: String -> [KeyPress]
optionsFile String
jn =
    [ Char -> String -> KeyPress
KeyPress Char
's' (String
"don't "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" the rest of the changes to this file")
    , Char -> String -> KeyPress
KeyPress Char
'f' (String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" the rest of the changes to this file") ]

optionsView :: String -> String -> [KeyPress]
optionsView :: String -> String -> [KeyPress]
optionsView String
aThing String
someThings =
    [ Char -> String -> KeyPress
KeyPress Char
'v' (String
"view this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThingString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" in full")
    , Char -> String -> KeyPress
KeyPress Char
'p' (String
"view this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThingString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" in full with pager")
    , Char -> String -> KeyPress
KeyPress Char
'r' (String
"view this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThing)
    , Char -> String -> KeyPress
KeyPress Char
'l' (String
"list all selected "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThings) ]

optionsSummary :: String -> [KeyPress]
optionsSummary :: String -> [KeyPress]
optionsSummary String
aThing =
    [ Char -> String -> KeyPress
KeyPress Char
'x' (String
"view a summary of this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThing) ]

optionsQuit :: String -> Bool -> String -> [KeyPress]
optionsQuit :: String -> Bool -> String -> [KeyPress]
optionsQuit String
jn Bool
allowsa String
someThings =
    [ Char -> String -> KeyPress
KeyPress Char
'd' (String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" selected "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThingsString -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
", skipping all the remaining "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThings)
            | Bool
allowsa ]
    [KeyPress] -> [KeyPress] -> [KeyPress]
forall a. [a] -> [a] -> [a]
++
    [ Char -> String -> KeyPress
KeyPress Char
'a' (String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" all the remaining "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThings)
    , Char -> String -> KeyPress
KeyPress Char
'q' (String
"cancel "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
jn) ]

optionsNav :: String -> Bool -> [KeyPress]
optionsNav :: String -> Bool -> [KeyPress]
optionsNav String
aThing Bool
isLast=
    [ Char -> String -> KeyPress
KeyPress Char
'j' (String
"skip to next "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
aThing) | Bool -> Bool
not Bool
isLast ]
    [KeyPress] -> [KeyPress] -> [KeyPress]
forall a. [a] -> [a] -> [a]
++
    [ Char -> String -> KeyPress
KeyPress Char
'k' (String
"back up to previous "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
aThing)
    , Char -> String -> KeyPress
KeyPress Char
'g' (String
"start over from the first "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThing)]

optionsSplit :: Maybe (Splitter a) -> String -> [KeyPress]
optionsSplit :: forall (a :: * -> * -> *).
Maybe (Splitter a) -> String -> [KeyPress]
optionsSplit Maybe (Splitter a)
split String
aThing
    | Just Splitter a
_ <- Maybe (Splitter a)
split
             = [ Char -> String -> KeyPress
KeyPress Char
'e' (String
"interactively edit this "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
aThing) ]
    | Bool
otherwise = []

optionsLast :: String -> String -> ([[KeyPress]], [[KeyPress]])
optionsLast :: String -> String -> ([[KeyPress]], [[KeyPress]])
optionsLast String
jn String
aThing =
  (String -> Bool -> [KeyPress]
optionsNav String
aThing Bool
True[KeyPress] -> [[KeyPress]] -> [[KeyPress]]
forall a. a -> [a] -> [a]
:
   [[ Char -> String -> KeyPress
KeyPress Char
'y' String
"confirm this operation"
    , Char -> String -> KeyPress
KeyPress Char
'q' (String
"cancel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn) ]
    , [ Char -> String -> KeyPress
KeyPress Char
'l' String
"list all selected" ]
   ]
  ,[[Char -> String -> KeyPress
KeyPress Char
'a' String
"confirm this operation"
    , Char -> String -> KeyPress
KeyPress Char
'd' String
"confirm this operation"
    , Char -> String -> KeyPress
KeyPress Char
'n' (String
"cancel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn) ]])

options :: (ShowPatch p)
        => Bool
        -> InteractiveSelectionM p wX wY ([[KeyPress]],[[KeyPress]])
options :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Bool -> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
options Bool
single = do
  Maybe (Splitter p)
split <- (SelectionConfig p -> Maybe (Splitter p))
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (Maybe (Splitter p))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> Maybe (Splitter p)
forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
splitter
  String
jn <- (SelectionConfig p -> String)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
  Bool
allowsa <- (SelectionConfig p -> Bool)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> Bool
forall (p :: * -> * -> *). SelectionConfig p -> Bool
allowSkipAll
  String
aThing <- StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
thing
  String
someThings <- StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
things
  PatchSelectionOptions
o <- (SelectionConfig p -> PatchSelectionOptions)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     PatchSelectionOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> PatchSelectionOptions
forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts
  ([[KeyPress]], [[KeyPress]])
-> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String -> String -> [KeyPress]
optionsBasic String
jn String
aThing]
         ,[Maybe (Splitter p) -> String -> [KeyPress]
forall (a :: * -> * -> *).
Maybe (Splitter a) -> String -> [KeyPress]
optionsSplit Maybe (Splitter p)
split String
aThing]
         [[KeyPress]] -> [[KeyPress]] -> [[KeyPress]]
forall a. [a] -> [a] -> [a]
++ [String -> [KeyPress]
optionsFile String
jn | Bool
single]
         [[KeyPress]] -> [[KeyPress]] -> [[KeyPress]]
forall a. [a] -> [a] -> [a]
++ [String -> String -> [KeyPress]
optionsView String
aThing String
someThings [KeyPress] -> [KeyPress] -> [KeyPress]
forall a. [a] -> [a] -> [a]
++
                if PatchSelectionOptions -> WithSummary
withSummary PatchSelectionOptions
o WithSummary -> WithSummary -> Bool
forall a. Eq a => a -> a -> Bool
== WithSummary
YesSummary
                    then []
                    else String -> [KeyPress]
optionsSummary String
aThing]
         [[KeyPress]] -> [[KeyPress]] -> [[KeyPress]]
forall a. [a] -> [a] -> [a]
++ [String -> Bool -> String -> [KeyPress]
optionsQuit String
jn Bool
allowsa String
someThings]
         [[KeyPress]] -> [[KeyPress]] -> [[KeyPress]]
forall a. [a] -> [a] -> [a]
++ [String -> Bool -> [KeyPress]
optionsNav String
aThing Bool
False]
         )

-- | Returns a 'Sealed2' version of the patch we are asking the user
-- about.
currentPatch :: InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch :: forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch = FZipper (LabelledPatch p) wX wY
-> Maybe (Sealed2 (LabelledPatch p))
forall (a :: * -> * -> *) wX wY.
FZipper a wX wY -> Maybe (Sealed2 a)
focus (FZipper (LabelledPatch p) wX wY
 -> Maybe (Sealed2 (LabelledPatch p)))
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (Maybe (Sealed2 (LabelledPatch p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps

-- | Returns the patches we have yet to ask the user about.
todo :: InteractiveSelectionM p wX wY (FlippedSeal (FL (LabelledPatch p)) wY)
todo :: forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM
  p wX wY (FlippedSeal (FL (LabelledPatch p)) wY)
todo = FZipper (LabelledPatch p) wX wY
-> FlippedSeal (FL (LabelledPatch p)) wY
forall (a :: * -> * -> *) wX wY.
FZipper a wX wY -> FlippedSeal (FL a) wY
jokers (FZipper (LabelledPatch p) wX wY
 -> FlippedSeal (FL (LabelledPatch p)) wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FlippedSeal (FL (LabelledPatch p)) wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps

-- | Modify the underlying @PatchChoices@ by some function
modifyChoices :: (PatchChoices p wX wY -> PatchChoices p wX wY)
              -> InteractiveSelectionM p wX wY ()
modifyChoices :: forall (p :: * -> * -> *) wX wY.
(PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
modifyChoices PatchChoices p wX wY -> PatchChoices p wX wY
f = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc{choices = f $ choices isc}

-- | returns @Just f@ if the 'currentPatch' only modifies @f@,
-- @Nothing@ otherwise.
currentFile :: (PatchInspect p)
            => InteractiveSelectionM p wX wY (Maybe AnchoredPath)
currentFile :: forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
InteractiveSelectionM p wX wY (Maybe AnchoredPath)
currentFile = do
  Maybe (Sealed2 (LabelledPatch p))
c <- InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch
  Maybe AnchoredPath
-> InteractiveSelectionM p wX wY (Maybe AnchoredPath)
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AnchoredPath
 -> InteractiveSelectionM p wX wY (Maybe AnchoredPath))
-> Maybe AnchoredPath
-> InteractiveSelectionM p wX wY (Maybe AnchoredPath)
forall a b. (a -> b) -> a -> b
$ case Maybe (Sealed2 (LabelledPatch p))
c of
             Maybe (Sealed2 (LabelledPatch p))
Nothing -> Maybe AnchoredPath
forall a. Maybe a
Nothing
             Just (Sealed2 LabelledPatch p wX wY
lp) ->
                 case LabelledPatch p wX wY -> [AnchoredPath]
forall wX wY. LabelledPatch p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles LabelledPatch p wX wY
lp of
                   [AnchoredPath
f] -> AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just AnchoredPath
f
                   [AnchoredPath]
_ -> Maybe AnchoredPath
forall a. Maybe a
Nothing

-- | @decide True@ selects the current patch, and @decide False@ deselects
-- it.
decide :: Commute p
       => Bool
       -> LabelledPatch p wA wB
       -> InteractiveSelectionM p wX wY ()
decide :: forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
Bool -> LabelledPatch p wA wB -> InteractiveSelectionM p wX wY ()
decide Bool
takeOrDrop LabelledPatch p wA wB
lp = do
    WhichChanges
whch <- (SelectionConfig p -> WhichChanges)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     WhichChanges
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> WhichChanges
forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges
    if WhichChanges -> Bool
backward WhichChanges
whch Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
takeOrDrop -- we go backward xor we are dropping
    then (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
modifyChoices ((PatchChoices p wX wY -> PatchChoices p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Label -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
Label -> PatchChoices p wA wB -> PatchChoices p wA wB
forceLast (LabelledPatch p wA wB -> Label
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> Label
label LabelledPatch p wA wB
lp)
    else (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
modifyChoices ((PatchChoices p wX wY -> PatchChoices p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Label -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
Label -> PatchChoices p wA wB -> PatchChoices p wA wB
forceFirst (LabelledPatch p wA wB -> Label
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> Label
label LabelledPatch p wA wB
lp)

-- | like 'decide', but for all patches touching @file@
decideWholeFile :: (Commute p, PatchInspect p)
                => AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile :: forall (p :: * -> * -> *) wX wY.
(Commute p, PatchInspect p) =>
AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile AnchoredPath
path Bool
takeOrDrop =
    do
      FlippedSeal FL (LabelledPatch p) wX wY
lps_todo <- InteractiveSelectionM
  p wX wY (FlippedSeal (FL (LabelledPatch p)) wY)
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM
  p wX wY (FlippedSeal (FL (LabelledPatch p)) wY)
todo
      let patches_to_skip :: [Sealed2 (LabelledPatch p)]
patches_to_skip =
              (forall wX wY. LabelledPatch p wX wY -> Bool)
-> FL (LabelledPatch p) wX wY -> [Sealed2 (LabelledPatch p)]
forall (a :: * -> * -> *) wW wZ.
(forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> [Sealed2 a]
filterFL (\LabelledPatch p wX wY
lp' -> LabelledPatch p wX wY -> [AnchoredPath]
forall wX wY. LabelledPatch p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles LabelledPatch p wX wY
lp' [AnchoredPath] -> [AnchoredPath] -> Bool
forall a. Eq a => a -> a -> Bool
== [AnchoredPath
path]) FL (LabelledPatch p) wX wY
lps_todo
      (Sealed2 (LabelledPatch p) -> InteractiveSelectionM p wX wY ())
-> [Sealed2 (LabelledPatch p)] -> InteractiveSelectionM p wX wY ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall wX wY.
 LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ())
-> Sealed2 (LabelledPatch p) -> InteractiveSelectionM p wX wY ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 ((forall wX wY.
  LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ())
 -> Sealed2 (LabelledPatch p) -> InteractiveSelectionM p wX wY ())
-> (forall wX wY.
    LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ())
-> Sealed2 (LabelledPatch p)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Bool -> LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
Bool -> LabelledPatch p wA wB -> InteractiveSelectionM p wX wY ()
decide Bool
takeOrDrop) [Sealed2 (LabelledPatch p)]
patches_to_skip

-- | Undecide the current patch.
postponeNext :: Commute p => InteractiveSelectionM p wX wY ()
postponeNext :: forall (p :: * -> * -> *) wX wY.
Commute p =>
InteractiveSelectionM p wX wY ()
postponeNext =
    do
      Just (Sealed2 LabelledPatch p wX wY
lp) <- InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch
      (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
modifyChoices ((PatchChoices p wX wY -> PatchChoices p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Label -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
Label -> PatchChoices p wA wB -> PatchChoices p wA wB
forceMiddle (LabelledPatch p wX wY -> Label
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> Label
label LabelledPatch p wX wY
lp)

-- | Focus the next patch.
skipOne :: InteractiveSelectionM p wX wY ()
skipOne :: forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
forall {p :: * -> * -> *} {wX} {wY}.
InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
so
    where so :: InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
so InteractiveSelectionState p wX wY
x = InteractiveSelectionState p wX wY
x{lps = right (lps x), current = current x +1}

-- | Focus the previous patch.
backOne :: InteractiveSelectionM p wX wY ()
backOne :: forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backOne = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
forall {p :: * -> * -> *} {wX} {wY}.
InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
so
    where so :: InteractiveSelectionState p wX wY
-> InteractiveSelectionState p wX wY
so InteractiveSelectionState p wX wY
isc = InteractiveSelectionState p wX wY
isc{lps = left (lps isc), current = max (current isc-1) 0}

-- | Split the current patch (presumably a hunk), and add the replace it
-- with its parts.
splitCurrent :: Splitter p
             -> InteractiveSelectionM p wX wY ()
splitCurrent :: forall (p :: * -> * -> *) wX wY.
Splitter p -> InteractiveSelectionM p wX wY ()
splitCurrent Splitter p
s = do
    FZipper RL (LabelledPatch p) wX wY
lps_done (LabelledPatch p wY wY
lp:>:FL (LabelledPatch p) wY wY
lps_todo) <- (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps
    case Splitter p
-> forall wX wY.
   p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall (p :: * -> * -> *).
Splitter p
-> forall wX wY.
   p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter Splitter p
s (LabelledPatch p wY wY -> p wY wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wY wY
lp) of
      Maybe (ByteString, ByteString -> Maybe (FL p wY wY))
Nothing -> () -> InteractiveSelectionM p wX wY ()
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (ByteString
text, ByteString -> Maybe (FL p wY wY)
parse) ->
          do
            ByteString
newText <- IO ByteString
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     ByteString
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> StateT
      (InteractiveSelectionState p wX wY)
      (PatchSelectionM p IO)
      ByteString)
-> IO ByteString
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ByteString
editText String
"darcs-patch-edit" ByteString
text
            case ByteString -> Maybe (FL p wY wY)
parse ByteString
newText of
               Maybe (FL p wY wY)
Nothing -> () -> InteractiveSelectionM p wX wY ()
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               Just FL p wY wY
ps -> do
                 FL (LabelledPatch p) wY wY
lps_new <- IO (FL (LabelledPatch p) wY wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FL (LabelledPatch p) wY wY)
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FL (LabelledPatch p) wY wY)
 -> StateT
      (InteractiveSelectionState p wX wY)
      (PatchSelectionM p IO)
      (FL (LabelledPatch p) wY wY))
-> IO (FL (LabelledPatch p) wY wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FL (LabelledPatch p) wY wY)
forall a b. (a -> b) -> a -> b
$ FL (LabelledPatch p) wY wY -> IO (FL (LabelledPatch p) wY wY)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (LabelledPatch p) wY wY -> IO (FL (LabelledPatch p) wY wY))
-> FL (LabelledPatch p) wY wY -> IO (FL (LabelledPatch p) wY wY)
forall a b. (a -> b) -> a -> b
$ Maybe Label -> FL p wY wY -> FL (LabelledPatch p) wY wY
forall (p :: * -> * -> *) wX wY.
Maybe Label -> FL p wX wY -> FL (LabelledPatch p) wX wY
labelPatches (Label -> Maybe Label
forall a. a -> Maybe a
Just (LabelledPatch p wY wY -> Label
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> Label
label LabelledPatch p wY wY
lp)) FL p wY wY
ps
                 (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> InteractiveSelectionM p wX wY ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc { total = total isc + lengthFL lps_new - 1
                                      , lps = FZipper lps_done
                                               (lps_new +>+ lps_todo)
                                      , choices = substitute
                                                   (seal2 (lp :||: lps_new))
                                                   (choices isc)
                                      }

-- | Print the list of the selected patches. We currently choose to display
-- them in "commuted" form, that is, in the order in which they have been
-- selected and with deselected patches moved out of the way.
printSelected :: (Commute p, ShowPatch p) => InteractiveSelectionM p wX wY ()
printSelected :: forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
printSelected = do
  String
someThings <- InteractiveSelectionM p wX wY String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
things
  PatchSelectionOptions
o <- (SelectionConfig p -> PatchSelectionOptions)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     PatchSelectionOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> PatchSelectionOptions
forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts
  WhichChanges
w <- (SelectionConfig p -> WhichChanges)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     WhichChanges
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> WhichChanges
forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges
  let showFL :: FL (LabelledPatch p) wX wY -> Doc
showFL = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> (FL (LabelledPatch p) wX wY -> [Doc])
-> FL (LabelledPatch p) wX wY
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. LabelledPatch p wW wZ -> Doc)
-> FL (LabelledPatch p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (Verbosity -> WithSummary -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> Doc
showFriendly (PatchSelectionOptions -> Verbosity
verbosity PatchSelectionOptions
o) (PatchSelectionOptions -> WithSummary
withSummary PatchSelectionOptions
o) (p wW wZ -> Doc)
-> (LabelledPatch p wW wZ -> p wW wZ)
-> LabelledPatch p wW wZ
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wW wZ -> p wW wZ
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel)
  (FL (LabelledPatch p) wX wZ
first_chs :> FL (LabelledPatch p) wZ wZ
_ :> FL (LabelledPatch p) wZ wY
last_chs) <- PatchChoices p wX wY
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wX
     wY
getChoices (PatchChoices p wX wY
 -> (:>)
      (FL (LabelledPatch p))
      (FL (LabelledPatch p) :> FL (LabelledPatch p))
      wX
      wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     ((:>)
        (FL (LabelledPatch p))
        (FL (LabelledPatch p) :> FL (LabelledPatch p))
        wX
        wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices
  IO () -> InteractiveSelectionM p wX wY ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InteractiveSelectionM p wX wY ())
-> IO () -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
    [ String -> Doc
greenText (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"---- selected "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThingsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" ----"
    , if WhichChanges -> Bool
backward WhichChanges
w then FL (LabelledPatch p) wZ wY -> Doc
forall {wX} {wY}. FL (LabelledPatch p) wX wY -> Doc
showFL FL (LabelledPatch p) wZ wY
last_chs else FL (LabelledPatch p) wX wZ -> Doc
forall {wX} {wY}. FL (LabelledPatch p) wX wY -> Doc
showFL FL (LabelledPatch p) wX wZ
first_chs
    , String -> Doc
greenText (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"---- end of selected "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
someThingsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" ----"
    ]

-- | Skips all remaining patches.
skipAll ::  InteractiveSelectionM p wX wY ()
skipAll :: forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipAll = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc {lps = toEnd $ lps isc}

backAll ::  InteractiveSelectionM p wX wY ()
backAll :: forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backAll = (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc {lps = toStart $ lps isc
                               ,current = 0}

isSingleFile :: PatchInspect p => p wX wY -> Bool
isSingleFile :: forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> Bool
isSingleFile p wX wY
p = [AnchoredPath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (p wX wY -> [AnchoredPath]
forall wX wY. p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
p) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

askConfirmation ::  InteractiveSelectionM p wX wY ()
askConfirmation :: forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
askConfirmation = do
    String
jn <- (SelectionConfig p -> String)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
    IO () -> InteractiveSelectionM p wX wY ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InteractiveSelectionM p wX wY ())
-> IO () -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
jn String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"unpull", String
"unrecord", String
"obliterate"]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
               Bool
yes <- String -> IO Bool
promptYorn (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"Really " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" all undecided patches?"
               Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
yes IO ()
forall a. IO a
exitSuccess

-- | The singular form of the noun for items of type @p@.
thing :: (ShowPatch p) => InteractiveSelectionM p wX wY String
thing :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
thing = (p wX wY -> String
forall wX wY. p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
Darcs.Patch.thing (p wX wY -> String)
-> (PatchChoices p wX wY -> p wX wY)
-> PatchChoices p wX wY
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wX wY -> p wX wY
forall (p :: * -> * -> *) wA wB. PatchChoices p wA wB -> p wA wB
helper) (PatchChoices p wX wY -> String)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices
        where
          helper :: PatchChoices p wA wB -> p wA wB
          helper :: forall (p :: * -> * -> *) wA wB. PatchChoices p wA wB -> p wA wB
helper = PatchChoices p wA wB -> p wA wB
forall a. HasCallStack => a
undefined

-- | The plural form of the noun for items of type @p@.
things :: (ShowPatch p) => InteractiveSelectionM p wX wY String
things :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
things = (p wX wY -> String
forall wX wY. p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
Darcs.Patch.things (p wX wY -> String)
-> (PatchChoices p wX wY -> p wX wY)
-> PatchChoices p wX wY
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchChoices p wX wY -> p wX wY
forall (p :: * -> * -> *) wA wB. PatchChoices p wA wB -> p wA wB
helper) (PatchChoices p wX wY -> String)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices
        where
          helper :: PatchChoices p wA wB -> p wA wB
          helper :: forall (p :: * -> * -> *) wA wB. PatchChoices p wA wB -> p wA wB
helper = PatchChoices p wA wB -> p wA wB
forall a. HasCallStack => a
undefined

-- | The question to ask about one patch.
prompt :: (ShowPatch p) => InteractiveSelectionM p wX wY String
prompt :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
prompt = do
  String
jn <- (SelectionConfig p -> String)
-> InteractiveSelectionM p wX wY String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
  String
aThing <- InteractiveSelectionM p wX wY String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
thing
  Int
n <- (InteractiveSelectionState p wX wY -> Int)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> Int
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> Int
current
  Int
n_max <- (InteractiveSelectionState p wX wY -> Int)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> Int
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> Int
total
  String -> InteractiveSelectionM p wX wY String
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> InteractiveSelectionM p wX wY String)
-> String -> InteractiveSelectionM p wX wY String
forall a b. (a -> b) -> a -> b
$ String
"Shall I "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" this "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
aThingString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"? "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n_max String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") "

-- | Asks the user about one patch, returns their answer.
promptUser :: (ShowPatch p)
           => Bool -> Char -> InteractiveSelectionM p wX wY Char
promptUser :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Bool -> Char -> InteractiveSelectionM p wX wY Char
promptUser Bool
single Char
def = do
  String
thePrompt <- InteractiveSelectionM p wX wY String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
prompt
  ([[KeyPress]]
basicOptions,[[KeyPress]]
advancedOptions) <- Bool -> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Bool -> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
options Bool
single
  IO Char -> InteractiveSelectionM p wX wY Char
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> InteractiveSelectionM p wX wY Char)
-> IO Char -> InteractiveSelectionM p wX wY Char
forall a b. (a -> b) -> a -> b
$ PromptConfig -> IO Char
promptChar PromptConfig { pPrompt :: String
pPrompt = String
thePrompt
                                   , pBasicCharacters :: String
pBasicCharacters = [[KeyPress]] -> String
keysFor [[KeyPress]]
basicOptions
                                   , pAdvancedCharacters :: String
pAdvancedCharacters = [[KeyPress]] -> String
keysFor [[KeyPress]]
advancedOptions
                                   , pDefault :: Maybe Char
pDefault = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
def
                                   , pHelp :: String
pHelp = String
"?h"
                                   }

-- | Ask the user what to do with the next patch.
textSelectOne :: ( Commute p, ShowPatch p, PatchInspect p )
              => InteractiveSelectionM p wX wY Bool
textSelectOne :: forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p, PatchInspect p) =>
InteractiveSelectionM p wX wY Bool
textSelectOne = do
 Maybe (Sealed2 (LabelledPatch p))
c <- InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch
 case Maybe (Sealed2 (LabelledPatch p))
c of
   Maybe (Sealed2 (LabelledPatch p))
Nothing -> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
   Just (Sealed2 LabelledPatch p wX wY
lp) ->
       do
         String
jn <- (SelectionConfig p -> String)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
         Maybe (Splitter p)
spl <- (SelectionConfig p -> Maybe (Splitter p))
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (Maybe (Splitter p))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> Maybe (Splitter p)
forall (p :: * -> * -> *). SelectionConfig p -> Maybe (Splitter p)
splitter
         WhichChanges
whichch <- (SelectionConfig p -> WhichChanges)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     WhichChanges
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> WhichChanges
forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges
         let singleFile :: Bool
singleFile = p wX wY -> Bool
forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> Bool
isSingleFile (LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp)
             p :: p wX wY
p = LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp
         ([[KeyPress]]
basicOptions,[[KeyPress]]
advancedOptions) <- Bool -> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Bool -> InteractiveSelectionM p wX wY ([[KeyPress]], [[KeyPress]])
options Bool
singleFile
         Slot
theSlot <- StateT (PatchChoices p wX wY) Identity Slot
-> InteractiveSelectionM p wX wY Slot
forall (p :: * -> * -> *) wX wY a.
StateT (PatchChoices p wX wY) Identity a
-> InteractiveSelectionM p wX wY a
liftChoices (StateT (PatchChoices p wX wY) Identity Slot
 -> InteractiveSelectionM p wX wY Slot)
-> StateT (PatchChoices p wX wY) Identity Slot
-> InteractiveSelectionM p wX wY Slot
forall a b. (a -> b) -> a -> b
$ (PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
-> StateT (PatchChoices p wX wY) Identity Slot
forall a.
(PatchChoices p wX wY -> (a, PatchChoices p wX wY))
-> StateT (PatchChoices p wX wY) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
 -> StateT (PatchChoices p wX wY) Identity Slot)
-> (PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
-> StateT (PatchChoices p wX wY) Identity Slot
forall a b. (a -> b) -> a -> b
$ LabelledPatch p wX wY
-> PatchChoices p wX wY -> (Slot, PatchChoices p wX wY)
forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
LabelledPatch p wA wB
-> PatchChoices p wX wY -> (Slot, PatchChoices p wX wY)
patchSlot LabelledPatch p wX wY
lp
         let the_default :: Char
the_default = Bool -> Slot -> Char
getDefault (WhichChanges -> Bool
backward WhichChanges
whichch) Slot
theSlot
         Char
yorn <- Bool -> Char -> InteractiveSelectionM p wX wY Char
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Bool -> Char -> InteractiveSelectionM p wX wY Char
promptUser Bool
singleFile Char
the_default
         let nextPatch :: StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch = StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
skipMundane StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent
         case Char
yorn of
               Char
'y' -> Bool -> LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
Bool -> LabelledPatch p wA wB -> InteractiveSelectionM p wX wY ()
decide Bool
True LabelledPatch p wX wY
lp InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch
                      InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'n' -> Bool -> LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
Bool -> LabelledPatch p wA wB -> InteractiveSelectionM p wX wY ()
decide Bool
False LabelledPatch p wX wY
lp InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch
                      InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'w' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
Commute p =>
InteractiveSelectionM p wX wY ()
postponeNext InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch
                      InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'e' | (Just Splitter p
s) <- Maybe (Splitter p)
spl -> Splitter p -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
Splitter p -> InteractiveSelectionM p wX wY ()
splitCurrent Splitter p
s InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent
                                        InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
's' -> InteractiveSelectionM p wX wY (Maybe AnchoredPath)
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
InteractiveSelectionM p wX wY (Maybe AnchoredPath)
currentFile InteractiveSelectionM p wX wY (Maybe AnchoredPath)
-> (Maybe AnchoredPath -> InteractiveSelectionM p wX wY ())
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> (a
    -> StateT
         (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InteractiveSelectionM p wX wY ()
-> (AnchoredPath -> InteractiveSelectionM p wX wY ())
-> Maybe AnchoredPath
-> InteractiveSelectionM p wX wY ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                       (() -> InteractiveSelectionM p wX wY ()
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                       (\AnchoredPath
f -> AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(Commute p, PatchInspect p) =>
AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile AnchoredPath
f Bool
False) InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch
                       InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'f' -> InteractiveSelectionM p wX wY (Maybe AnchoredPath)
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
InteractiveSelectionM p wX wY (Maybe AnchoredPath)
currentFile InteractiveSelectionM p wX wY (Maybe AnchoredPath)
-> (Maybe AnchoredPath -> InteractiveSelectionM p wX wY ())
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> (a
    -> StateT
         (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InteractiveSelectionM p wX wY ()
-> (AnchoredPath -> InteractiveSelectionM p wX wY ())
-> Maybe AnchoredPath
-> InteractiveSelectionM p wX wY ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                       (() -> InteractiveSelectionM p wX wY ()
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                       (\AnchoredPath
f -> AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(Commute p, PatchInspect p) =>
AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile AnchoredPath
f Bool
True) InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
nextPatch
                       InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'v' -> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InteractiveSelectionM p wX wY Bool)
-> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a b. (a -> b) -> a -> b
$ p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContent p wX wY
p IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'p' -> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InteractiveSelectionM p wX wY Bool)
-> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a b. (a -> b) -> a -> b
$ p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContentWithPager p wX wY
p IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'r' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'l' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
printSelected InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'x' -> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InteractiveSelectionM p wX wY Bool)
-> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a b. (a -> b) -> a -> b
$ p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printSummary p wX wY
p IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'd' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipAll InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               Char
'g' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backAll InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'a' ->
                   do
                     InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
askConfirmation
                     (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
(PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
modifyChoices ((PatchChoices p wX wY -> PatchChoices p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (PatchChoices p wX wY -> PatchChoices p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Bool -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
Bool -> PatchChoices p wX wY -> PatchChoices p wX wY
selectAllMiddles (WhichChanges -> Bool
backward WhichChanges
whichch)
                     InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipAll
                     Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               Char
'q' -> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InteractiveSelectionM p wX wY Bool)
-> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a b. (a -> b) -> a -> b
$
                      do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
capitalize String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cancelled."
                         IO Bool
forall a. IO a
exitSuccess
               Char
'j' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'k' -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backOne InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
_   -> do
                 IO () -> InteractiveSelectionM p wX wY ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InteractiveSelectionM p wX wY ())
-> (String -> IO ()) -> String -> InteractiveSelectionM p wX wY ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> InteractiveSelectionM p wX wY ())
-> String -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor String
jn [[KeyPress]]
basicOptions [[KeyPress]]
advancedOptions
                 Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

lastQuestion :: (Commute p, ShowPatch p)
             => InteractiveSelectionM p wX wY Bool
lastQuestion :: forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY Bool
lastQuestion = do
  String
jn <- (SelectionConfig p -> String)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
  String
theThings <- StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
things
  String
aThing <- StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
thing
  let ([[KeyPress]]
basicOptions, [[KeyPress]]
advancedOptions) = String -> String -> ([[KeyPress]], [[KeyPress]])
optionsLast String
jn String
aThing
  Int
num <- InteractiveSelectionM p wX wY Int
forall (p :: * -> * -> *) wX wY.
Commute p =>
InteractiveSelectionM p wX wY Int
numSelected
  if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
    IO ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> IO ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Nothing selected."
    Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  else do
    Char
yorn <- IO Char
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char)
-> (PromptConfig -> IO Char)
-> PromptConfig
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PromptConfig -> IO Char
promptChar (PromptConfig
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char)
-> PromptConfig
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char
forall a b. (a -> b) -> a -> b
$
            PromptConfig { pPrompt :: String
pPrompt = String
"Do you want to "String -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
capitalize String
jnString -> ShowS
forall a. [a] -> [a] -> [a]
++
                                      String
" these "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
theThingsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"?"
                         , pBasicCharacters :: String
pBasicCharacters = String
"yglqk"
                         , pAdvancedCharacters :: String
pAdvancedCharacters = String
"dan"
                         , pDefault :: Maybe Char
pDefault = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'y'
                         , pHelp :: String
pHelp = String
"?h"}
    case Char
yorn of
               Char
c | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"yda" -> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                 | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"qn" -> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InteractiveSelectionM p wX wY Bool)
-> IO Bool -> InteractiveSelectionM p wX wY Bool
forall a b. (a -> b) -> a -> b
$
                                    do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" cancelled."
                                       IO Bool
forall a. IO a
exitSuccess
               Char
'g' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backAll StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'l' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
printSelected StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
'k' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
backOne StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> InteractiveSelectionM p wX wY Bool
-> InteractiveSelectionM p wX wY Bool
forall a b.
StateT (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               Char
_ -> do
                 IO ()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> (String -> IO ())
-> String
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String
 -> StateT
      (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> String
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall a b. (a -> b) -> a -> b
$ String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor String
"this confirmation prompt"
                    [[KeyPress]]
basicOptions [[KeyPress]]
advancedOptions
                 Bool -> InteractiveSelectionM p wX wY Bool
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

numSelected :: Commute p => InteractiveSelectionM p wX wY Int
numSelected :: forall (p :: * -> * -> *) wX wY.
Commute p =>
InteractiveSelectionM p wX wY Int
numSelected = do
  WhichChanges
w <- (SelectionConfig p -> WhichChanges)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     WhichChanges
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> WhichChanges
forall (p :: * -> * -> *). SelectionConfig p -> WhichChanges
whichChanges
  (FL (LabelledPatch p) wX wZ
first_chs :> FL (LabelledPatch p) wZ wZ
_ :> FL (LabelledPatch p) wZ wY
last_chs) <- PatchChoices p wX wY
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
     (FL (LabelledPatch p))
     (FL (LabelledPatch p) :> FL (LabelledPatch p))
     wX
     wY
getChoices (PatchChoices p wX wY
 -> (:>)
      (FL (LabelledPatch p))
      (FL (LabelledPatch p) :> FL (LabelledPatch p))
      wX
      wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     ((:>)
        (FL (LabelledPatch p))
        (FL (LabelledPatch p) :> FL (LabelledPatch p))
        wX
        wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InteractiveSelectionState p wX wY -> PatchChoices p wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (PatchChoices p wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY -> PatchChoices p wX wY
choices
  Int -> InteractiveSelectionM p wX wY Int
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> InteractiveSelectionM p wX wY Int)
-> Int -> InteractiveSelectionM p wX wY Int
forall a b. (a -> b) -> a -> b
$
    if WhichChanges -> Bool
backward WhichChanges
w then FL (LabelledPatch p) wZ wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (LabelledPatch p) wZ wY
last_chs else FL (LabelledPatch p) wX wZ -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (LabelledPatch p) wX wZ
first_chs

-- | Shows the current patch as it should be seen by the user.
printCurrent :: ShowPatch p => InteractiveSelectionM p wX wY ()
printCurrent :: forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY ()
printCurrent = do
  PatchSelectionOptions
o <- (SelectionConfig p -> PatchSelectionOptions)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     PatchSelectionOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> PatchSelectionOptions
forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts
  Maybe (Sealed2 (LabelledPatch p))
c <- InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch
  case Maybe (Sealed2 (LabelledPatch p))
c of
    Maybe (Sealed2 (LabelledPatch p))
Nothing -> () -> InteractiveSelectionM p wX wY ()
forall a.
a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Sealed2 LabelledPatch p wX wY
lp) ->
      IO () -> InteractiveSelectionM p wX wY ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InteractiveSelectionM p wX wY ())
-> IO () -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> WithSummary -> p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly (PatchSelectionOptions -> Verbosity
verbosity PatchSelectionOptions
o) (PatchSelectionOptions -> WithSummary
withSummary PatchSelectionOptions
o) (p wX wY -> IO ()) -> p wX wY -> IO ()
forall a b. (a -> b) -> a -> b
$ LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp

-- | The interactive part of @darcs changes@
textView :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
         => PatchSelectionOptions -> Maybe Int -> Int
         -> [Sealed2 p] -> [Sealed2 p]
         -> IO ()
textView :: forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
_ Maybe Int
_ Int
_ [Sealed2 p]
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
textView PatchSelectionOptions
o Maybe Int
n_max Int
n
            [Sealed2 p]
ps_done ps_todo :: [Sealed2 p]
ps_todo@(Sealed2 p
p:[Sealed2 p]
ps_todo') = do
      Sealed2 p -> IO ()
defaultPrintFriendly Sealed2 p
p
      IO ()
repeatThis -- prompt the user
    where
        defaultPrintFriendly :: Sealed2 p -> IO ()
defaultPrintFriendly =
          (forall wX wY. p wX wY -> IO ()) -> Sealed2 p -> IO ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (Verbosity -> WithSummary -> p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly (PatchSelectionOptions -> Verbosity
verbosity PatchSelectionOptions
o) (PatchSelectionOptions -> WithSummary
withSummary PatchSelectionOptions
o))
        prev_patch :: IO ()
        prev_patch :: IO ()
prev_patch = case [Sealed2 p]
ps_done of
                       [] -> IO ()
repeatThis
                       (Sealed2 p
p':[Sealed2 p]
ps_done') ->
                         PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
o
                            Maybe Int
n_max (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Sealed2 p]
ps_done' (Sealed2 p
p'Sealed2 p -> [Sealed2 p] -> [Sealed2 p]
forall a. a -> [a] -> [a]
:[Sealed2 p]
ps_todo)
        next_patch :: IO ()
        next_patch :: IO ()
next_patch = case [Sealed2 p]
ps_todo' of
                         [] -> -- May as well work out the length now we have all
                                  -- the patches in memory
                               PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
o Maybe Int
n_max
                                   Int
n [Sealed2 p]
ps_done []
                         [Sealed2 p]
_ -> PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
o Maybe Int
n_max
                                  (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Sealed2 p
pSealed2 p -> [Sealed2 p] -> [Sealed2 p]
forall a. a -> [a] -> [a]
:[Sealed2 p]
ps_done) [Sealed2 p]
ps_todo'
        first_patch :: IO ()
first_patch = PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
o Maybe Int
n_max Int
0 [] ([Sealed2 p]
ps_done[Sealed2 p] -> [Sealed2 p] -> [Sealed2 p]
forall a. [a] -> [a] -> [a]
++[Sealed2 p]
ps_todo)
        options_yn :: [KeyPress]
options_yn =
          [ Char -> String -> KeyPress
KeyPress Char
'y' String
"view this patch and go to the next"
          , Char -> String -> KeyPress
KeyPress Char
'n' String
"skip to the next patch" ]
        optionsView' :: [KeyPress]
optionsView' =
          [ Char -> String -> KeyPress
KeyPress Char
'v' String
"view this patch in full"
          , Char -> String -> KeyPress
KeyPress Char
'p' String
"view this patch in full with pager"
          , Char -> String -> KeyPress
KeyPress Char
'r' String
"view this patch" ]
        optionsSummary' :: [KeyPress]
optionsSummary' =
          [ Char -> String -> KeyPress
KeyPress Char
'x' String
"view a summary of this patch" ]
        optionsNav' :: [KeyPress]
optionsNav' =
          [ Char -> String -> KeyPress
KeyPress Char
'q' String
"quit view changes"
          , Char -> String -> KeyPress
KeyPress Char
'k' String
"back up to previous patch"
          , Char -> String -> KeyPress
KeyPress Char
'j' String
"skip to next patch"
          , Char -> String -> KeyPress
KeyPress Char
'g' String
"start over from the first patch"
          , Char -> String -> KeyPress
KeyPress Char
'c' String
"count total patch number" ]
        basicOptions :: [[KeyPress]]
basicOptions = [ [KeyPress]
options_yn ]
        advancedOptions :: [[KeyPress]]
advancedOptions =
                     ([KeyPress]
optionsView' [KeyPress] -> [KeyPress] -> [KeyPress]
forall a. [a] -> [a] -> [a]
++
                        if PatchSelectionOptions -> WithSummary
withSummary PatchSelectionOptions
o WithSummary -> WithSummary -> Bool
forall a. Eq a => a -> a -> Bool
== WithSummary
YesSummary then [] else [KeyPress]
optionsSummary')
                  [KeyPress] -> [[KeyPress]] -> [[KeyPress]]
forall a. a -> [a] -> [a]
: [ [KeyPress]
optionsNav' ]
        prompt' :: String
prompt' = String
"Shall I view this patch? "
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?" Int -> String
forall a. Show a => a -> String
show Maybe Int
n_max String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        repeatThis :: IO ()
        repeatThis :: IO ()
repeatThis = do
          Char
yorn <- PromptConfig -> IO Char
promptChar (String -> String -> String -> Maybe Char -> String -> PromptConfig
PromptConfig String
prompt' ([[KeyPress]] -> String
keysFor [[KeyPress]]
basicOptions) ([[KeyPress]] -> String
keysFor [[KeyPress]]
advancedOptions) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n') String
"?h")
          case Char
yorn of
            Char
'y' -> (forall wX wY. p wX wY -> IO ()) -> Sealed2 p -> IO ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 p wX wY -> IO ()
forall wX wY. p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContent Sealed2 p
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
next_patch
            Char
'n' -> IO ()
next_patch
            Char
'v' -> (forall wX wY. p wX wY -> IO ()) -> Sealed2 p -> IO ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 p wX wY -> IO ()
forall wX wY. p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContent Sealed2 p
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
repeatThis
            Char
'p' -> (forall wX wY. p wX wY -> IO ()) -> Sealed2 p -> IO ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 p wX wY -> IO ()
forall wX wY. p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContentWithPager Sealed2 p
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
repeatThis
            Char
'r' -> do Sealed2 p -> IO ()
defaultPrintFriendly Sealed2 p
p
                      IO ()
repeatThis
            Char
'x' -> do (forall wX wY. p wX wY -> IO ()) -> Sealed2 p -> IO ()
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 p wX wY -> IO ()
forall wX wY. p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printSummary Sealed2 p
p
                      IO ()
repeatThis
            Char
'q' -> IO ()
forall a. IO a
exitSuccess
            Char
'k' -> IO ()
prev_patch
            Char
'j' -> IO ()
next_patch
            Char
'g' -> IO ()
first_patch
            Char
'c' -> PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions
-> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO ()
textView PatchSelectionOptions
o
                       Maybe Int
count_n_max Int
n [Sealed2 p]
ps_done [Sealed2 p]
ps_todo
            Char
_   -> do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [[KeyPress]] -> [[KeyPress]] -> String
helpFor String
"view changes" [[KeyPress]]
basicOptions [[KeyPress]]
advancedOptions
                      IO ()
repeatThis
        count_n_max :: Maybe Int
count_n_max | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
n_max = Maybe Int
n_max
                    | Bool
otherwise    = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Sealed2 p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sealed2 p]
ps_done Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Sealed2 p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sealed2 p]
ps_todo

-- | Skips patches we should not ask the user about
skipMundane :: (Commute p, ShowPatch p)
            => InteractiveSelectionM p wX wY ()
skipMundane :: forall (p :: * -> * -> *) wX wY.
(Commute p, ShowPatch p) =>
InteractiveSelectionM p wX wY ()
skipMundane = do
  (FZipper RL (LabelledPatch p) wX wY
lps_done FL (LabelledPatch p) wY wY
lps_todo) <- (InteractiveSelectionState p wX wY
 -> FZipper (LabelledPatch p) wX wY)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (FZipper (LabelledPatch p) wX wY)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionState p wX wY
-> FZipper (LabelledPatch p) wX wY
lps
  PatchSelectionOptions
o <- (SelectionConfig p -> PatchSelectionOptions)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     PatchSelectionOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> PatchSelectionOptions
forall (p :: * -> * -> *).
SelectionConfig p -> PatchSelectionOptions
opts
  MatchCriterion p
crit <- (SelectionConfig p -> MatchCriterion p)
-> StateT
     (InteractiveSelectionState p wX wY)
     (PatchSelectionM p IO)
     (MatchCriterion p)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> MatchCriterion p
forall (p :: * -> * -> *). SelectionConfig p -> MatchCriterion p
matchCriterion
  String
jn <- (SelectionConfig p -> String)
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SelectionConfig p -> String
forall (p :: * -> * -> *). SelectionConfig p -> String
jobname
  (FL (LabelledPatch p) wY wZ
skipped :> FL (LabelledPatch p) wZ wY
unskipped) <- StateT
  (PatchChoices p wX wY)
  Identity
  ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
-> InteractiveSelectionM
     p wX wY ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
forall (p :: * -> * -> *) wX wY a.
StateT (PatchChoices p wX wY) Identity a
-> InteractiveSelectionM p wX wY a
liftChoices (StateT
   (PatchChoices p wX wY)
   Identity
   ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
 -> InteractiveSelectionM
      p wX wY ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY))
-> StateT
     (PatchChoices p wX wY)
     Identity
     ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
-> InteractiveSelectionM
     p wX wY ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
forall a b. (a -> b) -> a -> b
$ (forall wW wY.
 LabelledPatch p wW wY
 -> StateT (PatchChoices p wX wY) Identity Bool)
-> FL (LabelledPatch p) wY wY
-> StateT
     (PatchChoices p wX wY)
     Identity
     ((:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wY wY)
forall (a :: * -> * -> *) (m :: * -> *) wX wZ.
Monad m =>
(forall wW wY. a wW wY -> m Bool)
-> FL a wX wZ -> m ((:>) (FL a) (FL a) wX wZ)
spanFL_M
                                 ((PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
-> StateT (PatchChoices p wX wY) Identity Slot
forall a.
(PatchChoices p wX wY -> (a, PatchChoices p wX wY))
-> StateT (PatchChoices p wX wY) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
 -> StateT (PatchChoices p wX wY) Identity Slot)
-> (LabelledPatch p wW wY
    -> PatchChoices p wX wY -> (Slot, PatchChoices p wX wY))
-> LabelledPatch p wW wY
-> StateT (PatchChoices p wX wY) Identity Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wW wY
-> PatchChoices p wX wY -> (Slot, PatchChoices p wX wY)
forall (p :: * -> * -> *) wA wB wX wY.
Commute p =>
LabelledPatch p wA wB
-> PatchChoices p wX wY -> (Slot, PatchChoices p wX wY)
patchSlot (LabelledPatch p wW wY
 -> StateT (PatchChoices p wX wY) Identity Slot)
-> (Slot -> StateT (PatchChoices p wX wY) Identity Bool)
-> LabelledPatch p wW wY
-> StateT (PatchChoices p wX wY) Identity Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> StateT (PatchChoices p wX wY) Identity Bool
forall a. a -> StateT (PatchChoices p wX wY) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> StateT (PatchChoices p wX wY) Identity Bool)
-> (Slot -> Bool)
-> Slot
-> StateT (PatchChoices p wX wY) Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> Bool
decided)
                                 FL (LabelledPatch p) wY wY
lps_todo
  let numSkipped :: Int
numSkipped = FL (LabelledPatch p) wY wZ -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (LabelledPatch p) wY wZ
skipped
  Bool
-> InteractiveSelectionM p wX wY ()
-> InteractiveSelectionM p wX wY ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numSkipped Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (InteractiveSelectionM p wX wY ()
 -> InteractiveSelectionM p wX wY ())
-> (IO () -> InteractiveSelectionM p wX wY ())
-> IO ()
-> InteractiveSelectionM p wX wY ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> InteractiveSelectionM p wX wY ()
forall a.
IO a
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InteractiveSelectionM p wX wY ())
-> IO () -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ PatchSelectionOptions
-> String -> Int -> FL (LabelledPatch p) wY wZ -> IO ()
forall {p :: * -> * -> *} {wY} {wZ}.
ShowPatch p =>
PatchSelectionOptions
-> String -> Int -> FL (LabelledPatch p) wY wZ -> IO ()
show_skipped PatchSelectionOptions
o String
jn Int
numSkipped FL (LabelledPatch p) wY wZ
skipped
  let boringThenInteresting :: (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wZ wY
boringThenInteresting =
          if PatchSelectionOptions -> SelectDeps
selectDeps PatchSelectionOptions
o SelectDeps -> SelectDeps -> Bool
forall a. Eq a => a -> a -> Bool
== SelectDeps
AutoDeps
          then (forall wW wY. LabelledPatch p wW wY -> Bool)
-> FL (LabelledPatch p) wZ wY
-> (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wZ wY
forall (a :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> Bool)
-> FL a wX wZ -> (:>) (FL a) (FL a) wX wZ
spanFL (Bool -> Bool
not (Bool -> Bool)
-> (LabelledPatch p wW wY -> Bool) -> LabelledPatch p wW wY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchCriterion p -> forall wA wB. p wA wB -> Bool
forall (p :: * -> * -> *).
MatchCriterion p -> forall wA wB. p wA wB -> Bool
mcFunction MatchCriterion p
crit (p wW wY -> Bool)
-> (LabelledPatch p wW wY -> p wW wY)
-> LabelledPatch p wW wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel) FL (LabelledPatch p) wZ wY
unskipped
          else FL (LabelledPatch p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (LabelledPatch p) wZ wZ
-> FL (LabelledPatch p) wZ wY
-> (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (LabelledPatch p) wZ wY
unskipped
  case (:>) (FL (LabelledPatch p)) (FL (LabelledPatch p)) wZ wY
boringThenInteresting of
    FL (LabelledPatch p) wZ wZ
boring :> FL (LabelledPatch p) wZ wY
interesting ->
        do
          Int -> InteractiveSelectionM p wX wY ()
forall (p :: * -> * -> *) wX wY.
Int -> InteractiveSelectionM p wX wY ()
justDone (Int -> InteractiveSelectionM p wX wY ())
-> Int -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ FL (LabelledPatch p) wZ wZ -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (LabelledPatch p) wZ wZ
boring Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numSkipped
          (InteractiveSelectionState p wX wY
 -> InteractiveSelectionState p wX wY)
-> InteractiveSelectionM p wX wY ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InteractiveSelectionState p wX wY
  -> InteractiveSelectionState p wX wY)
 -> InteractiveSelectionM p wX wY ())
-> (InteractiveSelectionState p wX wY
    -> InteractiveSelectionState p wX wY)
-> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ \InteractiveSelectionState p wX wY
isc -> InteractiveSelectionState p wX wY
isc {lps = FZipper (lps_done +<<+ skipped +<<+ boring)
                                      interesting}
    where
      show_skipped :: PatchSelectionOptions
-> String -> Int -> FL (LabelledPatch p) wY wZ -> IO ()
show_skipped PatchSelectionOptions
o String
jn Int
n FL (LabelledPatch p) wY wZ
ps = do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
_nevermind_ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
_these_ Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
                                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PatchSelectionOptions -> Verbosity
verbosity PatchSelectionOptions
o Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                                       FL (LabelledPatch p) wY wZ -> IO ()
forall (p :: * -> * -> *) wY wZ.
ShowPatch p =>
FL (LabelledPatch p) wY wZ -> IO ()
showskippedpatch FL (LabelledPatch p) wY wZ
ps
      _nevermind_ :: ShowS
_nevermind_ String
jn = String
"Will not ask whether to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
jn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
      _these_ :: Int -> String
_these_ Int
n  = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" already decided " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
_elem_ Int
n String
""
      _elem_ :: Int -> ShowS
_elem_ Int
n = Int -> Noun -> ShowS
forall n. Countable n => Int -> n -> ShowS
englishNum Int
n (String -> Noun
Noun String
"patch")
      showskippedpatch :: ShowPatch p => FL (LabelledPatch p) wY wZ -> IO ()
      showskippedpatch :: forall (p :: * -> * -> *) wY wZ.
ShowPatch p =>
FL (LabelledPatch p) wY wZ -> IO ()
showskippedpatch =
        Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ())
-> (FL (LabelledPatch p) wY wZ -> Doc)
-> FL (LabelledPatch p) wY wZ
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc)
-> (FL (LabelledPatch p) wY wZ -> [Doc])
-> FL (LabelledPatch p) wY wZ
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. LabelledPatch p wW wZ -> Doc)
-> FL (LabelledPatch p) wY wZ -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (Verbosity -> WithSummary -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> Doc
showFriendly Verbosity
NormalVerbosity WithSummary
NoSummary (p wW wZ -> Doc)
-> (LabelledPatch p wW wZ -> p wW wZ)
-> LabelledPatch p wW wZ
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledPatch p wW wZ -> p wW wZ
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel)

decided :: Slot -> Bool
decided :: Slot -> Bool
decided Slot
InMiddle = Bool
False
decided Slot
_ = Bool
True

-- | The action bound to space, depending on the current status of the
-- patch.
getDefault :: Bool -> Slot -> Char
getDefault :: Bool -> Slot -> Char
getDefault Bool
_ Slot
InMiddle = Char
'w'
getDefault Bool
True Slot
InFirst  = Char
'n'
getDefault Bool
True Slot
InLast   = Char
'y'
getDefault Bool
False Slot
InFirst = Char
'y'
getDefault Bool
False Slot
InLast  = Char
'n'

-- | For a given sequence of preceding patches to choose from, and a sequence
-- of prims which will become a new named patch, let the user select a subset
-- such that the new patch will explicitly depend on them. The patches offered
-- include only those that the new patch does not already depend on. To support
-- amend, we pass in the old dependencies, too.
askAboutDepends
  :: (RepoPatch p, ApplyState p ~ Tree)
  => RL (PatchInfoAnd p) wX wR  -- ^ patches to choose from
  -> FL (PrimOf p) wR wT        -- ^ tentative content of new patch
  -> PatchSelectionOptions
  -> [PatchInfo]                -- ^ old explicit dependencies
  -> IO [PatchInfo]
askAboutDepends :: forall (p :: * -> * -> *) wX wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
RL (PatchInfoAnd p) wX wR
-> FL (PrimOf p) wR wT
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
askAboutDepends RL (PatchInfoAnd p) wX wR
to_ask FL (PrimOf p) wR wT
pa' PatchSelectionOptions
ps_opts [PatchInfo]
olddeps = do
  -- Ideally we'd just default the olddeps to yes but still ask about them.
  -- SelectChanges doesn't currently (17/12/09) offer a way to do this so would
  -- have to have this support added first. This is not easy to do, though.

  -- As a cheap alternative we do two selection passes: one where the user can
  -- drop old dependencies and one where they can add new ones.
  FL (PatchInfoAnd p) wX wZ
_ :> FL (PatchInfoAnd p) wZ wR
to_drop <-
    FL (PatchInfoAnd p) wX wR
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wR)
forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection (RL (PatchInfoAnd p) wX wR -> FL (PatchInfoAnd p) wX wR
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wX wR
to_ask) (SelectionConfig (PatchInfoAnd p)
 -> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wR))
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wR)
forall a b. (a -> b) -> a -> b
$
      -- An explicit dependency that we /drop/ can be commuted to the right
      -- i.e. forward in the history without dragging others with them, thus we
      -- use LastReversed. We also use a custom match criterion to offer only
      -- patches we do explicitly depend on.
      WhichChanges
-> String
-> (PatchInfo -> Bool)
-> SelectionConfig (PatchInfoAnd p)
forall {p :: * -> * -> *}.
WhichChanges
-> String
-> (PatchInfo -> Bool)
-> SelectionConfig (PatchInfoAndG p)
selectionConfigDepends WhichChanges
LastReversed String
"drop dependency on" (PatchInfo -> [PatchInfo] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
olddeps)
  let keep :: [PatchInfo]
keep = [PatchInfo]
olddeps [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> FL (PatchInfoAnd p) wZ wR -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info FL (PatchInfoAnd p) wZ wR
to_drop
      dropped :: [PatchInfo]
dropped = [PatchInfo]
olddeps [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo]
keep
  -- Note: using anonymous here is safe since we don't store any patches
  -- and only return a list of PatchInfo
  PatchInfoAndG (Named p) wR wT
pa <- Named p wR wT -> PatchInfoAndG (Named p) wR wT
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia (Named p wR wT -> PatchInfoAndG (Named p) wR wT)
-> (Named p wR wT -> Named p wR wT)
-> Named p wR wT
-> PatchInfoAndG (Named p) wR wT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Named p wR wT -> [PatchInfo] -> Named p wR wT)
-> [PatchInfo] -> Named p wR wT -> Named p wR wT
forall a b c. (a -> b -> c) -> b -> a -> c
flip Named p wR wT -> [PatchInfo] -> Named p wR wT
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps [PatchInfo]
keep (Named p wR wT -> PatchInfoAndG (Named p) wR wT)
-> IO (Named p wR wT) -> IO (PatchInfoAndG (Named p) wR wT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FL (PrimOf p) wR wT -> IO (Named p wR wT)
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
FL (PrimOf p) wX wY -> IO (Named p wX wY)
anonymous FL (PrimOf p) wR wT
pa'
  -- get rid of all (implicit and explicit) dependencies of pa
  RL (PatchInfoAnd p) wX wZ
_ :> PatchInfoAnd p wZ wZ
_ :> RL (PatchInfoAnd p) wZ wT
non_deps <- (:>)
  (RL (PatchInfoAnd p)) (PatchInfoAnd p :> RL (PatchInfoAnd p)) wX wT
-> IO
     ((:>)
        (RL (PatchInfoAnd p))
        (PatchInfoAnd p :> RL (PatchInfoAnd p))
        wX
        wT)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>)
   (RL (PatchInfoAnd p)) (PatchInfoAnd p :> RL (PatchInfoAnd p)) wX wT
 -> IO
      ((:>)
         (RL (PatchInfoAnd p))
         (PatchInfoAnd p :> RL (PatchInfoAnd p))
         wX
         wT))
-> (:>)
     (RL (PatchInfoAnd p)) (PatchInfoAnd p :> RL (PatchInfoAnd p)) wX wT
-> IO
     ((:>)
        (RL (PatchInfoAnd p))
        (PatchInfoAnd p :> RL (PatchInfoAnd p))
        wX
        wT)
forall a b. (a -> b) -> a -> b
$ (:>) (RL (PatchInfoAnd p)) (PatchInfoAnd p) wX wT
-> (:>)
     (RL (PatchInfoAnd p)) (PatchInfoAnd p :> RL (PatchInfoAnd p)) wX wT
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> (:>) (RL p) (p :> RL p) wX wY
commuteWhatWeCanRL (RL (PatchInfoAnd p) wX wR
to_ask RL (PatchInfoAnd p) wX wR
-> PatchInfoAndG (Named p) wR wT
-> (:>) (RL (PatchInfoAnd p)) (PatchInfoAnd p) wX wT
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfoAndG (Named p) wR wT
pa)
  FL (PatchInfoAnd p) wZ wZ
candidates :> FL (PatchInfoAnd p) wZ wT
_ <-
    FL (PatchInfoAnd p) wZ wT
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wT)
forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection (RL (PatchInfoAnd p) wZ wT -> FL (PatchInfoAnd p) wZ wT
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wZ wT
non_deps) (SelectionConfig (PatchInfoAnd p)
 -> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wT))
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wT)
forall a b. (a -> b) -> a -> b
$
      -- Adding explicit dependencies should drag dependent patches with them
      -- (though they will be filtered out later), so we use FirstReversed. The
      -- matcher is there so we don't re-offer dependencies we dropped in the
      -- previous run.
      WhichChanges
-> String
-> (PatchInfo -> Bool)
-> SelectionConfig (PatchInfoAnd p)
forall {p :: * -> * -> *}.
WhichChanges
-> String
-> (PatchInfo -> Bool)
-> SelectionConfig (PatchInfoAndG p)
selectionConfigDepends WhichChanges
FirstReversed String
"depend on" (PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PatchInfo]
dropped)
  [PatchInfo] -> IO [PatchInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PatchInfo] -> IO [PatchInfo]) -> [PatchInfo] -> IO [PatchInfo]
forall a b. (a -> b) -> a -> b
$ [PatchInfo]
keep [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
`union` RL (PatchInfoAnd p) wZ wZ -> [PatchId (PatchInfoAnd p)]
forall (p :: * -> * -> *) wX wY.
(Commute p, Ident p) =>
RL p wX wY -> [PatchId p]
independentPatchIds (FL (PatchInfoAnd p) wZ wZ -> RL (PatchInfoAnd p) wZ wZ
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd p) wZ wZ
candidates)
  where
    selectionConfigDepends :: WhichChanges
-> String
-> (PatchInfo -> Bool)
-> SelectionConfig (PatchInfoAndG p)
selectionConfigDepends WhichChanges
whch String
name PatchInfo -> Bool
matchFn =
      PSC
        { opts :: PatchSelectionOptions
opts = PatchSelectionOptions
ps_opts {matchFlags = [], interactive = True}
        , splitter :: Maybe (Splitter (PatchInfoAndG p))
splitter = Maybe (Splitter (PatchInfoAndG p))
forall a. Maybe a
Nothing
        , files :: Maybe [AnchoredPath]
files = Maybe [AnchoredPath]
forall a. Maybe a
Nothing
        , matchCriterion :: MatchCriterion (PatchInfoAndG p)
matchCriterion =
            MatchCriterion
              {mcHasNonrange :: Bool
mcHasNonrange = Bool
True, mcFunction :: forall wA wB. PatchInfoAndG p wA wB -> Bool
mcFunction = PatchInfo -> Bool
matchFn (PatchInfo -> Bool)
-> (PatchInfoAndG p wA wB -> PatchInfo)
-> PatchInfoAndG p wA wB
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG p wA wB -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info}
        , jobname :: String
jobname = String
name
        , allowSkipAll :: Bool
allowSkipAll = Bool
True
        , whichChanges :: WhichChanges
whichChanges = WhichChanges
whch
        }

-- | From an 'RL' of patches select the identities of those that are
-- not depended upon by later patches.
independentPatchIds :: (Commute p, Ident p) => RL p wX wY -> [PatchId p]
independentPatchIds :: forall (p :: * -> * -> *) wX wY.
(Commute p, Ident p) =>
RL p wX wY -> [PatchId p]
independentPatchIds RL p wX wY
NilRL = []
independentPatchIds (RL p wX wY
ps :<: p wY wY
p) =
  case (:>) (RL p) p wX wY -> (:>) (RL p) (p :> RL p) wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> (:>) (RL p) (p :> RL p) wX wY
commuteWhatWeCanRL (RL p wX wY
ps RL p wX wY -> p wY wY -> (:>) (RL p) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wY wY
p) of
    RL p wX wZ
_ :> p wZ wZ
_ :> RL p wZ wY
non_deps ->
      p wY wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wY wY
p PatchId p -> [PatchId p] -> [PatchId p]
forall a. a -> [a] -> [a]
: RL p wZ wY -> [PatchId p]
forall (p :: * -> * -> *) wX wY.
(Commute p, Ident p) =>
RL p wX wY -> [PatchId p]
independentPatchIds RL p wZ wY
non_deps