% Copyright (C) 20032004 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 021101301, USA.
\subsection{darcs changes}
\begin{code}
module Darcs.Commands.Changes ( changes ) where
import Data.List ( sort )
import Data.Maybe ( fromMaybe )
import Control.Monad ( when, unless )
import Darcs.Hopefully ( hopefullyM, info )
import Darcs.Patch.Depends ( slightly_optimize_patchset )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag(Context, HumanReadable, MachineReadable,
Interactive, OnlyChangesToFiles, Count,
NumberPatches, XMLOutput, Summary,
Reverse, Verbose, Debug),
fixSubPaths, changes_format,
possibly_remote_repo_dir, get_repourl,
working_repo_dir, only_to_files,
summary, changes_reverse,
match_several_or_range,
all_interactive, showFriendly,
network_options
)
import Darcs.RepoPath ( toFilePath, rootDirectory )
import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path )
import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd, get_unrecorded_unsorted,
withRepositoryDirectory, ($-), findRepository,
read_repo, slurp_recorded )
import Darcs.Patch.Info ( to_xml, showPatchInfo )
import Darcs.Patch.Depends ( get_common_and_uncommon )
import Darcs.Patch.TouchesFiles ( look_touch )
import Darcs.Patch ( RepoPatch, invert, xml_summary, description, apply_to_filepaths,
list_touched_files, effect, identity )
import Darcs.Ordered ( (:\/:)(..), RL(..), unsafeFL, unsafeUnRL, concatRL,
EqCheck(..), filterFL )
import Darcs.Match ( first_match, second_match,
match_a_patchread, have_nonrange_match,
match_first_patchset, match_second_patchset,
)
import Darcs.Commands.Annotate ( created_as_xml )
import ByteStringUtils ( linesPS )
import Printer ( Doc, putDocLnWith, simplePrinters, renderPS, (<+>),
renderString, prefix,
packedString, text, vcat, vsep, ($$), empty, errorDoc )
import Darcs.ColorPrinter ( fancyPrinters )
import Progress ( setProgressMode, debugMessage )
import Darcs.SelectChanges ( view_changes )
import Darcs.Sealed ( unsafeUnseal )
#include "impossible.h"
\end{code}
\options{changes}
\begin{code}
changes_description :: String
changes_description = "Gives a changelog-style summary of the repository history."
\end{code}
\haskell{changes_help}
\begin{code}
changes_help :: String
changes_help =
"Changes gives a changelog-style summary of the repository history,\n"++
"including options for altering how the patches are selected and displayed.\n"
changes :: DarcsCommand
changes = DarcsCommand {command_name = "changes",
command_help = changes_help,
command_description = changes_description,
command_extra_args = 1,
command_extra_arg_help = ["[FILE or DIRECTORY]..."],
command_get_arg_possibilities = return [],
command_command = changes_cmd,
command_prereq = findRepository,
command_argdefaults = nodefaults,
command_advanced_options = network_options,
command_basic_options = [match_several_or_range,
only_to_files,
changes_format,
summary,
changes_reverse,
possibly_remote_repo_dir,
working_repo_dir,
all_interactive]}
changes_cmd :: [DarcsFlag] -> [String] -> IO ()
changes_cmd [Context _] [] = return ()
changes_cmd opts args | Context rootDirectory `elem` opts =
let repodir = fromMaybe "." (get_repourl opts) in
withRepositoryDirectory opts repodir $- \repository -> do
when (args /= []) $ fail "changes --context cannot accept other arguments"
changes_context repository opts
changes_cmd opts args =
let repodir = fromMaybe "." (get_repourl opts) in
withRepositoryDirectory opts repodir $- \repository -> do
unless (Debug `elem` opts) $ setProgressMode False
files <- sort `fmap` fixSubPaths opts args
unrec <- get_unrecorded_unsorted repository
`catch` \_ -> return identity
let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files
filtered_changes p = maybe_reverse $ get_changes_info opts filez p
debugMessage "About to read the repository..."
patches <- read_repo repository
debugMessage "Done reading the repository."
if Interactive `elem` opts
then do let (fp,_,_) = filtered_changes patches
s <- slurp_recorded repository
view_changes opts s filez (unsafeFL fp)
else do when (not (null files) && not (XMLOutput `elem` opts)) $
putStrLn $ "Changes to "++unwords filez++":\n"
debugMessage "About to print the changes..."
let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters
ps <- read_repo repository
putDocLnWith printers $ changelog opts ps $ filtered_changes patches
where maybe_reverse (xs,b,c) = if Reverse `elem` opts
then (reverse xs, b, c)
else (xs, b, c)
\end{code}
When given one or more files or directories as an argument, changes lists only
those patches which affect those files or the contents of those directories or,
of course, the directories themselves. This includes changes that happened to
files before they were moved or renamed.
\begin{options}
\end{options}
If changes is given a \verb!--frompatch!, \verb!--frommatch!, or
\verb!--fromtag! option, it outputs only those changes since that tag or
patch.
Without any options to limit the scope of the changes, history will be displayed
going back as far as possible.
\begin{code}
get_changes_info :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p
-> ([PatchInfoAnd p], [FilePath], Doc)
get_changes_info opts plain_fs ps =
case get_common_and_uncommon (p2s,p1s) of
(_,us:\/:_) -> filter_patches_by_names fs $ filter pf $ unsafeUnRL $ concatRL us
where fs = map (\x -> "./" ++ x) $ plain_fs
p1s = if first_match opts then unsafeUnseal $ match_first_patchset opts ps
else NilRL:<:NilRL
p2s = if second_match opts then unsafeUnseal $ match_second_patchset opts ps
else ps
pf = if have_nonrange_match opts
then match_a_patchread opts
else \_ -> True
filter_patches_by_names :: RepoPatch p => [FilePath]
-> [PatchInfoAnd p]
-> ([PatchInfoAnd p],[FilePath], Doc)
filter_patches_by_names _ [] = ([], [], empty)
filter_patches_by_names [] pps = (pps, [], empty)
filter_patches_by_names fs (hp:ps)
| Just p <- hopefullyM hp =
case look_touch fs (invert p) of
(True, []) -> ([hp], fs, empty)
(True, fs') -> hp -:- filter_patches_by_names fs' ps
(False, fs') -> filter_patches_by_names fs' ps
filter_patches_by_names _ (hp:_) =
([], [], text "Can't find changes prior to:" $$ description hp)
(-:-) :: a -> ([a],b,c) -> ([a],b,c)
x -:- (xs,y,z) = (x:xs,y,z)
changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([PatchInfoAnd p], [FilePath], Doc)
-> Doc
changelog opts patchset (pis, fs, errstring)
| Count `elem` opts = text $ show $ length pis
| MachineReadable `elem` opts =
if renderString errstring == ""
then vsep $ map (showPatchInfo.info) pis
else errorDoc errstring
| XMLOutput `elem` opts =
text "<changelog>"
$$ vcat xml_file_names
$$ vcat actual_xml_changes
$$ text "</changelog>"
| Summary `elem` opts || Verbose `elem` opts =
vsep (map (number_patch change_with_summary) pis)
$$ errstring
| otherwise = vsep (map (number_patch description) pis)
$$ errstring
where change_with_summary hp
| Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts
then description hp $$
showFriendly opts (filterFL xx $ effect p)
else showFriendly opts p
| otherwise = description hp
$$ indent (text "[this patch is unavailable]")
where xx x = case list_touched_files x of
[z] | z `elem` fs -> NotEq
_ -> IsEq
xml_with_summary hp
| Just p <- hopefullyM hp = insert_before_lastline
(to_xml $ info hp) (indent $ xml_summary p)
xml_with_summary hp = to_xml (info hp)
indent = prefix " "
actual_xml_changes = if Summary `elem` opts
then map xml_with_summary pis
else map (to_xml.info) pis
xml_file_names = map (created_as_xml first_change) fs
first_change = if Reverse `elem` opts
then info $ head pis
else info $ last pis
number_patch f x = if NumberPatches `elem` opts
then case get_number x of
Just n -> text (show n++":") <+> f x
Nothing -> f x
else f x
get_number :: PatchInfoAnd p -> Maybe Int
get_number y = gn 1 (concatRL patchset)
where iy = info y
gn n (b:<:bs) | seq n (info b) == iy = Just n
| otherwise = gn (n+1) bs
gn _ NilRL = Nothing
insert_before_lastline :: Doc -> Doc -> Doc
insert_before_lastline a b =
case reverse $ map packedString $ linesPS $ renderPS a of
(ll:ls) -> vcat (reverse ls) $$ b $$ ll
[] -> impossible
\end{code}
\begin{options}
\end{options}
When given the \verb!--context! flag, darcs changes outputs sufficient
information to allow the current state of the repository to be
recreated at a later date. This information should generally be piped to a
file, and then can be used later in conjunction with
\verb!darcs get
while the \verb!--context! flag may be used in conjunction with
\verb!--xmloutput! or \verb!--humanreadable!, in neither case will darcs
get be able to read the output. On the other hand, sufficient information
\emph{will} be output for a knowledgeable human to recreate the current
state of the repository.
\begin{code}
changes_context :: RepoPatch p => Repository p -> [DarcsFlag] -> IO ()
changes_context repository opts = do
r <- read_repo repository
putStrLn "\nContext:\n"
when (not $ null (unsafeUnRL r) || null (unsafeUnRL $ head $ unsafeUnRL r)) $
putDocLnWith simplePrinters $ changelog opts' NilRL $
get_changes_info opts' []
(headRL (slightly_optimize_patchset r) :<: NilRL)
where opts' = if HumanReadable `elem` opts || XMLOutput `elem` opts
then opts
else MachineReadable : opts
headRL (x:<:_) = x
headRL NilRL = impossible
\end{code}