--  Copyright (C) 2003-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.

module Darcs.UI.Commands.Log
    ( changes
    , log
    , changelog
    , logInfoFL
    , simpleLogInfo -- for darcsden
    ) where

import Darcs.Prelude

import Data.List ( intersect, find )
import Data.List.Ordered ( nubSort )
import Data.Maybe ( fromMaybe, isJust )
import Control.Arrow ( second )
import Control.Exception ( catch, IOException )
import Control.Monad.State.Strict

import Darcs.UI.PrintPatch ( showFriendly )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAndG, fmapFLPIAP, hopefullyM, info )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, commandAlias, findRepository )
import Darcs.UI.Commands.Util ( matchRange )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.External ( viewDocWith )
import Darcs.UI.Flags
    ( DarcsFlag
    , changesReverse, onlyToFiles
    , useCache, maxCount, hasXmlOutput
    , verbosity, withContext, isInteractive, verbose
    , getRepourl, pathSetFromArgs )
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Path
    ( SubPath
    , AbsolutePath
    , simpleSubPath
    , AnchoredPath
    , floatSubPath
    , displayPath
    )
import Darcs.Repository ( PatchInfoAnd,
                          withRepositoryLocation, RepoJob(..),
                          readRepo, unrecordedChanges,
                          withRepoLockCanFail )
import Darcs.Repository.Flags ( UseIndex(..), ScanKnown(..), DiffAlgorithm(MyersDiff) )
import Darcs.Util.Lock ( withTempDir )
import Darcs.Patch.Set ( PatchSet, patchSet2RL, Origin )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info ( toXml, toXmlShort, showPatchInfo, displayPatchInfo, escapeXML, PatchInfo )
import Darcs.Patch.Ident ( PatchId )
import Darcs.Patch.Invertible ( mkInvertible )
import Darcs.Patch.Depends ( contextPatches )
import Darcs.Patch.Show ( ShowPatch, ShowPatchFor(..) )
import Darcs.Patch.TouchesFiles ( lookTouch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch ( PrimPatchBase(..), invert, xmlSummary, description,
                     effectOnPaths, listTouchedFiles, showPatch )
import Darcs.Patch.Named ( HasDeps, getdeps )
import Darcs.Patch.Prim.Class ( PrimDetails )
import Darcs.Patch.Summary ( Summary )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
    ( FL(NilFL), RL(..), filterOutFLFL, filterRL,
    reverseFL, (:>)(..), mapFL, mapRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed2(..), unseal2, Sealed(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Patch.Match
    ( MatchFlag
    , Matchable
    , MatchableRP
    , matchAPatch
    , haveNonrangeMatch
    )
import Darcs.Util.Printer
    ( Doc
    , ($$)
    , (<+>)
    , formatWords
    , hsep
    , insertBeforeLastline
    , prefix
    , simplePrinters
    , text
    , vcat
    , vsep
    )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Progress ( setProgressMode, debugMessage )
import Darcs.UI.SelectChanges ( viewChanges )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Repository.PatchIndex ( PatchFilter, maybeFilterPatches, attemptCreatePatchIndex )
import Darcs.Util.Tree( Tree )

logHelp :: Doc
logHelp :: Doc
logHelp = [Doc] -> Doc
vsep ([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
formatWords
  [ [ String
"The `darcs log` command lists patches of the current repository or,"
    , String
"with `--repo`, a remote repository.  Without options or arguments,"
    , String
"ALL patches will be listed."
    ]
  , [ String
"When given files or directories paths as arguments, only patches which"
    , String
"affect those paths are listed.  This includes patches that happened to"
    , String
"files before they were moved or renamed."
    ]
  , [ String
"When given `--from-tag` or `--from-patch`, only patches since that tag"
    , String
"or patch are listed.  Similarly, the `--to-tag` and `--to-patch`"
    , String
"options restrict the list to older patches."
    ]
  , [ String
"The `--last` and `--max-count` options both limit the number of patches"
    , String
"listed.  The former applies BEFORE other filters, whereas the latter"
    , String
"applies AFTER other filters.  For example `darcs log foo.c"
    , String
"--max-count 3` will print the last three patches that affect foo.c,"
    , String
"whereas `darcs log --last 3 foo.c` will, of the last three"
    , String
"patches, print only those that affect foo.c."
    ]
  , [ String
"Four output formats exist.  The default is `--human-readable`. The slightly"
    , String
"different `--machine-readable` format enables to see patch dependencies in"
    , String
"non-interactive mode. You can also select `--context`, which is an internal"
    , String
"format that can be re-read by Darcs (e.g. `darcs clone --context`)."
    ]
  , [ String
"Finally, there is `--xml-output`, which emits valid XML... unless a the"
    , String
"patch metadata (author, name or description) contains a non-ASCII"
    , String
"character and was recorded in a non-UTF8 locale."
    ]
  ]

log :: DarcsCommand
log :: DarcsCommand
log = DarcsCommand :: String
-> String
-> Doc
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> DarcsCommand
DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"log"
    , commandHelp :: Doc
commandHelp = Doc
logHelp
    , commandDescription :: String
commandDescription = String
"List patches in the repository."
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
findRepository
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (NetworkOptions -> WithPatchIndex -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (NetworkOptions -> WithPatchIndex -> Any)
forall a.
OptSpec
  DarcsOptDescr DarcsFlag a (NetworkOptions -> WithPatchIndex -> a)
logAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
logBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
logOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
logOpts
    }
  where
    logBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
logBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  [MatchFlag]
MatchOption
O.matchSeveralOrRange
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption (Maybe Int)
O.maxCount
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
     (Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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 ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  (Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption Bool
O.onlyToFiles
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
     (Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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
  (WithSummary
   -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
  (Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
     (WithSummary
      -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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 -> Maybe String -> Maybe String -> Maybe Bool -> a)
  (WithSummary
   -> Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe String -> Maybe Bool -> a)
     (Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe String -> Maybe Bool -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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 String -> Maybe Bool -> a)
  (Bool -> Maybe String -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe String -> Maybe Bool -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     (Maybe String -> Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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)
  (Maybe String -> Maybe String -> Maybe Bool -> a)
PrimDarcsOption (Maybe String)
O.possiblyRemoteRepo
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     (Maybe String -> Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> a)
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> 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
    logAdvancedOpts :: OptSpec
  DarcsOptDescr DarcsFlag a (NetworkOptions -> WithPatchIndex -> a)
logAdvancedOpts = PrimOptSpec
  DarcsOptDescr DarcsFlag (WithPatchIndex -> a) NetworkOptions
PrimDarcsOption NetworkOptions
O.network PrimOptSpec
  DarcsOptDescr DarcsFlag (WithPatchIndex -> a) NetworkOptions
-> OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag a (NetworkOptions -> WithPatchIndex -> 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 (WithPatchIndex -> a)
PrimDarcsOption WithPatchIndex
O.patchIndexYes
    logOpts :: DarcsOption
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
logOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> a)
logBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> Maybe Int
   -> Bool
   -> Maybe ChangesFormat
   -> WithSummary
   -> Bool
   -> Maybe String
   -> Maybe String
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
     (NetworkOptions
      -> WithPatchIndex
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
-> DarcsOption
     a
     ([MatchFlag]
      -> Maybe Int
      -> Bool
      -> Maybe ChangesFormat
      -> WithSummary
      -> Bool
      -> Maybe String
      -> Maybe String
      -> Maybe Bool
      -> Maybe StdCmdAction
      -> Verbosity
      -> NetworkOptions
      -> WithPatchIndex
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
  (NetworkOptions
   -> WithPatchIndex
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr DarcsFlag a (NetworkOptions -> WithPatchIndex -> a)
logAdvancedOpts

logCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
args
  | PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat PrimDarcsOption (Maybe ChangesFormat)
-> [DarcsFlag] -> Maybe ChangesFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Maybe ChangesFormat -> Maybe ChangesFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ChangesFormat -> Maybe ChangesFormat
forall a. a -> Maybe a
Just ChangesFormat
O.GenContext = if Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
args
      then String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"log --context cannot accept other arguments"
      else [DarcsFlag] -> IO ()
logContext [DarcsFlag]
opts
  | [DarcsFlag] -> Bool
hasRemoteRepo [DarcsFlag]
opts = do
      ([SubPath]
fs, [String]
es) <- [String] -> [String] -> IO ([SubPath], [String])
remoteSubPaths [String]
args []
      if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
es then
        String -> (AbsolutePath -> IO ()) -> IO ()
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir String
"darcs.log"
          (\AbsolutePath
_ -> [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
showLog [DarcsFlag]
opts (Maybe [AnchoredPath] -> IO ()) -> Maybe [AnchoredPath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [AnchoredPath] -> Maybe [AnchoredPath]
forall a. [a] -> Maybe [a]
maybeNotNull ([AnchoredPath] -> Maybe [AnchoredPath])
-> [AnchoredPath] -> Maybe [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort ([AnchoredPath] -> [AnchoredPath])
-> [AnchoredPath] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ (SubPath -> AnchoredPath) -> [SubPath] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map SubPath -> AnchoredPath
floatSubPath [SubPath]
fs)
      else
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"For a remote repo I can only handle relative paths.\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Invalid arguments: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
es
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args = [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
showLog [DarcsFlag]
opts Maybe [AnchoredPath]
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
False [DarcsFlag]
opts)
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption WithPatchIndex
O.patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts WithPatchIndex -> WithPatchIndex -> Bool
forall a. Eq a => a -> a -> Bool
== WithPatchIndex
O.YesPatchIndex)
          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UseCache -> RepoJob () -> IO ()
withRepoLockCanFail (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
            (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob (\Repository rt p wR wU wR
repo -> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repo IO (PatchSet rt p Origin wR)
-> (PatchSet rt p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Repository rt p wR wU wR -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSet rt p Origin wR -> IO ()
attemptCreatePatchIndex Repository rt p wR wU wR
repo)
      Maybe [AnchoredPath]
paths <- (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
      [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
showLog [DarcsFlag]
opts Maybe [AnchoredPath]
paths

maybeNotNull :: [a] -> Maybe [a]
maybeNotNull :: [a] -> Maybe [a]
maybeNotNull [] = Maybe [a]
forall a. Maybe a
Nothing
maybeNotNull [a]
xs = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs

hasRemoteRepo :: [DarcsFlag] -> Bool
hasRemoteRepo :: [DarcsFlag] -> Bool
hasRemoteRepo = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> ([DarcsFlag] -> Maybe String) -> [DarcsFlag] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DarcsFlag] -> Maybe String
getRepourl

remoteSubPaths :: [String] -> [String] -> IO ([SubPath],[String])
remoteSubPaths :: [String] -> [String] -> IO ([SubPath], [String])
remoteSubPaths [] [String]
es = ([SubPath], [String]) -> IO ([SubPath], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [String]
es)
remoteSubPaths (String
arg:[String]
args) [String]
es = case String -> Maybe SubPath
simpleSubPath String
arg of
  Maybe SubPath
Nothing -> [String] -> [String] -> IO ([SubPath], [String])
remoteSubPaths [String]
args (String
argString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
es)
  Just SubPath
sp -> do
    ([SubPath]
sps, [String]
es') <- [String] -> [String] -> IO ([SubPath], [String])
remoteSubPaths [String]
args [String]
es
    ([SubPath], [String]) -> IO ([SubPath], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (SubPath
spSubPath -> [SubPath] -> [SubPath]
forall a. a -> [a] -> [a]
:[SubPath]
sps, [String]
es')

showLog :: [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
showLog :: [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
showLog [DarcsFlag]
opts Maybe [AnchoredPath]
files =
  let repodir :: String
repodir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." ([DarcsFlag] -> Maybe String
getRepourl [DarcsFlag]
opts) in
  UseCache -> String -> RepoJob () -> IO ()
forall a. UseCache -> String -> RepoJob a -> IO a
withRepositoryLocation (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
repodir (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
  (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
  Repository rt p wR wU wR -> IO ())
 -> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
    (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
    Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repository -> do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PrimDarcsOption Bool
O.debug PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
setProgressMode Bool
False
  Sealed FL (PrimOf p) wR wX
unrec <- case Maybe [AnchoredPath]
files of
    Maybe [AnchoredPath]
Nothing -> Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR)))
-> Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
forall a b. (a -> b) -> a -> b
$ 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
    Just [AnchoredPath]
_ -> FL (PrimOf p) wR wU -> Sealed (FL (PrimOf p) wR)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (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
`fmap` (UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges (UseIndex
UseIndex, ScanKnown
ScanKnown, DiffAlgorithm
MyersDiff)
                  LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
                  Repository rt p wR wU wR
repository Maybe [AnchoredPath]
files
                  IO (Sealed (FL (PrimOf p) wR))
-> (IOException -> IO (Sealed (FL (PrimOf p) wR)))
-> IO (Sealed (FL (PrimOf p) wR))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
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) -- this is triggered when repository is remote
  String -> IO ()
debugMessage String
"About to read the repository..."
  PatchSet rt p Origin wR
patches <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
  String -> IO ()
debugMessage String
"Done reading the repository."
  let recFiles :: Maybe [AnchoredPath]
recFiles = FL (PrimOf p) wX wR -> [AnchoredPath] -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (FL (PrimOf p) wR wX -> FL (PrimOf p) wX wR
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wR wX
unrec) ([AnchoredPath] -> [AnchoredPath])
-> Maybe [AnchoredPath] -> Maybe [AnchoredPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [AnchoredPath]
files
      filtered_changes :: PatchSet rt p Origin wY -> IO (LogInfo (PatchInfoAnd rt p))
filtered_changes PatchSet rt p Origin wY
p =
          LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p)
forall (p :: * -> * -> *). LogInfo p -> LogInfo p
maybe_reverse (LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p))
-> IO (LogInfo (PatchInfoAnd rt p))
-> IO (LogInfo (PatchInfoAnd rt p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Maybe Int
-> [MatchFlag]
-> Bool
-> Maybe [AnchoredPath]
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO (LogInfo (PatchInfoAnd rt p))
forall (rt :: RepoType) (p :: * -> * -> *) wY.
(MatchableRP p, ApplyState p ~ Tree) =>
Maybe Int
-> [MatchFlag]
-> Bool
-> Maybe [AnchoredPath]
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO (LogInfo (PatchInfoAnd rt p))
getLogInfo
              (PrimDarcsOption (Maybe Int)
maxCount PrimDarcsOption (Maybe Int) -> [DarcsFlag] -> Maybe Int
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
              (MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveralOrRange [DarcsFlag]
opts)
              (PrimDarcsOption Bool
onlyToFiles PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
              Maybe [AnchoredPath]
recFiles
              (Repository rt p wR wU wR
-> PatchSet rt p Origin wR -> PatchFilter rt p
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> PatchSet rt p Origin wR -> PatchFilter rt p
maybeFilterPatches Repository rt p wR wU wR
repository PatchSet rt p Origin wR
patches)
              PatchSet rt p Origin wY
p
  if Bool -> [DarcsFlag] -> Bool
isInteractive Bool
False [DarcsFlag]
opts
    then do LogInfo (PatchInfoAnd rt p)
li <- PatchSet rt p Origin wR -> IO (LogInfo (PatchInfoAnd rt p))
forall wY.
PatchSet rt p Origin wY -> IO (LogInfo (PatchInfoAnd rt p))
filtered_changes PatchSet rt p Origin wR
patches
            PatchSelectionOptions -> [Sealed2 (PatchInfoAnd rt p)] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges ([DarcsFlag] -> PatchSelectionOptions
logPatchSelOpts [DarcsFlag]
opts) (((Sealed2 (PatchInfoAnd rt p), [AnchoredPath])
 -> Sealed2 (PatchInfoAnd rt p))
-> [(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])]
-> [Sealed2 (PatchInfoAnd rt p)]
forall a b. (a -> b) -> [a] -> [b]
map (Sealed2 (PatchInfoAnd rt p), [AnchoredPath])
-> Sealed2 (PatchInfoAnd rt p)
forall a b. (a, b) -> a
fst (LogInfo (PatchInfoAnd rt p)
-> [(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches LogInfo (PatchInfoAnd rt p)
li))
    else do let header :: Doc
header =
                  case Maybe [AnchoredPath]
recFiles of
                    Just [AnchoredPath]
fs | Bool -> Bool
not ([DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts) ->
                      let pathlist :: [Doc]
pathlist = (AnchoredPath -> Doc) -> [AnchoredPath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (AnchoredPath -> String) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
displayPath) [AnchoredPath]
fs
                      in [Doc] -> Doc
hsep (String -> Doc
text String
"Changes to" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
pathlist) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" Doc -> Doc -> Doc
$$ String -> Doc
text String
""
                    Maybe [AnchoredPath]
_ -> Doc
forall a. Monoid a => a
mempty
            String -> IO ()
debugMessage String
"About to print the patches..."
            let printers :: Printers
printers = if [DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts then Printers
simplePrinters else Printers
fancyPrinters
            PatchSet rt p Origin wR
ps <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository -- read repo again to prevent holding onto
                                       -- values forced by filtered_changes
            Doc
logOutput <- [DarcsFlag]
-> RL (PatchInfoAnd rt p) Origin wR
-> LogInfo (PatchInfoAnd rt p)
-> Doc
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(ShowPatch p, PatchListFormat p, Summary p, HasDeps p,
 PrimDetails (PrimOf p)) =>
[DarcsFlag]
-> RL (PatchInfoAndG rt p) wStart wX
-> LogInfo (PatchInfoAndG rt p)
-> Doc
changelog [DarcsFlag]
opts (PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p Origin wR
ps) (LogInfo (PatchInfoAnd rt p) -> Doc)
-> IO (LogInfo (PatchInfoAnd rt p)) -> IO Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` PatchSet rt p Origin wR -> IO (LogInfo (PatchInfoAnd rt p))
forall wY.
PatchSet rt p Origin wY -> IO (LogInfo (PatchInfoAnd rt p))
filtered_changes PatchSet rt p Origin wR
patches
            Printers -> Doc -> IO ()
viewDocWith Printers
printers (Doc
header Doc -> Doc -> Doc
$$ Doc
logOutput)
  where
    maybe_reverse :: LogInfo p -> LogInfo p
maybe_reverse li :: LogInfo p
li@(LogInfo [(Sealed2 p, [AnchoredPath])]
xs [(AnchoredPath, AnchoredPath)]
b Maybe Doc
c) =
      if PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then [(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
forall (p :: * -> * -> *).
[(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
LogInfo ([(Sealed2 p, [AnchoredPath])] -> [(Sealed2 p, [AnchoredPath])]
forall a. [a] -> [a]
reverse [(Sealed2 p, [AnchoredPath])]
xs) [(AnchoredPath, AnchoredPath)]
b Maybe Doc
c else LogInfo p
li

data LogInfo p = LogInfo
  { LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches :: [(Sealed2 p, [AnchoredPath])]
  , LogInfo p -> [(AnchoredPath, AnchoredPath)]
liRenames :: [(AnchoredPath, AnchoredPath)]
  , LogInfo p -> Maybe Doc
liErrorMsg :: Maybe Doc
  }

mkLogInfo :: [Sealed2 p] -> LogInfo p
mkLogInfo :: [Sealed2 p] -> LogInfo p
mkLogInfo [Sealed2 p]
ps = [(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
forall (p :: * -> * -> *).
[(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
LogInfo ((Sealed2 p -> (Sealed2 p, [AnchoredPath]))
-> [Sealed2 p] -> [(Sealed2 p, [AnchoredPath])]
forall a b. (a -> b) -> [a] -> [b]
map (,[]) [Sealed2 p]
ps) [] Maybe Doc
forall a. Maybe a
Nothing

logInfoFL :: FL p wX wY -> LogInfo p
logInfoFL :: FL p wX wY -> LogInfo p
logInfoFL = [Sealed2 p] -> LogInfo p
forall (p :: * -> * -> *). [Sealed2 p] -> LogInfo p
mkLogInfo ([Sealed2 p] -> LogInfo p)
-> (FL p wX wY -> [Sealed2 p]) -> FL p wX wY -> LogInfo p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> Sealed2 p) -> FL p wX wY -> [Sealed2 p]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> Sealed2 p
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2

matchNonrange :: (Matchable p, PatchId p ~ PatchInfo)
              => [MatchFlag] -> RL p wA wB -> [Sealed2 p]
matchNonrange :: [MatchFlag] -> RL p wA wB -> [Sealed2 p]
matchNonrange [MatchFlag]
matchFlags
  | [MatchFlag] -> Bool
haveNonrangeMatch [MatchFlag]
matchFlags = (forall wX wY. p wX wY -> Bool) -> RL p wA wB -> [Sealed2 p]
forall (p :: * -> * -> *) wA wB.
(forall wX wY. p wX wY -> Bool) -> RL p wA wB -> [Sealed2 p]
filterRL ([MatchFlag] -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
matchFlags)
  | Bool
otherwise = (forall wW wZ. p wW wZ -> Sealed2 p) -> RL p wA wB -> [Sealed2 p]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. p wW wZ -> Sealed2 p
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2

simpleLogInfo :: ( MatchableRP p
                 , ApplyState p ~ Tree
                 )
              => AnchoredPath
              -> PatchFilter rt p
              -> PatchSet rt p Origin wY
              -> IO [Sealed2 (PatchInfoAnd rt p)]
simpleLogInfo :: AnchoredPath
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO [Sealed2 (PatchInfoAnd rt p)]
simpleLogInfo AnchoredPath
path PatchFilter rt p
pf PatchSet rt p Origin wY
ps =
  ((Sealed2 (PatchInfoAnd rt p), [AnchoredPath])
 -> Sealed2 (PatchInfoAnd rt p))
-> [(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])]
-> [Sealed2 (PatchInfoAnd rt p)]
forall a b. (a -> b) -> [a] -> [b]
map (Sealed2 (PatchInfoAnd rt p), [AnchoredPath])
-> Sealed2 (PatchInfoAnd rt p)
forall a b. (a, b) -> a
fst ([(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])]
 -> [Sealed2 (PatchInfoAnd rt p)])
-> (LogInfo (PatchInfoAnd rt p)
    -> [(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])])
-> LogInfo (PatchInfoAnd rt p)
-> [Sealed2 (PatchInfoAnd rt p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogInfo (PatchInfoAnd rt p)
-> [(Sealed2 (PatchInfoAnd rt p), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches (LogInfo (PatchInfoAnd rt p) -> [Sealed2 (PatchInfoAnd rt p)])
-> IO (LogInfo (PatchInfoAnd rt p))
-> IO [Sealed2 (PatchInfoAnd rt p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
-> [MatchFlag]
-> Bool
-> Maybe [AnchoredPath]
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO (LogInfo (PatchInfoAnd rt p))
forall (rt :: RepoType) (p :: * -> * -> *) wY.
(MatchableRP p, ApplyState p ~ Tree) =>
Maybe Int
-> [MatchFlag]
-> Bool
-> Maybe [AnchoredPath]
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO (LogInfo (PatchInfoAnd rt p))
getLogInfo Maybe Int
forall a. Maybe a
Nothing [] Bool
False ([AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just [AnchoredPath
path]) PatchFilter rt p
pf PatchSet rt p Origin wY
ps

getLogInfo :: forall rt p wY.
              ( MatchableRP p
              , ApplyState p ~ Tree
              )
           => Maybe Int -> [MatchFlag] -> Bool
           -> Maybe [AnchoredPath]
           -> PatchFilter rt p
           -> PatchSet rt p Origin wY
           -> IO (LogInfo (PatchInfoAnd rt p))
getLogInfo :: Maybe Int
-> [MatchFlag]
-> Bool
-> Maybe [AnchoredPath]
-> PatchFilter rt p
-> PatchSet rt p Origin wY
-> IO (LogInfo (PatchInfoAnd rt p))
getLogInfo Maybe Int
maxCountFlag [MatchFlag]
matchFlags Bool
onlyToFilesFlag Maybe [AnchoredPath]
paths PatchFilter rt p
patchFilter PatchSet rt p Origin wY
ps =
  case [MatchFlag]
-> PatchSet rt p Origin wY -> Sealed2 (FL (PatchInfoAnd rt p))
forall (p :: * -> * -> *) (rt :: RepoType) wY.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p Origin wY -> Sealed2 (FL (PatchInfoAnd rt p))
matchRange [MatchFlag]
matchFlags PatchSet rt p Origin wY
ps of
    Sealed2 FL (PatchInfoAnd rt p) wX wY
range ->
      let ps' :: [Sealed2 (PatchInfoAnd rt p)]
ps' = [MatchFlag]
-> RL (PatchInfoAnd rt p) wX wY -> [Sealed2 (PatchInfoAnd rt p)]
forall (p :: * -> * -> *) wA wB.
(Matchable p, PatchId p ~ PatchInfo) =>
[MatchFlag] -> RL p wA wB -> [Sealed2 p]
matchNonrange [MatchFlag]
matchFlags (FL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wX wY
range) in
      case Maybe [AnchoredPath]
paths of
        Maybe [AnchoredPath]
Nothing -> LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p))
forall (m :: * -> *) a. Monad m => a -> m a
return (LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p)))
-> LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p))
forall a b. (a -> b) -> a -> b
$ [Sealed2 (PatchInfoAnd rt p)] -> LogInfo (PatchInfoAnd rt p)
forall (p :: * -> * -> *). [Sealed2 p] -> LogInfo p
mkLogInfo ([Sealed2 (PatchInfoAnd rt p)] -> LogInfo (PatchInfoAnd rt p))
-> [Sealed2 (PatchInfoAnd rt p)] -> LogInfo (PatchInfoAnd rt p)
forall a b. (a -> b) -> a -> b
$ ([Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)])
-> (Int
    -> [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)])
-> Maybe Int
-> [Sealed2 (PatchInfoAnd rt p)]
-> [Sealed2 (PatchInfoAnd rt p)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)]
forall a. a -> a
id Int
-> [Sealed2 (PatchInfoAnd rt p)] -> [Sealed2 (PatchInfoAnd rt p)]
forall a. Int -> [a] -> [a]
take Maybe Int
maxCountFlag [Sealed2 (PatchInfoAnd rt p)]
ps'
        Just [AnchoredPath]
fs -> do
          LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p)
forall (q :: * -> * -> *) (rt :: RepoType).
PatchInspect q =>
LogInfo (PatchInfoAndG rt (Named q))
-> LogInfo (PatchInfoAndG rt (Named q))
filterOutUnrelatedChanges (LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p))
-> IO (LogInfo (PatchInfoAnd rt p))
-> IO (LogInfo (PatchInfoAnd rt p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            [Sealed2 (PatchInfoAnd rt p)]
ps'' <- PatchFilter rt p
patchFilter [AnchoredPath]
fs [Sealed2 (PatchInfoAnd rt p)]
ps'
            LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p))
forall (m :: * -> *) a. Monad m => a -> m a
return (LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p)))
-> LogInfo (PatchInfoAnd rt p) -> IO (LogInfo (PatchInfoAnd rt p))
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> [AnchoredPath]
-> [Sealed2 (PatchInfoAnd rt p)]
-> LogInfo (PatchInfoAnd rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(MatchableRP p, ApplyState p ~ Tree) =>
Maybe Int
-> [AnchoredPath]
-> [Sealed2 (PatchInfoAnd rt p)]
-> LogInfo (PatchInfoAnd rt p)
filterPatchesByNames Maybe Int
maxCountFlag [AnchoredPath]
fs [Sealed2 (PatchInfoAnd rt p)]
ps''
  where
        -- What we do here is somewhat unclean: we modify the contents of
        -- our patches and throw out everything not related to our files.
        -- This is okay because we only use the result for display.
        filterOutUnrelatedChanges :: LogInfo (PatchInfoAndG rt (Named q))
-> LogInfo (PatchInfoAndG rt (Named q))
filterOutUnrelatedChanges LogInfo (PatchInfoAndG rt (Named q))
li
          | Bool
onlyToFilesFlag = LogInfo (PatchInfoAndG rt (Named q))
li { liPatches :: [(Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])]
liPatches = ((Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
 -> (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath]))
-> [(Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])]
-> [(Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])]
forall a b. (a -> b) -> [a] -> [b]
map (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
-> (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
forall (q :: * -> * -> *) (rt :: RepoType).
PatchInspect q =>
(Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
-> (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
onlyRelated (LogInfo (PatchInfoAndG rt (Named q))
-> [(Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches LogInfo (PatchInfoAndG rt (Named q))
li) }
          | Bool
otherwise       = LogInfo (PatchInfoAndG rt (Named q))
li

        onlyRelated :: (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
-> (Sealed2 (PatchInfoAndG rt (Named q)), [AnchoredPath])
onlyRelated (Sealed2 PatchInfoAndG rt (Named q) wX wY
p, [AnchoredPath]
fs) =
          (PatchInfoAndG rt (Named q) wX wY
-> Sealed2 (PatchInfoAndG rt (Named q))
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (PatchInfoAndG rt (Named q) wX wY
 -> Sealed2 (PatchInfoAndG rt (Named q)))
-> PatchInfoAndG rt (Named q) wX wY
-> Sealed2 (PatchInfoAndG rt (Named q))
forall a b. (a -> b) -> a -> b
$ (FL q wX wY -> FL q wX wY)
-> PatchInfoAndG rt (Named q) wX wY
-> PatchInfoAndG rt (Named q) wX wY
forall (p :: * -> * -> *) wX wY (q :: * -> * -> *)
       (rt :: RepoType).
(FL p wX wY -> FL q wX wY)
-> PatchInfoAnd rt p wX wY -> PatchInfoAnd rt q wX wY
fmapFLPIAP ((forall wX wY. q wX wY -> EqCheck wX wY)
-> FL q wX wY -> FL q wX wY
forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL ([AnchoredPath] -> q wX wY -> EqCheck wX wY
forall (p :: * -> * -> *) wX wY wB wC.
PatchInspect p =>
[AnchoredPath] -> p wX wY -> EqCheck wB wC
unrelated [AnchoredPath]
fs)) PatchInfoAndG rt (Named q) wX wY
p, [AnchoredPath]
fs)

        unrelated :: [AnchoredPath] -> p wX wY -> EqCheck wB wC
unrelated [AnchoredPath]
fs p wX wY
p
          -- If the change does not affect the patches we are looking at,
          -- we ignore the difference between the two states.
          | [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([AnchoredPath] -> Bool) -> [AnchoredPath] -> Bool
forall a b. (a -> b) -> a -> b
$ [AnchoredPath]
fs [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
p = EqCheck Any Any -> EqCheck wB wC
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
          | Bool
otherwise                                = EqCheck wB wC
forall wA wB. EqCheck wA wB
NotEq

-- | Take a list of filenames and patches and produce a list of patches that
-- actually touch the given files with a list of touched file names, a list of
-- original-to-current filepath mappings, indicating the original names of the
-- affected files and possibly an error. Additionaly, the function takes a
-- "depth limit" -- maxcount, that could be Nothing (return everything) or
-- "Just n" -- returns at most n patches touching the file (starting from the
-- beginning of the patch list).
filterPatchesByNames
    :: forall rt p.
       ( MatchableRP p
       , ApplyState p ~ Tree
       )
    => Maybe Int                      -- ^ maxcount
    -> [AnchoredPath]                 -- ^ paths
    -> [Sealed2 (PatchInfoAnd rt p)]  -- ^ patches
    -> LogInfo (PatchInfoAnd rt p)
filterPatchesByNames :: Maybe Int
-> [AnchoredPath]
-> [Sealed2 (PatchInfoAnd rt p)]
-> LogInfo (PatchInfoAnd rt p)
filterPatchesByNames Maybe Int
maxcount [AnchoredPath]
paths [Sealed2 (PatchInfoAnd rt p)]
patches = LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p)
forall (p :: * -> * -> *). LogInfo p -> LogInfo p
removeNonRenames (LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p))
-> LogInfo (PatchInfoAnd rt p) -> LogInfo (PatchInfoAnd rt p)
forall a b. (a -> b) -> a -> b
$
    State
  (Maybe Int, [(AnchoredPath, AnchoredPath)])
  (LogInfo (PatchInfoAnd rt p))
-> (Maybe Int, [(AnchoredPath, AnchoredPath)])
-> LogInfo (PatchInfoAnd rt p)
forall s a. State s a -> s -> a
evalState ([AnchoredPath]
-> [Sealed2 (PatchInfoAnd rt p)]
-> State
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     (LogInfo (PatchInfoAnd rt p))
forall b (p :: * -> * -> *) (rt :: RepoType).
(MonadState
   (Maybe b, [(AnchoredPath, AnchoredPath)])
   (StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity),
 Num b, Ord b, Apply p, ApplyState p ~ Tree) =>
[AnchoredPath]
-> [Sealed2 (PatchInfoAndG rt p)]
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
filterPatchesByNamesM [AnchoredPath]
paths [Sealed2 (PatchInfoAnd rt p)]
patches) (Maybe Int
maxcount, [(AnchoredPath, AnchoredPath)]
initRenames) where
        removeNonRenames :: LogInfo p -> LogInfo p
removeNonRenames LogInfo p
li = LogInfo p
li { liRenames :: [(AnchoredPath, AnchoredPath)]
liRenames = [(AnchoredPath, AnchoredPath)] -> [(AnchoredPath, AnchoredPath)]
removeIds (LogInfo p -> [(AnchoredPath, AnchoredPath)]
forall (p :: * -> * -> *).
LogInfo p -> [(AnchoredPath, AnchoredPath)]
liRenames LogInfo p
li) }
        removeIds :: [(AnchoredPath, AnchoredPath)] -> [(AnchoredPath, AnchoredPath)]
removeIds = ((AnchoredPath, AnchoredPath) -> Bool)
-> [(AnchoredPath, AnchoredPath)] -> [(AnchoredPath, AnchoredPath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (((AnchoredPath, AnchoredPath) -> Bool)
 -> [(AnchoredPath, AnchoredPath)]
 -> [(AnchoredPath, AnchoredPath)])
-> ((AnchoredPath, AnchoredPath) -> Bool)
-> [(AnchoredPath, AnchoredPath)]
-> [(AnchoredPath, AnchoredPath)]
forall a b. (a -> b) -> a -> b
$ (AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath, AnchoredPath) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
        initRenames :: [(AnchoredPath, AnchoredPath)]
initRenames = (AnchoredPath -> (AnchoredPath, AnchoredPath))
-> [AnchoredPath] -> [(AnchoredPath, AnchoredPath)]
forall a b. (a -> b) -> [a] -> [b]
map (\AnchoredPath
x -> (AnchoredPath
x, AnchoredPath
x)) [AnchoredPath]
paths
        returnFinal :: StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity (LogInfo p)
returnFinal = (\[(AnchoredPath, AnchoredPath)]
renames -> [(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
forall (p :: * -> * -> *).
[(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
LogInfo [] [(AnchoredPath, AnchoredPath)]
renames Maybe Doc
forall a. Maybe a
Nothing) ([(AnchoredPath, AnchoredPath)] -> LogInfo p)
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     [(AnchoredPath, AnchoredPath)]
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity (LogInfo p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe Int, [(AnchoredPath, AnchoredPath)])
 -> [(AnchoredPath, AnchoredPath)])
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     [(AnchoredPath, AnchoredPath)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe Int, [(AnchoredPath, AnchoredPath)])
-> [(AnchoredPath, AnchoredPath)]
forall a b. (a, b) -> b
snd
        filterPatchesByNamesM :: [AnchoredPath]
-> [Sealed2 (PatchInfoAndG rt p)]
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
filterPatchesByNamesM [] [Sealed2 (PatchInfoAndG rt p)]
_ = StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)])
  Identity
  (LogInfo (PatchInfoAndG rt p))
forall (p :: * -> * -> *).
StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity (LogInfo p)
returnFinal
        filterPatchesByNamesM [AnchoredPath]
_ [] = StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)])
  Identity
  (LogInfo (PatchInfoAndG rt p))
forall (p :: * -> * -> *).
StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity (LogInfo p)
returnFinal
        filterPatchesByNamesM [AnchoredPath]
fs (s2hp :: Sealed2 (PatchInfoAndG rt p)
s2hp@(Sealed2 PatchInfoAndG rt p wX wY
hp) : [Sealed2 (PatchInfoAndG rt p)]
ps) = do
            (Maybe b
count, [(AnchoredPath, AnchoredPath)]
renames) <- StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)])
  Identity
  (Maybe b, [(AnchoredPath, AnchoredPath)])
forall s (m :: * -> *). MonadState s m => m s
get
            case Maybe b
count of
                Just b
c | b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 -> StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)])
  Identity
  (LogInfo (PatchInfoAndG rt p))
forall (p :: * -> * -> *).
StateT
  (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity (LogInfo p)
returnFinal
                Maybe b
_ ->
                  case PatchInfoAndG rt p wX wY -> Maybe (p wX wY)
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
hopefullyM PatchInfoAndG rt p wX wY
hp of
                    Maybe (p wX wY)
Nothing -> do
                        let err :: Doc
err = String -> Doc
text String
"Can't find patches prior to:"
                                  Doc -> Doc -> Doc
$$ PatchInfo -> Doc
displayPatchInfo (PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
hp)
                        LogInfo (PatchInfoAndG rt p)
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)]
-> Maybe Doc
-> LogInfo (PatchInfoAndG rt p)
forall (p :: * -> * -> *).
[(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
LogInfo [] [(AnchoredPath, AnchoredPath)]
renames (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
err))
                    Just p wX wY
p ->
                        case Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> Invertible p wY wX
-> (Bool, [AnchoredPath], [AnchoredPath],
    [(AnchoredPath, AnchoredPath)])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> p wX wY
-> (Bool, [AnchoredPath], [AnchoredPath],
    [(AnchoredPath, AnchoredPath)])
lookTouch ([(AnchoredPath, AnchoredPath)]
-> Maybe [(AnchoredPath, AnchoredPath)]
forall a. a -> Maybe a
Just [(AnchoredPath, AnchoredPath)]
renames) [AnchoredPath]
fs (Invertible p wX wY -> Invertible p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (p wX wY -> Invertible p wX wY
forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
mkInvertible p wX wY
p)) of
                            (Bool
True, [AnchoredPath]
affected, [], [(AnchoredPath, AnchoredPath)]
renames') ->
                                LogInfo (PatchInfoAndG rt p)
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)]
-> Maybe Doc
-> LogInfo (PatchInfoAndG rt p)
forall (p :: * -> * -> *).
[(Sealed2 p, [AnchoredPath])]
-> [(AnchoredPath, AnchoredPath)] -> Maybe Doc -> LogInfo p
LogInfo [(Sealed2 (PatchInfoAndG rt p)
s2hp, [AnchoredPath]
affected)] [(AnchoredPath, AnchoredPath)]
renames' Maybe Doc
forall a. Maybe a
Nothing)
                            (Bool
True, [AnchoredPath]
affected, [AnchoredPath]
fs', [(AnchoredPath, AnchoredPath)]
renames') -> do
                                let sub1Mb :: f b -> f b
sub1Mb f b
c = b -> b -> b
forall a. Num a => a -> a -> a
subtract b
1 (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
c
                                ((Maybe b, [(AnchoredPath, AnchoredPath)])
 -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
-> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Maybe b, [(AnchoredPath, AnchoredPath)])
  -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
 -> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ())
-> ((Maybe b, [(AnchoredPath, AnchoredPath)])
    -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
-> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ()
forall a b. (a -> b) -> a -> b
$ \(Maybe b
c, [(AnchoredPath, AnchoredPath)]
_) -> (Maybe b -> Maybe b
forall (f :: * -> *) b. (Functor f, Num b) => f b -> f b
sub1Mb Maybe b
c, [(AnchoredPath, AnchoredPath)]
renames')
                                LogInfo (PatchInfoAndG rt p)
rest <- [AnchoredPath]
-> [Sealed2 (PatchInfoAndG rt p)]
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
filterPatchesByNamesM [AnchoredPath]
fs' [Sealed2 (PatchInfoAndG rt p)]
ps
                                LogInfo (PatchInfoAndG rt p)
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
forall (m :: * -> *) a. Monad m => a -> m a
return (LogInfo (PatchInfoAndG rt p)
 -> StateT
      (Maybe Int, [(AnchoredPath, AnchoredPath)])
      Identity
      (LogInfo (PatchInfoAndG rt p)))
-> LogInfo (PatchInfoAndG rt p)
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
forall a b. (a -> b) -> a -> b
$ LogInfo (PatchInfoAndG rt p)
rest {
                                    liPatches :: [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
liPatches = (Sealed2 (PatchInfoAndG rt p)
s2hp, [AnchoredPath]
affected) (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
forall a. a -> [a] -> [a]
: LogInfo (PatchInfoAndG rt p)
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches LogInfo (PatchInfoAndG rt p)
rest
                                  }
                            (Bool
False, [AnchoredPath]
_, [AnchoredPath]
fs', [(AnchoredPath, AnchoredPath)]
renames') -> do
                                ((Maybe b, [(AnchoredPath, AnchoredPath)])
 -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
-> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Maybe b, [(AnchoredPath, AnchoredPath)])
  -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
 -> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ())
-> ((Maybe b, [(AnchoredPath, AnchoredPath)])
    -> (Maybe b, [(AnchoredPath, AnchoredPath)]))
-> StateT (Maybe Int, [(AnchoredPath, AnchoredPath)]) Identity ()
forall a b. (a -> b) -> a -> b
$ ([(AnchoredPath, AnchoredPath)] -> [(AnchoredPath, AnchoredPath)])
-> (Maybe b, [(AnchoredPath, AnchoredPath)])
-> (Maybe b, [(AnchoredPath, AnchoredPath)])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([(AnchoredPath, AnchoredPath)]
-> [(AnchoredPath, AnchoredPath)] -> [(AnchoredPath, AnchoredPath)]
forall a b. a -> b -> a
const [(AnchoredPath, AnchoredPath)]
renames')
                                [AnchoredPath]
-> [Sealed2 (PatchInfoAndG rt p)]
-> StateT
     (Maybe Int, [(AnchoredPath, AnchoredPath)])
     Identity
     (LogInfo (PatchInfoAndG rt p))
filterPatchesByNamesM [AnchoredPath]
fs' [Sealed2 (PatchInfoAndG rt p)]
ps

changelog :: forall rt p wStart wX
           . ( ShowPatch p, PatchListFormat p
             , Summary p, HasDeps p, PrimDetails (PrimOf p)
             )
          => [DarcsFlag] -> RL (PatchInfoAndG rt p) wStart wX
          -> LogInfo (PatchInfoAndG rt p)
          -> Doc
changelog :: [DarcsFlag]
-> RL (PatchInfoAndG rt p) wStart wX
-> LogInfo (PatchInfoAndG rt p)
-> Doc
changelog [DarcsFlag]
opts RL (PatchInfoAndG rt p) wStart wX
patches LogInfo (PatchInfoAndG rt p)
li
    | PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat PrimDarcsOption (Maybe ChangesFormat)
-> [DarcsFlag] -> Maybe ChangesFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Maybe ChangesFormat -> Maybe ChangesFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ChangesFormat -> Maybe ChangesFormat
forall a. a -> Maybe a
Just ChangesFormat
O.CountPatches =
        String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])] -> Int)
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])] -> Int
forall a b. (a -> b) -> a -> b
$ LogInfo (PatchInfoAndG rt p)
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches LogInfo (PatchInfoAndG rt p)
li
    | [DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts = Doc
xml_changelog
    | WithSummary -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool -> Bool -> Bool
|| [DarcsFlag] -> Bool
verbose [DarcsFlag]
opts =
        [Doc] -> Doc
vsep ((Sealed2 (PatchInfoAndG rt p) -> Doc)
-> [Sealed2 (PatchInfoAndG rt p)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Sealed2 (PatchInfoAndG rt p) -> Doc)
-> Sealed2 (PatchInfoAndG rt p) -> Doc
forall (re :: RepoType).
(Sealed2 (PatchInfoAndG re p) -> Doc)
-> Sealed2 (PatchInfoAndG re p) -> Doc
number_patch Sealed2 (PatchInfoAndG rt p) -> Doc
change_with_summary) [Sealed2 (PatchInfoAndG rt p)]
ps) Doc -> Doc -> Doc
$$ Doc
mbErr
    | Bool
otherwise = [Doc] -> Doc
vsep ((Sealed2 (PatchInfoAndG rt p) -> Doc)
-> [Sealed2 (PatchInfoAndG rt p)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Sealed2 (PatchInfoAndG rt p) -> Doc)
-> Sealed2 (PatchInfoAndG rt p) -> Doc
forall (re :: RepoType).
(Sealed2 (PatchInfoAndG re p) -> Doc)
-> Sealed2 (PatchInfoAndG re p) -> Doc
number_patch Sealed2 (PatchInfoAndG rt p) -> Doc
description') [Sealed2 (PatchInfoAndG rt p)]
ps) Doc -> Doc -> Doc
$$ Doc
mbErr
    where ps_and_fs :: [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
ps_and_fs = LogInfo (PatchInfoAndG rt p)
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
forall (p :: * -> * -> *).
LogInfo p -> [(Sealed2 p, [AnchoredPath])]
liPatches LogInfo (PatchInfoAndG rt p)
li
          mbErr :: Doc
mbErr = Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
forall a. Monoid a => a
mempty (LogInfo (PatchInfoAndG rt p) -> Maybe Doc
forall (p :: * -> * -> *). LogInfo p -> Maybe Doc
liErrorMsg LogInfo (PatchInfoAndG rt p)
li)
          change_with_summary :: Sealed2 (PatchInfoAndG rt p) -> Doc
          change_with_summary :: Sealed2 (PatchInfoAndG rt p) -> Doc
change_with_summary (Sealed2 PatchInfoAndG rt p wX wY
hp)
            | Just p wX wY
p <- PatchInfoAndG rt p wX wY -> Maybe (p wX wY)
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
hopefullyM PatchInfoAndG rt p wX wY
hp =
              if PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat PrimDarcsOption (Maybe ChangesFormat)
-> [DarcsFlag] -> Maybe ChangesFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Maybe ChangesFormat -> Maybe ChangesFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ChangesFormat -> Maybe ChangesFormat
forall a. a -> Maybe a
Just ChangesFormat
O.MachineReadable
                then ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage p wX wY
p
                else Verbosity -> WithSummary -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> Doc
showFriendly (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) p wX wY
p
            | Bool
otherwise = PatchInfoAndG rt p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description PatchInfoAndG rt p wX wY
hp Doc -> Doc -> Doc
$$ Doc -> Doc
indent (String -> Doc
text String
"[this patch is unavailable]")

          xml_changelog :: Doc
xml_changelog = [Doc] -> Doc
vcat
            [ String -> Doc
text String
"<changelog>"
            , [Doc] -> Doc
vcat [Doc]
xml_created_as
            , [Doc] -> Doc
vcat [Doc]
xml_changes
            , String -> Doc
text String
"</changelog>"
            ]

          xml_with_summary :: Sealed2 (PatchInfoAndG rt p) -> Doc
          xml_with_summary :: Sealed2 (PatchInfoAndG rt p) -> Doc
xml_with_summary (Sealed2 PatchInfoAndG rt p wX wY
hp) | Just p wX wY
p <- PatchInfoAndG rt p wX wY -> Maybe (p wX wY)
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
hopefullyM PatchInfoAndG rt p wX wY
hp =
                    let
                      deps :: [PatchInfo]
deps = p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps p wX wY
p
                      xmlDependencies :: Doc
xmlDependencies =
                        String -> Doc
text String
"<explicit_dependencies>"
                        Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
indent (Doc -> Doc) -> (PatchInfo -> Doc) -> PatchInfo -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> Doc
toXmlShort) [PatchInfo]
deps)
                        Doc -> Doc -> Doc
$$ String -> Doc
text String
"</explicit_dependencies>"
                      summary :: Doc
summary | [PatchInfo]
deps [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [] = Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
(Summary p, PrimDetails (PrimOf p)) =>
p wX wY -> Doc
xmlSummary p wX wY
p
                              | Bool
otherwise = Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
xmlDependencies Doc -> Doc -> Doc
$$ p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
(Summary p, PrimDetails (PrimOf p)) =>
p wX wY -> Doc
xmlSummary p wX wY
p
                    in
                      Doc -> Doc -> Doc
insertBeforeLastline (PatchInfo -> Doc
toXml (PatchInfo -> Doc) -> PatchInfo -> Doc
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
hp) Doc
summary
          xml_with_summary (Sealed2 PatchInfoAndG rt p wX wY
hp) = PatchInfo -> Doc
toXml (PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
hp)
          indent :: Doc -> Doc
indent = String -> Doc -> Doc
prefix String
"    "
          xml_changes :: [Doc]
xml_changes =
            case PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
              WithSummary
O.YesSummary -> (Sealed2 (PatchInfoAndG rt p) -> Doc)
-> [Sealed2 (PatchInfoAndG rt p)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Sealed2 (PatchInfoAndG rt p) -> Doc
xml_with_summary [Sealed2 (PatchInfoAndG rt p)]
ps
              WithSummary
O.NoSummary -> (Sealed2 (PatchInfoAndG rt p) -> Doc)
-> [Sealed2 (PatchInfoAndG rt p)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PatchInfo -> Doc
toXml (PatchInfo -> Doc)
-> (Sealed2 (PatchInfoAndG rt p) -> PatchInfo)
-> Sealed2 (PatchInfoAndG rt p)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX wY. PatchInfoAndG rt p wX wY -> PatchInfo)
-> Sealed2 (PatchInfoAndG rt p) -> PatchInfo
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall wX wY. PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) [Sealed2 (PatchInfoAndG rt p)]
ps
          xml_created_as :: [Doc]
xml_created_as = ((AnchoredPath, AnchoredPath) -> Doc)
-> [(AnchoredPath, AnchoredPath)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath, AnchoredPath) -> Doc
create (LogInfo (PatchInfoAndG rt p) -> [(AnchoredPath, AnchoredPath)]
forall (p :: * -> * -> *).
LogInfo p -> [(AnchoredPath, AnchoredPath)]
liRenames LogInfo (PatchInfoAndG rt p)
li) where
            create :: (AnchoredPath, AnchoredPath) -> Doc
            create :: (AnchoredPath, AnchoredPath) -> Doc
create rename :: (AnchoredPath, AnchoredPath)
rename@(AnchoredPath
_, AnchoredPath
as) = PatchInfo -> (AnchoredPath, AnchoredPath) -> Doc
createdAsXml (AnchoredPath -> PatchInfo
first_change_of AnchoredPath
as) (AnchoredPath, AnchoredPath)
rename
            -- We need to reorder the patches when they haven't been reversed
            -- already, so that we find the *first* patch that modifies a given
            -- file, not the last (by default, the list is oldest->newest).
            reorderer :: [a] -> [a]
reorderer = if Bool -> Bool
not (PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) then [a] -> [a]
forall a. [a] -> [a]
reverse else [a] -> [a]
forall a. a -> a
id
            oldest_first_ps_and_fs :: [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
oldest_first_ps_and_fs = [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
forall a. [a] -> [a]
reorderer [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
ps_and_fs
            couldnt_find :: AnchoredPath -> a
couldnt_find AnchoredPath
fn = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find first patch affecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      (AnchoredPath -> String
displayPath AnchoredPath
fn) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in ps_and_fs"
            mb_first_change_of :: AnchoredPath
-> Maybe (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
mb_first_change_of AnchoredPath
fn = ((Sealed2 (PatchInfoAndG rt p), [AnchoredPath]) -> Bool)
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> Maybe (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((AnchoredPath
fn AnchoredPath -> [AnchoredPath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([AnchoredPath] -> Bool)
-> ((Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
    -> [AnchoredPath])
-> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sealed2 (PatchInfoAndG rt p), [AnchoredPath]) -> [AnchoredPath]
forall a b. (a, b) -> b
snd) [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
oldest_first_ps_and_fs
            find_first_change_of :: AnchoredPath -> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
find_first_change_of AnchoredPath
fn = (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> Maybe (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
forall a. a -> Maybe a -> a
fromMaybe (AnchoredPath -> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
forall a. AnchoredPath -> a
couldnt_find AnchoredPath
fn)
              (AnchoredPath
-> Maybe (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
mb_first_change_of AnchoredPath
fn)
            first_change_of :: AnchoredPath -> PatchInfo
            first_change_of :: AnchoredPath -> PatchInfo
first_change_of = (forall wX wY. PatchInfoAndG rt p wX wY -> PatchInfo)
-> Sealed2 (PatchInfoAndG rt p) -> PatchInfo
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall wX wY. PatchInfoAndG rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info (Sealed2 (PatchInfoAndG rt p) -> PatchInfo)
-> (AnchoredPath -> Sealed2 (PatchInfoAndG rt p))
-> AnchoredPath
-> PatchInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> Sealed2 (PatchInfoAndG rt p)
forall a b. (a, b) -> a
fst ((Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
 -> Sealed2 (PatchInfoAndG rt p))
-> (AnchoredPath -> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath]))
-> AnchoredPath
-> Sealed2 (PatchInfoAndG rt p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
find_first_change_of

          number_patch :: (Sealed2 (PatchInfoAndG re p) -> Doc)
-> Sealed2 (PatchInfoAndG re p) -> Doc
number_patch Sealed2 (PatchInfoAndG re p) -> Doc
f Sealed2 (PatchInfoAndG re p)
x = if PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat PrimDarcsOption (Maybe ChangesFormat)
-> [DarcsFlag] -> Maybe ChangesFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Maybe ChangesFormat -> Maybe ChangesFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ChangesFormat -> Maybe ChangesFormat
forall a. a -> Maybe a
Just ChangesFormat
O.NumberPatches
                             then case Sealed2 (PatchInfoAndG re p) -> Maybe Int
forall (re :: RepoType). Sealed2 (PatchInfoAndG re p) -> Maybe Int
get_number Sealed2 (PatchInfoAndG re p)
x of
                                  Just Int
n -> String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":") Doc -> Doc -> Doc
<+> Sealed2 (PatchInfoAndG re p) -> Doc
f Sealed2 (PatchInfoAndG re p)
x
                                  Maybe Int
Nothing -> Sealed2 (PatchInfoAndG re p) -> Doc
f Sealed2 (PatchInfoAndG re p)
x
                             else Sealed2 (PatchInfoAndG re p) -> Doc
f Sealed2 (PatchInfoAndG re p)
x

          get_number :: Sealed2 (PatchInfoAndG re p) -> Maybe Int
          get_number :: Sealed2 (PatchInfoAndG re p) -> Maybe Int
get_number (Sealed2 PatchInfoAndG re p wX wY
y) = Int -> RL (PatchInfoAndG rt p) wStart wX -> Maybe Int
forall wY. Int -> RL (PatchInfoAndG rt p) wStart wY -> Maybe Int
gn Int
1 RL (PatchInfoAndG rt p) wStart wX
patches
              where iy :: PatchInfo
iy = PatchInfoAndG re p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG re p wX wY
y
                    gn :: Int -> RL (PatchInfoAndG rt p) wStart wY -> Maybe Int
                    gn :: Int -> RL (PatchInfoAndG rt p) wStart wY -> Maybe Int
gn Int
n (RL (PatchInfoAndG rt p) wStart wY
bs:<:PatchInfoAndG rt p wY wY
b) | Int -> PatchInfo -> PatchInfo
seq Int
n (PatchInfoAndG rt p wY wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wY wY
b) PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
iy = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                                  | Bool
otherwise = Int -> RL (PatchInfoAndG rt p) wStart wY -> Maybe Int
forall wY. Int -> RL (PatchInfoAndG rt p) wStart wY -> Maybe Int
gn (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RL (PatchInfoAndG rt p) wStart wY
bs
                    gn Int
_ RL (PatchInfoAndG rt p) wStart wY
NilRL = Maybe Int
forall a. Maybe a
Nothing
          ps :: [Sealed2 (PatchInfoAndG rt p)]
ps = ((Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
 -> Sealed2 (PatchInfoAndG rt p))
-> [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
-> [Sealed2 (PatchInfoAndG rt p)]
forall a b. (a -> b) -> [a] -> [b]
map (Sealed2 (PatchInfoAndG rt p), [AnchoredPath])
-> Sealed2 (PatchInfoAndG rt p)
forall a b. (a, b) -> a
fst [(Sealed2 (PatchInfoAndG rt p), [AnchoredPath])]
ps_and_fs
          description' :: Sealed2 (PatchInfoAndG rt p) -> Doc
description' = (forall wX wY. PatchInfoAndG rt p wX wY -> Doc)
-> Sealed2 (PatchInfoAndG rt p) -> Doc
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall wX wY. PatchInfoAndG rt p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description

logContext :: [DarcsFlag] -> IO ()
logContext :: [DarcsFlag] -> IO ()
logContext [DarcsFlag]
opts = do
  let repodir :: String
repodir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe String
getRepourl [DarcsFlag]
opts
  UseCache -> String -> RepoJob () -> IO ()
forall a. UseCache -> String -> RepoJob a -> IO a
withRepositoryLocation (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
repodir (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
  (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
  Repository rt p wR wU wR -> IO ())
 -> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
    (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
    Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repository -> do
      (PatchSet rt p Origin wZ
_ :> RL (PatchInfoAnd rt p) wZ wR
ps) <- PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wX wY
contextPatches (PatchSet rt p Origin wR
 -> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wR)
-> IO (PatchSet rt p Origin wR)
-> IO ((:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
      let header :: Doc
header = String -> Doc
text String
"\nContext:\n"
      Printers -> Doc -> IO ()
viewDocWith Printers
simplePrinters (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep
          (Doc
header Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (forall wW wZ. PatchInfoAnd rt p wW wZ -> Doc)
-> RL (PatchInfoAnd rt p) wZ wR -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
ForStorage (PatchInfo -> Doc)
-> (PatchInfoAndG rt (Named p) wW wZ -> PatchInfo)
-> PatchInfoAndG rt (Named p) wW wZ
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) RL (PatchInfoAnd rt p) wZ wR
ps)

-- | changes is an alias for log
changes :: DarcsCommand
changes :: DarcsCommand
changes = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"changes" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
log

createdAsXml :: PatchInfo -> (AnchoredPath, AnchoredPath) -> Doc
createdAsXml :: PatchInfo -> (AnchoredPath, AnchoredPath) -> Doc
createdAsXml PatchInfo
pinfo (AnchoredPath
current, AnchoredPath
createdAs) =
    String -> Doc
text String
"<created_as current_name='"
       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
escapeXML (AnchoredPath -> String
displayPath AnchoredPath
current)
       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"' original_name='"
       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
escapeXML (AnchoredPath -> String
displayPath AnchoredPath
createdAs)
       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'>"
    Doc -> Doc -> Doc
$$    PatchInfo -> Doc
toXml PatchInfo
pinfo
    Doc -> Doc -> Doc
$$    String -> Doc
text String
"</created_as>"

logPatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
logPatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
logPatchSelOpts [DarcsFlag]
flags = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> WithSummary
-> WithContext
-> PatchSelectionOptions
S.PatchSelectionOptions
    { verbosity :: Verbosity
S.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 = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveralOrRange [DarcsFlag]
flags
    , interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
False [DarcsFlag]
flags
    , selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps -- option not supported, use default
    , withSummary :: WithSummary
S.withSummary = PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withContext :: WithContext
S.withContext = PrimDarcsOption WithContext
withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    }