% 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; if not, write to the Free Software Foundation,
% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{darcs changes}
\begin{code}
module Changes ( changes ) where
import List ( sort )
import Control.Monad ( when )
import Depends ( slightly_optimize_patchset )
import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag(Context, MachineReadable, HumanReadable,
XMLOutput, Summary, Reverse),
fix_filepath, changes_format,
possibly_remote_repo_dir, get_repodir,
summary, changes_reverse,
match_range,
)
import Repository ( PatchSet, read_repo, maybe_in_repo )
import PatchInfo ( PatchInfo, human_friendly, to_xml, )
import Depends ( get_common_and_uncommon )
import TouchesFiles ( look_touch )
import Patch ( Patch, invert, patch_summary, xml_summary )
import Match ( first_match, second_match,
match_first_patchset, match_second_patchset,
)
import DarcsUtils ( catchall )
#include "impossible.h"
\end{code}
\options{changes}
\begin{code}
changes_description :: String
changes_description = "Gives a human-readable list of changes between versions.\n"
\end{code}
\haskell{changes_help}
\begin{code}
changes_help :: String
changes_help =
"Changes gives a human-readable list of changes between versions\n"++
"suitable for use as a changelog.\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 = maybe_in_repo,
command_argdefaults = nodefaults,
command_darcsoptions = [match_range,
changes_format,
summary,
changes_reverse,
possibly_remote_repo_dir]}
\end{code}
\begin{code}
changes_cmd :: [DarcsFlag] -> [String] -> IO ()
changes_cmd [Context ""] [] = do return ()
changes_cmd opts args | Context "" `elem` opts = do
when (args /= []) $ fail "changes --context cannot accept other arguments"
changes_context opts
changes_cmd opts args =
let files = sort $ map (fix_filepath opts) args in do
patches <- read_repo (get_repodir opts)
`catchall` (fail "changes must be run in a repo directory.")
when (not (null files) && not (XMLOutput `elem` opts)) $
putStr $ "Changes to "++unwords files++":\n\n"
putStr $ changelog opts $ maybe_reverse $ get_changes_info opts files patches
where maybe_reverse = if Reverse `elem` opts then reverse else \a->a
\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.
If changes is given a \verb!--from-patch!, \verb!--from-match!, or
\verb!--from-tag! option, it outputs only those changes since that tag or
patch.
\begin{code}
get_changes_info :: [DarcsFlag] -> [FilePath] -> PatchSet
-> [(PatchInfo, Maybe Patch)]
get_changes_info opts plain_fs ps =
case get_common_and_uncommon (p2s,p1s) of
(_,us,_) -> filter_patches_by_names fs $ concat us
where fs = map ("./"++) plain_fs
p1s = if first_match opts then match_first_patchset opts ps
else [[]]
p2s = if second_match opts then match_second_patchset opts ps
else ps
filter_patches_by_names :: [FilePath]
-> [(PatchInfo, Maybe Patch)]
-> [(PatchInfo, Maybe Patch)]
filter_patches_by_names _ [] = []
filter_patches_by_names [] pps = pps
filter_patches_by_names fs ((pinfo, Just p):ps) =
case look_touch fs (invert p) of
(True, []) -> [(pinfo, Just p)]
(True, fs') -> (pinfo, Just p) : filter_patches_by_names fs' ps
(False, fs') -> filter_patches_by_names fs' ps
filter_patches_by_names _ ((pinf, Nothing):_) =
error $ "Can't find changes prior to:\n" ++ human_friendly pinf
changelog :: [DarcsFlag] -> [(PatchInfo, Maybe Patch)] -> String
changelog opts pis
| MachineReadable `elem` opts = unlines $ map (show.fst) pis
| XMLOutput `elem` opts && Summary `elem` opts =
unlines $ [""] ++ (map xml_with_summary pis) ++ [""]
| XMLOutput `elem` opts =
unlines $ [""] ++ (map (to_xml.fst) pis) ++ [""]
| Summary `elem` opts = unlines $ map change_with_summary pis
| otherwise = unlines $ map (human_friendly.fst) pis
where change_with_summary (pinfo, Just p) = human_friendly pinfo ++
indent ("\n"++patch_summary p)
change_with_summary (pinfo, Nothing) =
human_friendly pinfo ++ indent "\n[this patch is unavailable]"
xml_with_summary (pinfo, Just p)
= insert_str_before_lastline
(to_xml pinfo) (indent $ "\n"++xml_summary p)
xml_with_summary (pinfo, Nothing) = to_xml pinfo
indent ('\n':s) = "\n "++ indent s
indent (c:cs) = c : indent cs
indent "" = ""
insert_str_before_lastline :: String -> String -> String
insert_str_before_lastline a b =
case reverse $ lines a of
(ll:ls) -> unlines $ reverse ls ++ lines b ++ [ll]
[] -> impossible
\end{code}
When given the \verb!--context! flag, darcs changes outputs sufficient
information which will 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 --context! to recreate the current version. Note that
while the \verb!--context! flag may be used in conjunction with
\verb!--xml-output! or \verb!--human-readable!, 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 :: [DarcsFlag] -> IO ()
changes_context opts = do
r <- read_repo $ get_repodir opts
when (r == []) $ fail "Empty repository!"
putStr "\nContext:\n\n"
putStr $ changelog opts' $ get_changes_info [] []
[head $ slightly_optimize_patchset r]
where opts' = if HumanReadable `elem` opts || XMLOutput `elem` opts
then opts
else MachineReadable : opts
\end{code}