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

module Darcs.UI.SelectChanges
    ( -- * Working with changes
      WhichChanges(..)
    , viewChanges
    , withSelectedPatchFromRepo
    , runSelection
    , selectionContextPrim
    , selectionContextGeneric
    , selectionContext
    , PatchSelectionContext(allowSkipAll)
    , printSummary
    -- * Interactive selection utils
    , PatchSelectionOptions(..)
    , InteractiveSelectionM
    , InteractiveSelectionContext(..)
    -- ** Navigating the patchset
    , currentPatch
    , skipMundane
    , skipOne
    , backOne
    , backAll
    , showCur
    -- ** Decisions
    , decide
    , decideWholeFile
    -- ** Prompts and queries
    , isSingleFile
    , currentFile
    , promptUser
    , prompt
    , KeyPress(..)
    , keysFor
    , helpFor
    , askAboutDepends
    ) where

import Prelude ()
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, catMaybes )
import System.Exit ( exitSuccess )

import Darcs.Patch
    ( IsRepoType, RepoPatch, PrimOf
    , commuteFLorComplain, invert
    , listTouchedFiles, fromPrims
    )
import qualified Darcs.Patch ( thing, things, summary )
import Darcs.Patch.Apply ( Apply, ApplyState )
import Darcs.Patch.Choices
    ( PatchChoices, Slot (..), LabelledPatch
    , mkPatchChoices, forceFirsts
    , 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.Info ( PatchInfo )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.Invert ( Invert )
import Darcs.Patch.Match ( haveNonrangeMatch, matchAPatch )
import Darcs.Patch.Named.Wrapped ( anonymous )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, n2pia )
import Darcs.Patch.Set ( PatchSet(..), patchSet2RL )
import Darcs.Patch.Show ( ShowPatch, ShowContextPatch )
import Darcs.Patch.Split ( Splitter(applySplitter,canonizeSplit) )
import Darcs.Patch.TouchesFiles ( selectNotTouching, deselectNotTouching )
import Darcs.Patch.Type ( PatchType (..) )
import Darcs.Patch.Witnesses.Eq ( unsafeCompare )
import Darcs.Patch.Witnesses.Ordered
    ( (:>) (..), (:||:) (..), FL (..)
    , RL (..), filterFL, lengthFL, mapFL
    , mapFL_FL, spanFL, spanFL_M
    , (+>+), (+<<+), (+>>+)
    )
import Darcs.Patch.Witnesses.Sealed
    ( FlippedSeal (..), Sealed2 (..)
    , flipSeal, seal2, unseal2
    )
import Darcs.Patch.Witnesses.WZipper
    ( FZipper (..), left, right
    , rightmost, toEnd, toStart
    )
import Darcs.Repository ( Repository, repoLocation, readRepo, readTentativeRepo )
import Darcs.UI.External ( editText )
import Darcs.UI.Options.All
    ( Verbosity(..), Summary(..)
    , WithContext(..), SelectDeps(..), MatchFlag )
import Darcs.UI.PrintPatch
    ( printFriendly, printPatch
    , printPatchPager, showFriendly )
import Darcs.Util.English ( Noun (..), englishNum, capitalize )
import Darcs.Util.Printer ( prefix, putDocLn, putDocLnWith, greenText )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Prompt ( PromptConfig (..), askUser, 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 (Eq, 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 w = w == Last || w == FirstReversed

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

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

data PatchSelectionOptions = PatchSelectionOptions
  { verbosity :: Verbosity
  , matchFlags :: [MatchFlag]
  , interactive :: Bool
  , selectDeps :: SelectDeps
  , summary :: Summary
  , withContext :: WithContext
  }

-- | A @PatchSelectionContext@ contains all the static settings for selecting
-- patches. See "PatchSelectionM"
data PatchSelectionContext p = PSC { opts :: PatchSelectionOptions
                                   , splitter :: Maybe (Splitter p)
                                   , files :: Maybe [FilePath]
                                   , matchCriterion :: MatchCriterion p
                                   , jobname :: String
                                   , allowSkipAll :: Bool
                                   , pristine :: Maybe (Tree IO)
                                   , whichChanges :: WhichChanges
                                   }

-- | A 'PatchSelectionContext' for selecting 'Prim' patches.
selectionContextPrim :: WhichChanges
                     -> String
                     -> PatchSelectionOptions
                     -> Maybe (Splitter prim)
                     -> Maybe [FilePath]
                     -> Maybe (Tree IO)
                     -> PatchSelectionContext prim
selectionContextPrim whch jn o spl fs p =
 PSC { opts = o
     , splitter = spl
     , files = fs
     , matchCriterion = triv
     , jobname = jn
     , allowSkipAll = True
     , pristine = p
     , whichChanges = whch
     }

-- | A 'PatchSelectionContext' for selecting full patches ('PatchInfoAnd' patches)
selectionContext :: (IsRepoType rt, RepoPatch p)
                 => WhichChanges -> String -> PatchSelectionOptions
                 -> Maybe (Splitter (PatchInfoAnd rt p))
                 -> Maybe [FilePath]
                 -> PatchSelectionContext (PatchInfoAnd rt p)
selectionContext whch jn o spl fs =
 PSC { opts = o
     , splitter = spl
     , files = fs
     , matchCriterion = iswanted seal2 (matchFlags o)
     , jobname = jn
     , allowSkipAll = True
     , pristine = Nothing
     , whichChanges = whch
     }

-- | A generic 'PatchSelectionContext'.
selectionContextGeneric :: (IsRepoType rt, RepoPatch p, Invert q)
                        => (forall wX wY . q wX wY -> Sealed2 (PatchInfoAnd rt p))
                        -> WhichChanges
                        -> String
                        -> PatchSelectionOptions
                        -> Maybe [FilePath]
                        -> PatchSelectionContext q
selectionContextGeneric extract whch jn o fs =
 PSC { opts = o
     , splitter = Nothing
     , files = fs
     , matchCriterion = iswanted extract (matchFlags o)
     , jobname = jn
     , allowSkipAll = True
     , pristine = Nothing
     , whichChanges = whch
     }

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

type PatchSelectionM p a = ReaderT (PatchSelectionContext p) a

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

-- Common match criteria

-- | For commands without @--match@, 'triv' matches all patches
triv :: MatchCriterion p
triv = MatchCriterion { mcHasNonrange = False, mcFunction = \ _ _ -> True }

-- | 'iswanted' selects patches according to the given match flags
iswanted :: forall rt p q
          . (IsRepoType rt, RepoPatch p, Invert q)
         => (forall wX wY . q wX wY -> Sealed2 (PatchInfoAnd rt p))
         -> [MatchFlag]
         -> MatchCriterion q
iswanted extract mflags = MatchCriterion
    { mcHasNonrange = haveNonrangeMatch (PatchType :: PatchType rt p) mflags
    , mcFunction = isWantedMcFunction
    }
  where
    isWantedMcFunction w = unseal2 (matchAPatch mflags) . extract_reverse w . unLabel
    -- TODO inverting should not be necessary here, at least I would expect
    --
    -- prop> matchAPatch (invert x) == matchAPatch x
    extract_reverse w = if reversed w then extract . invert else extract

-- | Run a 'PatchSelection' action in the given 'PatchSelectionContext'.
runSelection :: forall p wX wY . ( Invert p, Commute p, Apply p, PatchInspect p, ShowPatch p
                                 , ShowContextPatch p, ApplyState p ~ Tree )
             => FL p wX wY
             -> PatchSelectionContext p
             -> IO ((FL p :> FL p) wX wY)
runSelection ps psc = runReaderT (selection ps) psc where
  selection
    | reversed whch = fmap invert . doit . invert
    | otherwise = 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 =
    fmap (canonizeAfterSplitter . selectedPatches) .
    selectChanges . filterNotTouching . filterUnwanted . patchChoices

  -- configuration
  whch = whichChanges psc
  fs = files psc
  os = opts psc
  crit = matchCriterion psc
  mspl = splitter 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 (x :> y) =
    let canonizeIfNeeded = maybe id canonizeSplit mspl
    in canonizeIfNeeded x :> canonizeIfNeeded y

  -- retrieve the results of patch selection
  selectedPatches :: PatchChoices p wA wB -> (FL p :> FL p) wA wB
  selectedPatches pc
    | backward whch =
        case getChoices pc of
          fc :> mc :> lc -> mapFL_FL unLabel (fc +>+ mc) :> mapFL_FL unLabel lc
    | otherwise =
        case separateFirstFromMiddleLast pc of
          xs :> ys -> mapFL_FL unLabel xs :> mapFL_FL unLabel ys

  selectChanges :: PatchChoices p wA wB
                -> PatchSelectionM p IO (PatchChoices p wA wB)
  selectChanges
    | interactive os = refineChoices textSelect
    | otherwise      = return . promote

  promote
    | backward whch = makeEverythingLater
    | otherwise     = makeEverythingSooner
  demote
    | backward whch = makeEverythingSooner
    | otherwise     = makeEverythingLater

  filterNotTouching
    | backward whch = selectNotTouching fs
    | otherwise     = deselectNotTouching fs

  -- when using @--match@, remove unmatched patches
  -- not depended upon by matched patches
  filterUnwanted :: PatchChoices p wA wB -> PatchChoices p wA wB
  filterUnwanted
    | mcHasNonrange crit =
        case selectDeps os of
          NoDeps -> deselectUnwanted
          _      -> demote . selectWanted
    | otherwise = id

  selectWanted
    | backward whch = forceMatchingLast iswanted_
    | otherwise     = forceMatchingFirst iswanted_
  deselectUnwanted
    | backward whch = forceMatchingFirst (not . iswanted_)
    | otherwise     = forceMatchingLast (not . iswanted_)
  iswanted_ = mcFunction crit whch

  {- end of runSelection -}

-- | The equivalent of 'runSelection' for the @darcs log@ command
viewChanges :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
            => PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges ps_opts = textView ps_opts Nothing 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 { kp     :: Char
                           , kpHelp :: String }

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

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

-- | The function for selecting a patch to amend record. Read at your own risks.
withSelectedPatchFromRepo
    :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
    => String   -- name of calling command (always "amend" as of now)
    -> Repository rt p wR wU wT
    -> PatchSelectionOptions
    -> (forall wA . (FL (PatchInfoAnd rt p) :> PatchInfoAnd rt p) wA wR -> IO ())
    -> IO ()
withSelectedPatchFromRepo jn repository o job = do
    patchSet <- readRepo repository
    sp <- wspfr jn (matchAPatch $ matchFlags o) (patchSet2RL patchSet) NilFL
    case sp of
        Just (FlippedSeal (skipped :> selected')) -> job (skipped :> selected')
        Nothing ->
            putStrLn $ "Cancelling " ++ jn ++ " since no patch was selected."

data SkippedReason = SkippedAutomatically | SkippedManually

data WithSkipped p wX wY = WithSkipped
    { _skippedReason :: SkippedReason
    , 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 rt p wX wY wU. (RepoPatch p, ApplyState p ~ Tree)
      => String
      -> (forall wA wB . (PatchInfoAnd rt p) wA wB -> Bool)
      -> RL (PatchInfoAnd rt p) wX wY
      -> FL (WithSkipped (PatchInfoAnd rt p)) wY wU
      -> IO (Maybe (FlippedSeal (FL (PatchInfoAnd rt p) :> PatchInfoAnd rt p) wU))
wspfr _ _ NilRL _ = return Nothing
wspfr jn matches remaining@(pps:<:p) skipped
    | not $ matches p = wspfr jn matches pps
                            (WithSkipped SkippedAutomatically p :>: skipped)
    | otherwise =
    case commuteFLorComplain (p :> mapFL_FL skippedPatch skipped) of
    Left _  -> do putStrLn "\nSkipping depended-upon patch:"
                  defaultPrintFriendly p
                  wspfr jn matches pps (WithSkipped SkippedAutomatically p :>: skipped)

    Right (skipped' :> p') -> do
        defaultPrintFriendly p
        yorn <- promptChar
                    PromptConfig { pPrompt = prompt'
                                 , pBasicCharacters = keysFor basicOptions
                                 , pAdvancedCharacters = keysFor advancedOptions
                                 , pDefault = Just 'n'
                                 , pHelp = "?h" }
        case yorn of
            'y' -> return $ Just $ flipSeal $ skipped' :> p'
            'n' -> nextPatch
            'j' -> nextPatch
            'k' -> previousPatch remaining skipped
            'v' -> printPatch p >> repeatThis
            'p' -> printPatchPager p >> repeatThis
            'x' -> do putDocLn $ prefix "    " $ Darcs.Patch.summary p
                      repeatThis
            'q' -> do putStrLn $ (capitalize jn) ++ " cancelled."
                      exitSuccess
            _   -> do putStrLn $ helpFor jn basicOptions advancedOptions
                      repeatThis
  where repeatThis = wspfr jn matches (pps:<:p) skipped
        prompt' = "Shall I " ++ jn ++ " this patch?"
        nextPatch = wspfr jn matches pps (WithSkipped SkippedManually p:>:skipped)
        previousPatch :: RL (PatchInfoAnd rt p) wX wQ
                      -> FL (WithSkipped (PatchInfoAnd rt p)) wQ wU
                      -> IO (Maybe (FlippedSeal
                              (FL (PatchInfoAnd rt p) :> PatchInfoAnd rt p) wU))
        previousPatch remaining' NilFL = wspfr jn matches remaining' NilFL
        previousPatch remaining' (WithSkipped sk prev :>: skipped'') =
            case sk of
                SkippedManually -> wspfr jn matches (remaining' :<: prev) skipped''
                SkippedAutomatically -> previousPatch (remaining' :<: prev) skipped''
        basicOptions =
                    [[ KeyPress 'y' (jn ++ " this patch")
                     , KeyPress 'n' ("don't " ++ jn ++ " it")
                     , KeyPress 'j' "skip to next patch"
                     , KeyPress 'k' "back up to previous patch"
                    ]]
        advancedOptions =
                    [[ KeyPress 'v' "view this patch in full"
                     , KeyPress 'p' "view this patch in full with pager"
                     , KeyPress 'x' "view a summary of this patch"
                     , KeyPress 'q' ("cancel " ++ jn)
                    ]]
        defaultPrintFriendly =
          printFriendly Nothing NormalVerbosity NoSummary NoContext

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

-- | @justDone n@ notes that @n@ patches have just been processed
justDone :: Int -> InteractiveSelectionM p wX wY ()
justDone n = modify $ \isc -> isc{ current = current isc + n}

-- | 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 lps' pcs = do
    userSelection <- execStateT (skipMundane >>
                                 showCur >>
                                 textSelectIfAny)
                     ISC { total = lengthFL lps'
                         , current = 0
                         , lps = FZipper NilRL lps'
                         , choices = pcs }
    return $ choices userSelection
    where textSelectIfAny = do
            z <- gets lps
            unless (rightmost z) $
              textSelect'

textSelect' :: ( Commute p, Invert p, ShowPatch p, ShowContextPatch p
               , PatchInspect p, ApplyState p ~ Tree )
            => InteractiveSelectionM p wX wY ()
textSelect' = do
  z <- gets lps
  done <- if not $ rightmost z
           then textSelectOne
           else lastQuestion
  unless done $ textSelect'

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

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

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

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

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

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

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

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

options :: (ShowPatch p)
        => Bool
        -> InteractiveSelectionM p wX wY ([[KeyPress]],[[KeyPress]])
options single = do
  split <- asks splitter
  jn <- asks jobname
  allowsa <- asks allowSkipAll
  aThing <- thing
  someThings <- things
  o <- asks opts
  return ([optionsBasic jn aThing]
         ,[optionsSplit split aThing]
         ++ [optionsFile jn | single]
         ++ [optionsView aThing someThings ++
                if summary o == YesSummary
                    then []
                    else optionsSummary aThing]
         ++ [optionsQuit jn allowsa someThings]
         ++ [optionsNav aThing False]
         )

-- | Returns a @Sealed2@ version of the patch we are asking the user
-- about.
currentPatch :: InteractiveSelectionM p wX wY (Maybe (Sealed2 (LabelledPatch p)))
currentPatch = do
  FZipper _ lps_todo <- gets lps
  case lps_todo of
    NilFL -> return Nothing
    (lp:>:_) -> return $ Just (Sealed2 lp)

-- | Returns the patches we have yet to ask the user about.
todo :: InteractiveSelectionM p wX wY (FlippedSeal (FL (LabelledPatch p)) wY)
todo = do
    (FZipper _ lps_todo) <- gets lps
    return (FlippedSeal lps_todo)

-- | Modify the underlying @PatchChoices@ by some function
modifyChoices :: (PatchChoices p wX wY -> PatchChoices p wX wY)
              -> InteractiveSelectionM p wX wY ()
modifyChoices f = modify $ \isc -> isc{choices = f $ choices isc}

-- | returns @Just f@ if the 'currentPatch' only modifies @f@,
-- @Nothing@ otherwise.
currentFile :: (PatchInspect p)
            => InteractiveSelectionM p wX wY (Maybe FilePath)
currentFile = do
  c <- currentPatch
  return $ case c of
             Nothing -> Nothing
             Just (Sealed2 lp) ->
                 case listTouchedFiles lp of
                   [f] -> Just f
                   _ -> Nothing

-- | @decide True@ selects the current patch, and @decide False@ deselects
-- it.
decide :: Commute p
       => Bool
       -> LabelledPatch p wT wU
       -> InteractiveSelectionM p wX wY ()
decide takeOrDrop lp = do
    whch <- asks whichChanges
    if backward whch == takeOrDrop -- we go backward xor we are dropping
    then modifyChoices $ forceLast (label lp)
    else modifyChoices $ forceFirst (label lp)

-- | like 'decide', but for all patches touching @file@
decideWholeFile :: (Commute p, PatchInspect p)
                => FilePath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile file takeOrDrop =
    do
      FlippedSeal lps_todo <- todo
      let patches_to_skip =
              filterFL (\lp' -> listTouchedFiles lp' == [file]) lps_todo
      mapM_ (unseal2 $ decide takeOrDrop) patches_to_skip

-- | Undecide the current patch.
postponeNext :: Commute p => InteractiveSelectionM p wX wY ()
postponeNext =
    do
      Just (Sealed2 lp) <- currentPatch
      modifyChoices $ forceMiddle (label lp)

-- | Focus the next patch.
skipOne :: InteractiveSelectionM p wX wY ()
skipOne = modify so
    where so x = x{lps = right (lps x), current = current x +1}

-- | Focus the previous patch.
backOne :: InteractiveSelectionM p wX wY ()
backOne = modify so
    where so isc = 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 s = do
    FZipper lps_done (lp:>:lps_todo) <- gets lps
    case applySplitter s (unLabel lp) of
      Nothing -> return ()
      Just (text, parse) ->
          do
            newText <- liftIO $ editText "darcs-patch-edit" text
            case parse newText of
               Nothing -> return ()
               Just ps -> do
                 lps_new <- liftIO $ return $ labelPatches (Just (label lp)) ps
                 modify $ \isc -> isc { total = total isc + lengthFL lps_new - 1
                                      , lps = FZipper lps_done
                                               (lps_new +>+ lps_todo)
                                      , choices = substitute
                                                   (seal2 (lp :||: lps_new))
                                                   (choices isc)
                                      }

-- | Shows the patch that is actually being selected the way the user
-- should see it.
repr :: Invert p => WhichChanges -> LabelledPatch p wX wY -> Sealed2 p
repr w p
  | reversed w = Sealed2 (invert (unLabel p))
  | otherwise = Sealed2 (unLabel p)

-- | Returns a list of the currently selected patches, in
-- their original context, i.e., not commuted past unselected
-- patches.
selected :: (Commute p, Invert p) => InteractiveSelectionM p wX wY [Sealed2 p]
selected = do
  w <- asks whichChanges
  chs <- gets choices
  (first_chs :> _ :> last_chs) <- return $ getChoices chs
  return $ if backward w then mapFL (repr w) last_chs else mapFL (repr w) first_chs

-- | Prints the list of the selected patches. See 'selected'.
printSelected :: (Invert p, Commute p, ShowPatch p) =>
                InteractiveSelectionM p wX wY ()
printSelected = do
  someThings <- things
  o <- asks opts
  s <- selected
  liftIO $ do
    putDocLnWith fancyPrinters $ greenText $ "---- selected "++someThings++" ----"
    mapM_ (putDocLnWith fancyPrinters . unseal2 (showFriendly (verbosity o) (summary o))) s
    putDocLnWith fancyPrinters $ greenText $ "---- end of selected "++someThings++" ----"

printSummary :: ShowPatch p => p wX wY -> IO ()
printSummary = putDocLn . prefix "    " . Darcs.Patch.summary

-- | Skips all remaining patches.
skipAll ::  InteractiveSelectionM p wX wY ()
skipAll = modify $ \isc -> isc {lps = toEnd $ lps isc}

backAll ::  InteractiveSelectionM p wX wY ()
backAll = modify $ \isc -> isc {lps = toStart $ lps isc
                               ,current = 0}

isSingleFile :: PatchInspect p => p wX wY -> Bool
isSingleFile p = length (listTouchedFiles p) == 1

askConfirmation ::  InteractiveSelectionM p wX wY ()
askConfirmation = do
    jn <- asks jobname
    liftIO $ when (jn `elem` ["unpull", "unrecord", "obliterate"]) $ do
               yorn <- askUser $ "Really " ++ jn ++ " all undecided patches? "
               case yorn of
                 ('y':_) -> return ()
                 _ -> exitSuccess

-- | The singular form of the noun for items of type @p@.
thing :: (ShowPatch p) => InteractiveSelectionM p wX wY String
thing = (Darcs.Patch.thing . helper) `liftM` gets choices
        where
          helper :: PatchChoices p wA wB -> p wA wB
          helper = undefined

-- | The plural form of the noun for items of type @p@.
things :: (ShowPatch p) => InteractiveSelectionM p wX wY String
things = (Darcs.Patch.things . helper) `liftM` gets choices
        where
          helper :: PatchChoices p wA wB -> p wA wB
          helper = undefined

-- | The question to ask about one patch.
prompt :: (ShowPatch p) => InteractiveSelectionM p wX wY String
prompt = do
  jn <- asks jobname
  aThing <- thing
  n <- gets current
  n_max <- gets total
  return $ "Shall I "++jn++" this "++aThing++"? "
             ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") "

-- | Asks the user about one patch, returns their answer.
promptUser :: (ShowPatch p)
           => Bool -> Char -> InteractiveSelectionM p wX wY Char
promptUser single def = do
  thePrompt <- prompt
  (basicOptions,advancedOptions) <- options single
  liftIO $ promptChar PromptConfig { pPrompt = thePrompt
                                   , pBasicCharacters = keysFor basicOptions
                                   , pAdvancedCharacters = keysFor advancedOptions
                                   , pDefault = Just def
                                   , pHelp = "?h"
                                   }

-- | Ask the user what to do with the next patch.
textSelectOne :: ( Invert p, Commute p, ShowPatch p, ShowContextPatch p, PatchInspect p
                 , ApplyState p ~ Tree )
              => InteractiveSelectionM p wX wY Bool
textSelectOne = do
 c <- currentPatch
 case c of
   Nothing -> return False
   Just (Sealed2 lp) ->
       do
         jn <- asks jobname
         spl <- asks splitter
         whichch <- asks whichChanges
         let singleFile = isSingleFile (unLabel lp)
             reprCur = repr whichch lp
         (basicOptions,advancedOptions) <- options singleFile
         theSlot <- liftChoices $ state $ patchSlot lp
         let the_default = getDefault (backward whichch) theSlot
         yorn <- promptUser singleFile the_default
         let nextPatch = skipMundane >> showCur
         case yorn of
               'y' -> decide True lp >> skipOne >> nextPatch
                      >> return False
               'n' -> decide False lp >> skipOne >> nextPatch
                      >> return False
               'w' -> postponeNext >> skipOne >> nextPatch
                      >> return False
               'e' | (Just s) <- spl -> splitCurrent s >> showCur
                                        >> return False
               's' -> currentFile >>= maybe
                       (return ())
                       (\f -> decideWholeFile f False) >> nextPatch
                       >> return False
               'f' -> currentFile >>= maybe
                       (return ())
                       (\f -> decideWholeFile f True) >> nextPatch
                       >> return False
               'v' -> liftIO $ unseal2 printPatch reprCur >> return False
               'p' -> liftIO $ unseal2 printPatchPager reprCur >> return False
               'l' -> printSelected >> showCur >> return False
               'x' -> liftIO $ unseal2 printSummary reprCur >> return False
               'd' -> skipAll >> return True
               'g' -> backAll >> showCur >> return False
               'a' ->
                   do
                     askConfirmation
                     modifyChoices $ selectAllMiddles (backward whichch)
                     skipAll
                     return True
               'q' -> liftIO $
                      do putStrLn $ capitalize jn ++ " cancelled."
                         exitSuccess
               'j' -> skipOne >> showCur >> return False
               'k' -> backOne >> showCur >> return False
               _   -> do
                 liftIO . putStrLn $ helpFor jn basicOptions advancedOptions
                 return False

lastQuestion :: (Commute p, Invert p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
             => InteractiveSelectionM p wX wY Bool
lastQuestion = do
  jn <- asks jobname
  theThings <-things
  aThing <- thing
  let (basicOptions, advancedOptions) = optionsLast jn aThing
  yorn <- liftIO . promptChar $
            PromptConfig { pPrompt = "Do you want to "++capitalize jn++
                                      " these "++theThings++"?"
                         , pBasicCharacters = "yglqk"
                         , pAdvancedCharacters = "dan"
                         , pDefault = Just 'y'
                         , pHelp = "?h"}
  case yorn of c | c `elem` "yda" -> return True
                 | c `elem` "qn" -> liftIO $
                                    do putStrLn $ jn ++" cancelled."
                                       exitSuccess
               'g' -> backAll >> showCur >> return False
               'l' -> printSelected >> return False
               'k' -> backOne >> showCur >> return False
               _ -> do
                 liftIO . putStrLn $ helpFor "this confirmation prompt"
                    basicOptions advancedOptions
                 return False

-- | Shows the current patch as it should be seen by the user.
showCur :: (Invert p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
        => InteractiveSelectionM p wX wY ()
showCur = do
  o <- asks opts
  p <- asks pristine
  c <- currentPatch
  whichch <- asks whichChanges
  case c of
      Nothing -> return ()
      Just (Sealed2 lp) -> do
             let reprCur = repr whichch lp
             liftIO . unseal2 (printFriendly p (verbosity o) (summary o) (withContext o)) $ reprCur

-- | The interactive part of @darcs changes@
textView :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
         => PatchSelectionOptions -> Maybe Int -> Int
         -> [Sealed2 p] -> [Sealed2 p]
         -> IO ()
textView _ _ _ _ [] = return ()
textView o n_max n
            ps_done ps_todo@(p:ps_todo') = do
      unseal2 (printFriendly Nothing (verbosity o) (summary o) (withContext o)) p
      repeatThis -- prompt the user
    where
        prev_patch :: IO ()
        prev_patch = case ps_done of
                       [] -> repeatThis
                       (p':ps_done') ->
                         textView o
                            n_max (n-1) ps_done' (p':ps_todo)
        next_patch :: IO ()
        next_patch = case ps_todo' of
                         [] -> -- May as well work out the length now we have all
                                  -- the patches in memory
                               textView o n_max
                                   n ps_done []
                         _ -> textView o n_max
                                  (n+1) (p:ps_done) ps_todo'
        first_patch = textView o n_max 0 [] (ps_done++ps_todo)
        options_yn =
          [ KeyPress 'y' "view this patch and go to the next"
          , KeyPress 'n' "skip to the next patch" ]
        optionsView' =
          [ KeyPress 'v' "view this patch in full"
          , KeyPress 'p' "view this patch in full with pager" ]
        optionsSummary' =
          [ KeyPress 'x' "view a summary of this patch" ]
        optionsNav' =
          [ KeyPress 'q' "quit view changes"
          , KeyPress 'k' "back up to previous patch"
          , KeyPress 'j' "skip to next patch"
          , KeyPress 'g' "start over from the first patch"
          , KeyPress 'c' "count total patch number" ]
        basicOptions = [ options_yn ]
        advancedOptions =
                     (optionsView' ++
                        if summary o == YesSummary then [] else optionsSummary')
                  : [ optionsNav' ]
        prompt' = "Shall I view this patch? "
               ++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")"
        repeatThis :: IO ()
        repeatThis = do
          yorn <- promptChar (PromptConfig prompt' (keysFor basicOptions) (keysFor advancedOptions) (Just 'n') "?h")
          case yorn of
            'y' -> unseal2 printPatch p >> next_patch
            'n' -> next_patch
            'v' -> unseal2 printPatch p >> repeatThis
            'p' -> unseal2 printPatchPager p >> repeatThis
            'x' -> do putDocLn $ prefix "    " $ unseal2 Darcs.Patch.summary p
                      repeatThis
            'q' -> exitSuccess
            'k' -> prev_patch
            'j' -> next_patch
            'g' -> first_patch
            'c' -> textView o
                       count_n_max n ps_done ps_todo
            _   -> do putStrLn $ helpFor "view changes" basicOptions advancedOptions
                      repeatThis
        count_n_max | isJust n_max = n_max
                    | otherwise    = Just $ length ps_done + length ps_todo

-- | Skips patches we should not ask the user about
skipMundane :: (Commute p, ShowPatch p)
            => InteractiveSelectionM p wX wY ()
skipMundane = do
  (FZipper lps_done lps_todo) <- gets lps
  o <- asks opts
  crit <- asks matchCriterion
  jn <- asks jobname
  whichch <- asks whichChanges
  (skipped :> unskipped) <- liftChoices $ spanFL_M
                                 (state . patchSlot >=> return . decided)
                                 lps_todo
  let numSkipped = lengthFL skipped
  when (numSkipped > 0) . liftIO $ show_skipped o jn numSkipped skipped
  let boringThenInteresting =
          if selectDeps o == AutoDeps
          then spanFL (not. mcFunction crit whichch)
                                 unskipped
          else NilFL :> unskipped
  case boringThenInteresting of
    boring :> interesting ->
        do
          justDone $ lengthFL boring + numSkipped
          modify $ \isc -> isc {lps = FZipper (lps_done +<<+ skipped +<<+ boring)
                                      interesting}
    where
      show_skipped o jn n ps = do putStrLn $ _nevermind_ jn ++ _these_ n ++ "."
                                  when (verbosity o == Verbose) $
                                       showskippedpatch ps
      _nevermind_ jn = "Will not ask whether to " ++ jn ++ " "
      _these_ n  = show n ++ " already decided " ++ _elem_ n ""
      _elem_ n = englishNum n (Noun "patch")
      showskippedpatch :: ShowPatch p => FL (LabelledPatch p) wY wT -> IO ()
      showskippedpatch = sequence_ . mapFL (printSummary . unLabel)

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

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

askAboutDepends :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                => Repository rt p wR wU wT -> FL (PrimOf p) wT wY
                -> PatchSelectionOptions
                -> [PatchInfo] -> IO [PatchInfo]
askAboutDepends repository pa' ps_opts 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.
  pps <- readTentativeRepo repository (repoLocation repository)
  pa <- n2pia `fmap` anonymous (fromPrims pa')
  -- FIXME: this code is completely unreadable
  FlippedSeal ps <-
    return $ case pps of PatchSet _ x -> FlippedSeal (x+>>+(pa:>:NilFL))
  let my_lps = labelPatches Nothing ps
      pc = mkPatchChoices my_lps
      tas =
        case catMaybes (mapFL (\lp -> if pa `unsafeCompare` unLabel lp || info (unLabel lp) `elem` olddeps
                                          then Just (label lp) else Nothing) my_lps) of

                [] -> error "askAboutDepends: []"
                tgs -> tgs
  Sealed2 ps' <- return $
    case getChoices (forceFirsts tas pc) of
      _ :> mc :> _ -> Sealed2 $ mapFL_FL unLabel mc
  (deps:>_) <- runSelection ps' $
                 selectionContext FirstReversed "depend on" ps_opts
                    { matchFlags = [], interactive = True } Nothing Nothing
  return $ olddeps `union` mapFL info deps