--  Copyright (C) 2002-2004 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 OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module Darcs.UI.Commands.WhatsNew
    ( whatsnew
    , status
    ) where

import Darcs.Prelude

import Control.Monad ( void, when )
import Control.Monad.Reader ( runReaderT )
import Control.Monad.State ( evalStateT, liftIO )
import Data.Maybe ( isJust )
import System.Exit ( ExitCode (..), exitSuccess, exitWith )

import Darcs.Patch
    ( PrimOf, PrimPatch, RepoPatch
    , applyToTree, plainSummaryPrims
    )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Choices ( mkPatchChoices, labelPatches, unLabel )
import Darcs.Patch.Commute ( Commute )
import Darcs.Patch.FileHunk ( IsHunk (..) )
import Darcs.Patch.Inspect ( PatchInspect (..) )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.Prim.Class ( PrimDetails (..) )
import Darcs.Patch.Show
    ( ShowContextPatch
    , ShowPatch(..)
    , ShowPatchBasic(..)
    , displayPatch
    )
import Darcs.Patch.TouchesFiles ( chooseTouching )
import Darcs.Patch.Witnesses.Ordered
    ( (:>) (..), FL (..)
    , reverseFL, reverseRL
    )
import Darcs.Patch.Witnesses.Sealed
    ( Sealed (..), Sealed2 (..)
    , unFreeLeft
    )
import Darcs.Repository
    ( RepoJob (..), Repository, AccessType(RO)
    , readPristine
    , unrecordedChanges, withRepository
    )
import Darcs.Repository.Diff ( treeDiff )
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.UI.Commands
    ( DarcsCommand(..), withStdOpts, amInRepository
    , commandAlias, nodefaults
    )
import Darcs.UI.Completion ( modifiedFileArgs )
import Darcs.UI.Commands.Util ( announceFiles, filterExistingPaths )
import Darcs.UI.External ( viewDocWith )
import Darcs.UI.Flags
    ( DarcsFlag, diffAlgorithm
    , useCache, pathSetFromArgs
    , verbosity, isInteractive
    , diffingOpts
    )
import Darcs.UI.Options ( (^), parseFlags, (?), oid )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PrintPatch ( contextualPrintPatchWithPager )
import Darcs.UI.SelectChanges
    ( InteractiveSelectionM, KeyPress (..)
    , WhichChanges (..)
    , initialSelectionState
    , backAll
    , backOne, currentFile
    , currentPatch, decide
    , decideWholeFile, helpFor
    , keysFor, prompt
    , selectionConfigPrim, skipMundane
    , skipOne
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Util.Path ( AbsolutePath, AnchoredPath )
import Darcs.Util.Printer
    ( Doc, formatWords, putDocLn, putDocLnWith, renderString
    , text, vcat, ($+$)
    )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Prompt ( PromptConfig (..), promptChar )
import Darcs.Util.Tree ( Tree )

patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
flags = S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , matchFlags :: [MatchFlag]
S.matchFlags = []
    , interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
    , selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps -- option not supported, use default
    , withSummary :: WithSummary
S.withSummary = [DarcsFlag] -> WithSummary
getSummary [DarcsFlag]
flags
    }

-- lookForAdds and machineReadable set YesSummary
-- unless NoSummary was given expressly
-- (or by default e.g. status)
getSummary :: [DarcsFlag] -> O.WithSummary
getSummary :: [DarcsFlag] -> WithSummary
getSummary [DarcsFlag]
flags = case Maybe WithSummary
-> forall {a}.
   PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe WithSummary)
O.maybeSummary Maybe WithSummary
forall a. Maybe a
Nothing (forall {a}.
 PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe WithSummary))
-> [DarcsFlag] -> Maybe WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags of
  Just WithSummary
O.NoSummary -> WithSummary
O.NoSummary
  Just WithSummary
O.YesSummary -> WithSummary
O.YesSummary
  Maybe WithSummary
Nothing
    | LookForAdds -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a LookForAdds
PrimDarcsOption LookForAdds
O.lookforadds PrimDarcsOption LookForAdds -> [DarcsFlag] -> LookForAdds
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags) -> WithSummary
O.YesSummary
    | PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.machineReadable PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags -> WithSummary
O.YesSummary
    | Bool
otherwise -> WithSummary
O.NoSummary

whatsnew :: DarcsCommand
whatsnew :: DarcsCommand
whatsnew = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"whatsnew"
    , commandHelp :: Doc
commandHelp = Doc
whatsnewHelp
    , commandDescription :: String
commandDescription = String
whatsnewDescription
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
whatsnewCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
modifiedFileArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
whatsnewOpts
    }
  where
    whatsnewBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
whatsnewBasicOpts
      = Maybe WithSummary
-> forall {a}.
   PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe WithSummary)
O.maybeSummary Maybe WithSummary
forall a. Maybe a
Nothing
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption WithContext
O.withContext
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption Bool
O.machineReadable
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ LookForAdds -> PrimDarcsOption LookForAdds
O.maybelookforadds LookForAdds
O.NoLookForAdds
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption LookForReplaces
O.lookforreplaces
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption LookForMoves
O.lookformoves
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> a)
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     (Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> a)
  (Maybe String -> Maybe Bool -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
PrimDarcsOption (Maybe Bool)
O.interactive -- False
    whatsnewOpts :: CommandOptions
whatsnewOpts = DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
withStdOpts DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
whatsnewBasicOpts DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
forall (d :: * -> *) f a. OptSpec d f a a
oid

whatsnewDescription :: String
whatsnewDescription :: String
whatsnewDescription = String
"List unrecorded changes in the working tree."

whatsnewHelp :: Doc
whatsnewHelp :: Doc
whatsnewHelp =
  [String] -> Doc
formatWords
  [ String
"The `darcs whatsnew` command lists unrecorded changes to the working"
  , String
"tree.  If you specify a set of files and directories, only unrecorded"
  , String
"changes to those files and directories are listed."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"With the `--summary` option, the changes are condensed to one line per"
  , String
"file, with mnemonics to indicate the nature and extent of the change."
  , String
"The `--look-for-adds` option causes candidates for `darcs add` to be"
  , String
"included in the summary output.  WithSummary mnemonics are as follows:"
  ]
  -- TODO autoformat bullet lists
  Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat
  [ Doc
"  * `A f` and `A d/` respectively mean an added file or directory."
  , Doc
"  * `R f` and `R d/` respectively mean a removed file or directory."
  , Doc
"  * `M f -N +M rP` means a modified file, with `N` lines deleted, `M`"
  , Doc
"    lines added, and `P` lexical replacements."
  , Doc
"  * `f -> g` means a moved file or directory."
  , Doc
"  * `a f` and `a d/` respectively mean a new, but unadded, file or"
  , Doc
"    directory, when using `--look-for-adds`."
  , Doc
"  * An exclamation mark (!) as in `R! foo.c`, means the change"
  , Doc
"    conflicts with a change in an earlier patch. The phrase `duplicated`"
  , Doc
"    means the change is identical to a change in an earlier patch."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"The `--machine-readable` option implies `--summary` while making it more"
  , String
"parsable. Modified files are only shown as `M f`, and moves are shown in"
  , String
"two lines: `F f` and `T g` (as in 'From f To g')."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"By default, `darcs whatsnew` uses Darcs' internal format for changes."
  , String
"To see some context (unchanged lines) around each change, use the"
  , String
"`--unified` option. (This option has no effect in interactive mode.)"
  , String
"To view changes in conventional `diff` format, use"
  , String
"the `darcs diff` command; but note that `darcs diff` cannot properly"
  , String
"display changes when file renames are involved."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"This command exits unsuccessfully (returns a non-zero exit status) if"
  , String
"there are no unrecorded changes."
  ]

whatsnewCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
whatsnewCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
whatsnewCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
args =
   UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \(Repository 'RO p wU wR
repo :: Repository 'RO p wU wR) -> do
    Maybe [AnchoredPath]
existing_files <- do
      Maybe [AnchoredPath]
files <- (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
      Maybe ([AnchoredPath], [AnchoredPath])
files' <-
        ([AnchoredPath] -> IO ([AnchoredPath], [AnchoredPath]))
-> Maybe [AnchoredPath]
-> IO (Maybe ([AnchoredPath], [AnchoredPath]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse
          (Repository 'RO p wU wR
-> Verbosity
-> DiffOpts
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> Verbosity
-> DiffOpts
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
filterExistingPaths Repository 'RO p wU wR
repo (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts)) Maybe [AnchoredPath]
files
      let files'' :: Maybe [AnchoredPath]
files'' = (([AnchoredPath], [AnchoredPath]) -> [AnchoredPath])
-> Maybe ([AnchoredPath], [AnchoredPath]) -> Maybe [AnchoredPath]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([AnchoredPath], [AnchoredPath]) -> [AnchoredPath]
forall a b. (a, b) -> b
snd Maybe ([AnchoredPath], [AnchoredPath])
files'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [AnchoredPath]
files'' Maybe [AnchoredPath] -> Maybe [AnchoredPath] -> Bool
forall a. Eq a => a -> a -> Bool
== [AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"None of the files you specified exist."
      Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [AnchoredPath]
files''

    -- get all unrecorded changes, possibly including unadded or even boring
    -- files if the appropriate options were supplied
    Sealed FL (PrimOf p) wR wX
allInterestingChanges <-
      DiffOpts
-> Repository 'RO p wU wR
-> Maybe [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wR))
forall (rt :: AccessType) (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wR))
filteredUnrecordedChanges ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts) Repository 'RO p wU wR
repo Maybe [AnchoredPath]
existing_files

    -- get the recorded state
    Tree IO
pristine <- Repository 'RO p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository 'RO p wU wR
repo

    -- the case --look-for-adds and --summary must be handled specially
    -- in order to distinguish added and unadded files

    -- TODO: it would be nice if we could return the pair
    -- (noLookChanges,unaddedNewPathsPs) in one go and also
    -- with proper witnesses (e.g. as noLookChanges +>+ unaddedNewPathsPs)
    -- This would also obviate the need for samePatchType.
    Sealed FL (PrimOf p) wR wX
noLookChanges <-
      if Bool
haveLookForAddsAndSummary
        then
          -- do *not* look for adds here:
          let dopts :: DiffOpts
dopts = [DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts
          in DiffOpts
-> Repository 'RO p wU wR
-> Maybe [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wR))
forall (rt :: AccessType) (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wR))
filteredUnrecordedChanges
                DiffOpts
dopts {O.lookForAdds = O.NoLookForAdds} Repository 'RO p wU wR
repo Maybe [AnchoredPath]
existing_files
        else Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PrimOf p) wR wR -> Sealed (FL (PrimOf p) wR)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PrimOf p) wR wR
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
    Sealed FL (PrimOf p) Any wX
unaddedNewPathsPs <-
      if Bool
haveLookForAddsAndSummary
        then do
          Tree IO
noLookAddsTree <- FL (PrimOf p) wR wX -> Tree IO -> IO (Tree IO)
forall {p :: * -> * -> *} {m :: * -> *} {wX} {wY}.
(ApplyState p ~ Tree, Commute p, IsHunk p, Apply p,
 MonadThrow m) =>
FL p wX wY -> Tree m -> m (Tree m)
applyAddPatchesToPristine FL (PrimOf p) wR wX
noLookChanges Tree IO
pristine
          Tree IO
lookAddsTree <- FL (PrimOf p) wR wX -> Tree IO -> IO (Tree IO)
forall {p :: * -> * -> *} {m :: * -> *} {wX} {wY}.
(ApplyState p ~ Tree, Commute p, IsHunk p, Apply p,
 MonadThrow m) =>
FL p wX wY -> Tree m -> m (Tree m)
applyAddPatchesToPristine FL (PrimOf p) wR wX
allInterestingChanges Tree IO
pristine
          String -> FileType
ftf <- IO (String -> FileType)
filetypeFunction
          -- Return the patches that create files/dirs that aren't yet added.
          FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) Any)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) Any))
-> IO (FreeLeft (FL (PrimOf p))) -> IO (Sealed (FL (PrimOf p) Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiffAlgorithm
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL (PrimOf p)))
forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String -> FileType
ftf Tree IO
noLookAddsTree Tree IO
lookAddsTree
        else Sealed (FL (PrimOf p) Any) -> IO (Sealed (FL (PrimOf p) Any))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PrimOf p) Any Any -> Sealed (FL (PrimOf p) Any)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PrimOf p) Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
    -- avoid ambiguous typing for unaddedNewPathsPs:
    FL (PrimOf p) wR wX -> FL (PrimOf p) Any wX -> IO ()
forall (p :: * -> * -> *) wX wY wU wV.
FL p wX wY -> FL p wU wV -> IO ()
samePatchType FL (PrimOf p) wR wX
noLookChanges FL (PrimOf p) Any wX
unaddedNewPathsPs

    FL (PrimOf p) wR wX -> IO ()
forall (p :: * -> * -> *) wX wY. FL p wX wY -> IO ()
exitOnNoChanges FL (PrimOf p) wR wX
allInterestingChanges
    Verbosity -> Maybe [AnchoredPath] -> String -> IO ()
announceFiles (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Maybe [AnchoredPath]
existing_files String
"What's new in"
    if [DarcsFlag] -> Bool
maybeIsInteractive [DarcsFlag]
opts
      then
        InteractiveSelectionM (PrimOf p) wR wX ()
-> PatchSelectionOptions -> FL (PrimOf p) wR wX -> IO ()
forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY ()
-> PatchSelectionOptions -> FL p wX wY -> IO ()
runInteractive InteractiveSelectionM (PrimOf p) wR wX ()
forall (p :: * -> * -> *) wX wY.
(IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
 PatchInspect p, PrimDetails p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
interactiveHunks ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) FL (PrimOf p) wR wX
allInterestingChanges
      else
        if Bool
haveLookForAddsAndSummary
          then do
            Tree IO -> FL (PrimOf p) wR wX -> IO ()
forall (p :: * -> * -> *) wX wY.
(PrimPatch p, ApplyState p ~ Tree) =>
Tree IO -> FL p wX wY -> IO ()
printChanges Tree IO
pristine FL (PrimOf p) wR wX
noLookChanges
            FL (PrimOf p) Any wX -> IO ()
forall (p :: * -> * -> *) wX wY. PrimPatch p => FL p wX wY -> IO ()
printUnaddedPaths FL (PrimOf p) Any wX
unaddedNewPathsPs
          else do
            Tree IO -> FL (PrimOf p) wR wX -> IO ()
forall (p :: * -> * -> *) wX wY.
(PrimPatch p, ApplyState p ~ Tree) =>
Tree IO -> FL p wX wY -> IO ()
printChanges Tree IO
pristine FL (PrimOf p) wR wX
allInterestingChanges
  where
    haveSummary :: Bool
haveSummary = WithSummary -> Bool
forall a. YesNo a => a -> Bool
O.yes ([DarcsFlag] -> WithSummary
getSummary [DarcsFlag]
opts)
    haveLookForAddsAndSummary :: Bool
haveLookForAddsAndSummary = Bool
haveSummary Bool -> Bool -> Bool
&& LookForAdds -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a LookForAdds
PrimDarcsOption LookForAdds
O.lookforadds PrimDarcsOption LookForAdds -> [DarcsFlag] -> LookForAdds
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)

    -- Filter out hunk patches (leaving add patches) and return the tree
    -- resulting from applying the filtered patches to the pristine tree.
    applyAddPatchesToPristine :: FL p wX wY -> Tree m -> m (Tree m)
applyAddPatchesToPristine FL p wX wY
ps Tree m
pristine = do
        RL p wX wZ
adds :> RL p wZ wY
_ <- (:>) (RL p) (RL p) wX wY -> m ((:>) (RL p) (RL p) wX wY)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (RL p) (RL p) wX wY -> m ((:>) (RL p) (RL p) wX wY))
-> (:>) (RL p) (RL p) wX wY -> m ((:>) (RL p) (RL p) wX wY)
forall a b. (a -> b) -> a -> b
$ (forall wU wV. p wU wV -> Bool)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
(forall wU wV. p wU wV -> Bool)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
partitionRL (Maybe (FileHunk (ObjectIdOf (ApplyState p)) wU wV) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (FileHunk (ObjectIdOf (ApplyState p)) wU wV) -> Bool)
-> (p wU wV -> Maybe (FileHunk (ObjectIdOf (ApplyState p)) wU wV))
-> p wU wV
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wU wV -> Maybe (FileHunk (ObjectIdOf (ApplyState p)) wU wV)
forall wX wY.
p wX wY -> Maybe (FileHunk (ObjectIdOf (ApplyState p)) wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
isHunk) (RL p wX wY -> (:>) (RL p) (RL p) wX wY)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
forall a b. (a -> b) -> a -> b
$ FL p wX wY -> RL p wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wX wY
ps
        FL p wX wZ -> Tree m -> m (Tree m)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, MonadThrow m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (RL p wX wZ -> FL p wX wZ
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL p wX wZ
adds) Tree m
pristine

    exitOnNoChanges :: FL p wX wY -> IO ()
    exitOnNoChanges :: forall (p :: * -> * -> *) wX wY. FL p wX wY -> IO ()
exitOnNoChanges FL p wX wY
NilFL = do String -> IO ()
putStrLn String
"No changes!"
                               ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
    exitOnNoChanges FL p wX wY
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- This function does nothing. Its purpose is to enforce the
    -- same patch type for the two passed FLs. This is necessary
    -- in order to avoid ambiguous typing for unaddedNewPathsPs.
    samePatchType :: FL p wX wY -> FL p wU wV -> IO ()
    samePatchType :: forall (p :: * -> * -> *) wX wY wU wV.
FL p wX wY -> FL p wU wV -> IO ()
samePatchType FL p wX wY
_ FL p wU wV
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    printUnaddedPaths :: PrimPatch p => FL p wX wY -> IO ()
    printUnaddedPaths :: forall (p :: * -> * -> *) wX wY. PrimPatch p => FL p wX wY -> IO ()
printUnaddedPaths FL p wX wY
NilFL = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    printUnaddedPaths FL p wX wY
ps =
        Doc -> IO ()
putDocLn (Doc -> IO ()) -> (FL p wX wY -> Doc) -> FL p wX wY -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
lowercaseAs (String -> Doc) -> (FL p wX wY -> String) -> FL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderString (Doc -> String) -> (FL p wX wY -> Doc) -> FL p wX wY -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> FL p wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
Bool -> FL prim wX wY -> Doc
plainSummaryPrims Bool
False) (FL p wX wY -> IO ()) -> FL p wX wY -> IO ()
forall a b. (a -> b) -> a -> b
$ FL p wX wY
ps

    -- Make any add markers lowercase, to distinguish new-but-unadded files
    -- from those that are unrecorded, but added.
    lowercaseAs :: String -> Doc
lowercaseAs String
x = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
lowercaseA) ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
x
    lowercaseA :: String -> String
lowercaseA (Char
'A' : String
x) = Char
'a' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x
    lowercaseA String
x = String
x

    -- Appropriately print changes, according to the passed flags.
    -- Note this cannot make distinction between unadded and added files.
    printChanges :: ( PrimPatch p, ApplyState p ~ Tree)
                 => Tree IO -> FL p wX wY
                 -> IO ()
    printChanges :: forall (p :: * -> * -> *) wX wY.
(PrimPatch p, ApplyState p ~ Tree) =>
Tree IO -> FL p wX wY -> IO ()
printChanges Tree IO
pristine FL p wX wY
changes
        | Bool
haveSummary = Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FL p wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
Bool -> FL prim wX wY -> Doc
plainSummaryPrims Bool
machineReadable FL p wX wY
changes
        | WithContext -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a WithContext
PrimDarcsOption WithContext
O.withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) = ApplyState (FL p) IO -> FL p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
(ApplyMonadTrans (ApplyState p) IO, ShowContextPatch p) =>
ApplyState p IO -> p wX wY -> IO ()
contextualPrintPatchWithPager Tree IO
ApplyState (FL p) IO
pristine FL p wX wY
changes
        | Bool
otherwise = FL p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatchPager FL p wX wY
changes
     where machineReadable :: Bool
machineReadable = PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.machineReadable [DarcsFlag]
opts

    -- return the unrecorded changes that affect an optional list of paths.
    filteredUnrecordedChanges :: forall rt p wR wU. (RepoPatch p, ApplyState p ~ Tree)
                              => O.DiffOpts
                              -> Repository rt p wU wR
                              -> Maybe [AnchoredPath]
                              -> IO (Sealed (FL (PrimOf p) wR))
    filteredUnrecordedChanges :: forall (rt :: AccessType) (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wR))
filteredUnrecordedChanges DiffOpts
diffing Repository rt p wU wR
repo Maybe [AnchoredPath]
paths =
        Maybe [AnchoredPath]
-> FL (PrimOf p) wR wU -> Sealed (FL (PrimOf p) wR)
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [AnchoredPath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching Maybe [AnchoredPath]
paths (FL (PrimOf p) wR wU -> Sealed (FL (PrimOf p) wR))
-> IO (FL (PrimOf p) wR wU) -> IO (Sealed (FL (PrimOf p) wR))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges DiffOpts
diffing Repository rt p wU wR
repo Maybe [AnchoredPath]
paths

-- | Runs the 'InteractiveSelectionM' code
runInteractive :: InteractiveSelectionM p wX wY () -- Selection to run
               -> S.PatchSelectionOptions
               -> FL p wX wY      -- A list of patches
               -> IO ()
runInteractive :: forall (p :: * -> * -> *) wX wY.
InteractiveSelectionM p wX wY ()
-> PatchSelectionOptions -> FL p wX wY -> IO ()
runInteractive InteractiveSelectionM p wX wY ()
i PatchSelectionOptions
patchsel FL p wX wY
ps' = do
    let lps' :: FL (LabelledPatch p) wX wY
lps' = Maybe Label -> FL p wX wY -> FL (LabelledPatch p) wX wY
forall (p :: * -> * -> *) wX wY.
Maybe Label -> FL p wX wY -> FL (LabelledPatch p) wX wY
labelPatches Maybe Label
forall a. Maybe a
Nothing FL p wX wY
ps'
        choices' :: PatchChoices p wX wY
choices' = FL (LabelledPatch p) wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
FL (LabelledPatch p) wX wY -> PatchChoices p wX wY
mkPatchChoices FL (LabelledPatch p) wX wY
lps'
        ps :: PatchSelectionM p IO ()
ps = InteractiveSelectionM p wX wY ()
-> InteractiveSelectionState p wX wY -> PatchSelectionM p IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT InteractiveSelectionM p wX wY ()
i (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
choices')
    IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      PatchSelectionM p IO () -> SelectionConfig p -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PatchSelectionM p IO ()
ps (SelectionConfig p -> IO ()) -> SelectionConfig p -> IO ()
forall a b. (a -> b) -> a -> b
$
        WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> SelectionConfig prim
selectionConfigPrim WhichChanges
First String
"view" PatchSelectionOptions
patchsel Maybe (Splitter p)
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing

-- | The interactive part of @darcs whatsnew@
interactiveHunks :: (IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
                     PatchInspect p, PrimDetails p, ApplyState p ~ Tree)
                 => InteractiveSelectionM p wX wY ()
interactiveHunks :: forall (p :: * -> * -> *) wX wY.
(IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
 PatchInspect p, PrimDetails p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
interactiveHunks = 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 -> 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
$ String -> IO ()
putStrLn String
"No more changes!"
        Just (Sealed2 LabelledPatch p wX wY
lp) -> 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 ())
-> IO () -> InteractiveSelectionM p wX wY ()
forall a b. (a -> b) -> a -> b
$ p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatchPager (LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp)
            LabelledPatch p wX wY -> InteractiveSelectionM p wX wY ()
forall {wX} {wY} {wX} {wY}.
LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp
  where
    repeatThis :: LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp = do
        String
thePrompt <- InteractiveSelectionM p wX wY String
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
InteractiveSelectionM p wX wY String
prompt -- "Shall I view this change? (n/m)"
        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)
-> IO Char
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) Char
forall a b. (a -> b) -> a -> b
$ PromptConfig -> IO Char
promptChar
                (String -> String -> String -> Maybe Char -> String -> PromptConfig
PromptConfig String
thePrompt ([[KeyPress]] -> String
keysFor [[KeyPress]]
basic_options) ([[KeyPress]] -> String
keysFor [[KeyPress]]
adv_options)
                 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n') String
"?h")
        case Char
yorn of
            -- View change
            Char
'v' -> 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 (p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatch (LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp))
                   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
>> LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp
            -- View summary of the change
            Char
'x' -> 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 (Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ p wX wY -> Doc
forall wX wY. p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary (p wX wY -> Doc) -> p wX wY -> Doc
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)
                   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
>> LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp
            -- View change and move on
            Char
'y' -> 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 (p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatch (LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp))
                   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
>> Bool
-> LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
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 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 {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
next_hunk
            -- Go to the next patch
            Char
'n' -> Bool
-> LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
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 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 {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
next_hunk
            -- Skip the whole file
            Char
's' -> do
                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
    -> 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
-> (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
>>= StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
-> (AnchoredPath
    -> StateT
         (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ())
-> Maybe AnchoredPath
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    (()
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
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
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY.
(Commute p, PatchInspect p) =>
AnchoredPath -> Bool -> InteractiveSelectionM p wX wY ()
decideWholeFile AnchoredPath
f Bool
False)
                StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
next_hunk
            -- View change in a pager
            Char
'p' -> 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 (p wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatchPager (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)
                   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
>> LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp
            -- Next change
            Char
'j' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
next_hunk
            -- Previous change
            Char
'k' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
prev_hunk
            -- Start from the first change
            Char
'g' -> StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall {wX} {wY}.
StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
start_over
            -- Quit whatsnew
            Char
'q' -> 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
$ IO ()
forall a. IO a
exitSuccess
            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
"whatsnew" [[KeyPress]]
basic_options [[KeyPress]]
adv_options
                    LabelledPatch p wX wY
-> StateT
     (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
repeatThis LabelledPatch p wX wY
lp
    start_over :: StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
start_over = 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.
(IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
 PatchInspect p, PrimDetails p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
interactiveHunks
    next_hunk :: StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
next_hunk  = StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
forall (p :: * -> * -> *) wX wY. InteractiveSelectionM p wX wY ()
skipOne 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.
(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.
(IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
 PatchInspect p, PrimDetails p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
interactiveHunks
    prev_hunk :: StateT
  (InteractiveSelectionState p wX wY) (PatchSelectionM p IO) ()
prev_hunk  = 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.
(IsHunk p, ShowPatch p, ShowContextPatch p, Commute p,
 PatchInspect p, PrimDetails p, ApplyState p ~ Tree) =>
InteractiveSelectionM p wX wY ()
interactiveHunks
    options_yn :: [KeyPress]
options_yn =
        [ Char -> String -> KeyPress
KeyPress Char
'v' String
"view this change"
        , Char -> String -> KeyPress
KeyPress Char
'y' String
"view this change and go to the next one"
        , Char -> String -> KeyPress
KeyPress Char
'n' String
"skip this change and its dependencies"
        ]
    optionsView :: [KeyPress]
optionsView =
        [ Char -> String -> KeyPress
KeyPress Char
'p' String
"view this change with pager"
        , Char -> String -> KeyPress
KeyPress Char
'x' String
"view a summary of this change"
        ]
    optionsNav :: [KeyPress]
optionsNav =
        [ Char -> String -> KeyPress
KeyPress Char
'q' String
"quit whatsnew"
        , Char -> String -> KeyPress
KeyPress Char
's' String
"skip the rest of the changes to this file"
        , Char -> String -> KeyPress
KeyPress Char
'j' String
"go to the next change"
        , Char -> String -> KeyPress
KeyPress Char
'k' String
"back up to previous change"
        , Char -> String -> KeyPress
KeyPress Char
'g' String
"start over from the first change"
        ]
    basic_options :: [[KeyPress]]
basic_options = [ [KeyPress]
options_yn ]
    adv_options :: [[KeyPress]]
adv_options = [ [KeyPress]
optionsView, [KeyPress]
optionsNav ]

printPatchPager :: ShowPatchBasic p => p wX wY -> IO ()
printPatchPager :: forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatchPager = Printers -> Doc -> IO ()
viewDocWith Printers
fancyPrinters (Doc -> IO ()) -> (p wX wY -> Doc) -> p wX wY -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch

printPatch :: ShowPatchBasic p => p wX wY -> IO ()
printPatch :: forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
p wX wY -> IO ()
printPatch = Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ()) -> (p wX wY -> Doc) -> p wX wY -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch

-- | An alias for 'whatsnew', with implicit @-l@ (and thus implicit @-s@)
-- flags. We override the default description, to include these flags.
status :: DarcsCommand
status :: DarcsCommand
status = DarcsCommand
statusAlias
    { commandDescription = statusDesc
    , commandOptions = statusOpts
    }
  where
    statusAlias :: DarcsCommand
statusAlias = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"status" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
whatsnew
    statusDesc :: String
statusDesc = String
"Alias for `darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand -> String
commandName DarcsCommand
whatsnew String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -ls`."
    statusBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
statusBasicOpts
      = Maybe WithSummary
-> forall {a}.
   PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe WithSummary)
O.maybeSummary (WithSummary -> Maybe WithSummary
forall a. a -> Maybe a
Just WithSummary
O.YesSummary)
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption WithContext
O.withContext
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption Bool
O.machineReadable
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ LookForAdds -> PrimDarcsOption LookForAdds
O.maybelookforadds LookForAdds
O.YesLookForAdds
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption LookForReplaces
O.lookforreplaces
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (LookForMoves -> DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption LookForMoves
O.lookformoves
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> a)
  (DiffAlgorithm -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     (Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> a)
  (Maybe String -> Maybe Bool -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> a)
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe WithSummary
      -> WithContext
      -> Bool
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> DiffAlgorithm
      -> Maybe String
      -> Maybe Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
    statusOpts :: CommandOptions
statusOpts = DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
withStdOpts DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe WithSummary
   -> WithContext
   -> Bool
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> DiffAlgorithm
   -> Maybe String
   -> Maybe Bool
   -> a)
statusBasicOpts DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
forall (d :: * -> *) f a. OptSpec d f a a
oid

maybeIsInteractive :: [DarcsFlag] -> Bool
maybeIsInteractive :: [DarcsFlag] -> Bool
maybeIsInteractive = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id (Maybe Bool -> Bool)
-> ([DarcsFlag] -> Maybe Bool) -> [DarcsFlag] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimDarcsOption (Maybe Bool) -> [DarcsFlag] -> Maybe Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe Bool)
PrimDarcsOption (Maybe Bool)
O.interactive