src/Darcs/Commands/Changes.lhs

   1 %  Copyright (C) 2003-2004 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \subsection{darcs changes}
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
  21 {-# LANGUAGE CPP, PatternGuards #-}
  22
  23 module Darcs.Commands.Changes ( changes ) where
  24
  25 import Data.List ( sort )
  26 import Data.Maybe ( fromMaybe )
  27 import Control.Monad ( when, unless )
  28
  29 import Darcs.Hopefully ( hopefullyM, info )
  30 import Darcs.Patch.Depends ( slightly_optimize_patchset )
  31 import Darcs.Commands ( DarcsCommand(..), nodefaults )
  32 import Darcs.Arguments ( DarcsFlag(Context, HumanReadable, MachineReadable,
  33                                    Interactive, OnlyChangesToFiles, Count,
  34                                    NumberPatches, XMLOutput, Summary,
  35                                    Reverse, Verbose, Debug),
  36                          fixSubPaths, changes_format,
  37                          possibly_remote_repo_dir, get_repourl,
  38                          working_repo_dir, only_to_files,
  39                          summary, changes_reverse,
  40                          match_several_or_range,
  41                          all_interactive, showFriendly,
  42                          network_options
  43                       )
  44 import Darcs.RepoPath ( toFilePath, rootDirectory )
  45 import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path )
  46 import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd, get_unrecorded_unsorted,
  47                           withRepositoryDirectory, ($-), findRepository,
  48                           read_repo, slurp_recorded )
  49 import Darcs.Patch.Info ( to_xml, showPatchInfo )
  50 import Darcs.Patch.Depends ( get_common_and_uncommon )
  51 import Darcs.Patch.TouchesFiles ( look_touch )
  52 import Darcs.Patch ( RepoPatch, invert, xml_summary, description, apply_to_filepaths,
  53                      list_touched_files, effect, identity )
  54 import Darcs.Ordered ( (:\/:)(..), RL(..), unsafeFL, unsafeUnRL, concatRL,
  55                              EqCheck(..), filterFL )
  56 import Darcs.Match ( first_match, second_match,
  57                match_a_patchread, have_nonrange_match,
  58                match_first_patchset, match_second_patchset,
  59              )
  60 import Darcs.Commands.Annotate ( created_as_xml )
  61 import ByteStringUtils ( linesPS )
  62 import Printer ( Doc, putDocLnWith, simplePrinters, renderPS, (<+>),
  63                  renderString, prefix,
  64                  packedString, text, vcat, vsep, ($$), empty, errorDoc )
  65 import Darcs.ColorPrinter ( fancyPrinters )
  66 import Darcs.Progress ( setProgressMode, debugMessage )
  67 import Darcs.SelectChanges ( view_changes )
  68 import Darcs.Sealed ( unsafeUnseal )
  69 #include "impossible.h"
  70 \end{code}
  71
  72 \options{changes}
  73 \begin{code}
  74 changes_description :: String
  75 changes_description = "Gives a changelog-style summary of the repository history."
  76 \end{code}
  77 \haskell{changes_help}
  78 \begin{code}
  79 changes_help :: String
  80 changes_help =
  81  "Changes gives a changelog-style summary of the repository history,\n"++
  82  "including options for altering how the patches are selected and displayed.\n"
  83
  84 changes :: DarcsCommand
  85 changes = DarcsCommand {command_name = "changes",
  86                         command_help = changes_help,
  87                         command_description = changes_description,
  88                         command_extra_args = -1,
  89                         command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  90                         command_get_arg_possibilities = return [],
  91                         command_command = changes_cmd,
  92                         command_prereq = findRepository,
  93                         command_argdefaults = nodefaults,
  94                         command_advanced_options = network_options,
  95                         command_basic_options = [match_several_or_range,
  96                                                  only_to_files,
  97                                                  changes_format,
  98                                                  summary,
  99                                                  changes_reverse,
 100                                                  possibly_remote_repo_dir,
 101                                                  working_repo_dir,
 102                                                  all_interactive]}
 103 \end{code}
 104
 105
 106 \begin{code}
 107 changes_cmd :: [DarcsFlag] -> [String] -> IO ()
 108 changes_cmd [Context _] [] = return ()
 109 changes_cmd opts args | Context rootDirectory `elem` opts =
 110   let repodir = fromMaybe "." (get_repourl opts) in
 111   withRepositoryDirectory opts repodir $- \repository -> do
 112   when (args /= []) $ fail "changes --context cannot accept other arguments"
 113   changes_context repository opts
 114 changes_cmd opts args =
 115   let repodir = fromMaybe "." (get_repourl opts) in
 116   withRepositoryDirectory opts repodir $- \repository -> do
 117   unless (Debug `elem` opts) $ setProgressMode False
 118   files <- sort `fmap` fixSubPaths opts args
 119   unrec <- get_unrecorded_unsorted repository
 120            `catch` \_ -> return identity -- this is triggered when repository is remote
 121   let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files
 122       filtered_changes p = maybe_reverse $ get_changes_info opts filez p
 123   debugMessage "About to read the repository..."
 124   patches <- read_repo repository
 125   debugMessage "Done reading the repository."
 126   if Interactive `elem` opts
 127     then do let (fp,_,_) = filtered_changes patches
 128             s <- slurp_recorded repository
 129             view_changes opts s filez (unsafeFL fp)
 130     else do when (not (null files) && not (XMLOutput `elem` opts)) $
 131                  putStrLn $ "Changes to "++unwords filez++":\n"
 132             debugMessage "About to print the changes..."
 133             let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters
 134             ps <- read_repo repository
 135             putDocLnWith printers $ changelog opts ps $ filtered_changes patches
 136   where maybe_reverse (xs,b,c) = if Reverse `elem` opts
 137                                  then (reverse xs, b, c)
 138                                  else (xs, b, c)
 139 \end{code}
 140
 141 When given one or more files or directories as an argument, changes lists only
 142 those patches which affect those files or the contents of those directories or,
 143 of course, the directories themselves. This includes changes that happened to
 144 files before they were moved or renamed.
 145
 146 \begin{options}
 147 --from-match, --from-patch, --from-tag
 148 \end{options}
 149
 150 If changes is given a \verb!--from-patch!, \verb!--from-match!, or
 151 \verb!--from-tag! option, it outputs only those changes since that tag or
 152 patch.
 153
 154 Without any options to limit the scope of the changes, history will be displayed
 155 going back as far as possible.
 156
 157
 158 \begin{code}
 159 get_changes_info :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p
 160                  -> ([PatchInfoAnd p], [FilePath], Doc)
 161 get_changes_info opts plain_fs ps =
 162   case get_common_and_uncommon (p2s,p1s) of
 163   (_,us:\/:_) -> filter_patches_by_names fs $ filter pf $ unsafeUnRL $ concatRL us
 164   where fs = map (\x -> "./" ++ x) $ plain_fs
 165         p1s = if first_match opts then unsafeUnseal $ match_first_patchset opts ps
 166                                   else NilRL:<:NilRL
 167         p2s = if second_match opts then unsafeUnseal $ match_second_patchset opts ps
 168                                    else ps
 169         pf = if have_nonrange_match opts
 170              then match_a_patchread opts
 171              else \_ -> True
 172
 173 filter_patches_by_names :: RepoPatch p => [FilePath]
 174                         -> [PatchInfoAnd p]
 175                         -> ([PatchInfoAnd p],[FilePath], Doc)
 176 filter_patches_by_names _ [] = ([], [], empty)
 177 filter_patches_by_names [] pps = (pps, [], empty)
 178 filter_patches_by_names fs (hp:ps)
 179     | Just p <- hopefullyM hp =
 180     case look_touch fs (invert p) of
 181     (True, []) -> ([hp], fs, empty)
 182     (True, fs') -> hp -:- filter_patches_by_names fs' ps
 183     (False, fs') -> filter_patches_by_names fs' ps
 184 filter_patches_by_names _ (hp:_) =
 185     ([], [], text "Can't find changes prior to:" $$ description hp)
 186
 187 (-:-) :: a -> ([a],b,c) -> ([a],b,c)
 188 x -:- (xs,y,z) = (x:xs,y,z)
 189
 190 changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([PatchInfoAnd p], [FilePath], Doc)
 191           -> Doc
 192 changelog opts patchset (pis, fs, errstring)
 193     | Count `elem` opts = text $ show $ length pis
 194     | MachineReadable `elem` opts =
 195         if renderString errstring == ""
 196         then vsep $ map (showPatchInfo.info) pis
 197         else errorDoc errstring
 198     | XMLOutput `elem` opts =
 199          text "<changelog>"
 200       $$ vcat xml_file_names
 201       $$ vcat actual_xml_changes
 202       $$ text "</changelog>"
 203     | Summary `elem` opts || Verbose `elem`  opts =
 204            vsep (map (number_patch change_with_summary) pis)
 205         $$ errstring
 206     | otherwise = vsep (map (number_patch description) pis)
 207                $$ errstring
 208     where change_with_summary hp
 209               | Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts
 210                                           then description hp $$
 211                                                showFriendly opts (filterFL xx $ effect p)
 212                                           else showFriendly opts p
 213               | otherwise = description hp
 214                             $$ indent (text "[this patch is unavailable]")
 215               where xx x = case list_touched_files x of
 216                              [z] | z `elem` fs -> NotEq
 217                              _ -> IsEq
 218           xml_with_summary hp
 219               | Just p <- hopefullyM hp = insert_before_lastline
 220                                            (to_xml $ info hp) (indent $ xml_summary p)
 221           xml_with_summary hp = to_xml (info hp)
 222           indent = prefix "    "
 223           actual_xml_changes = if Summary `elem` opts
 224                                then map xml_with_summary pis
 225                                else map (to_xml.info) pis
 226           xml_file_names = map (created_as_xml first_change) fs
 227           first_change = if Reverse `elem` opts
 228                          then info $ head pis
 229                          else info $ last pis
 230           number_patch f x = if NumberPatches `elem` opts
 231                              then case get_number x of
 232                                   Just n -> text (show n++":") <+> f x
 233                                   Nothing -> f x
 234                              else f x
 235           get_number :: PatchInfoAnd p -> Maybe Int
 236           get_number y = gn 1 (concatRL patchset)
 237               where iy = info y
 238                     gn n (b:<:bs) | seq n (info b) == iy = Just n
 239                                   | otherwise = gn (n+1) bs
 240                     gn _ NilRL = Nothing
 241
 242 insert_before_lastline :: Doc -> Doc -> Doc
 243 insert_before_lastline a b =
 244     case reverse $ map packedString $ linesPS $ renderPS a of
 245     (ll:ls) -> vcat (reverse ls) $$ b $$ ll
 246     [] -> impossible
 247 \end{code}
 248
 249 \begin{options}
 250 --context, --human-readable, --xml-output
 251 \end{options}
 252
 253 When given the \verb!--context! flag, darcs changes outputs sufficient
 254 information to allow the current state of the repository to be
 255 recreated at a later date.  This information should generally be piped to a
 256 file, and then can be used later in conjunction with
 257 \verb!darcs get --context! to recreate the current version.  Note that
 258 while the \verb!--context! flag may be used in conjunction with
 259 \verb!--xml-output! or \verb!--human-readable!, in neither case will darcs
 260 get be able to read the output.  On the other hand, sufficient information
 261 \emph{will} be output for a knowledgeable human to recreate the current
 262 state of the repository.
 263 \begin{code}
 264 changes_context :: RepoPatch p => Repository p -> [DarcsFlag] -> IO ()
 265 changes_context repository opts = do
 266   r <- read_repo repository
 267   putStrLn "\nContext:\n"
 268   when (not $ null (unsafeUnRL r) || null (unsafeUnRL $ head $ unsafeUnRL r)) $
 269     putDocLnWith simplePrinters $ changelog opts' NilRL $
 270                  get_changes_info opts' []
 271                  (headRL (slightly_optimize_patchset r) :<: NilRL)
 272     where opts' = if HumanReadable `elem` opts || XMLOutput `elem` opts
 273                   then opts
 274                   else MachineReadable : opts
 275           headRL (x:<:_) = x
 276           headRL NilRL = impossible
 277 \end{code}