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 \darcsCommand{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 ( intersect, 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 match_maxcount, maxCount, 42 all_interactive, showFriendly, 43 network_options 44 ) 45 import Darcs.RepoPath ( toFilePath, rootDirectory ) 46 import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path ) 47 import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd, 48 get_unrecorded_in_files_unsorted, 49 withRepositoryDirectory, ($-), findRepository, 50 read_repo ) 51 import Darcs.Patch.Info ( to_xml, showPatchInfo ) 52 import Darcs.Patch.Depends ( get_common_and_uncommon ) 53 import Darcs.Patch.TouchesFiles ( look_touch ) 54 import Darcs.Patch ( RepoPatch, invert, xml_summary, description, apply_to_filepaths, 55 list_touched_files, effect, identity ) 56 import Darcs.Ordered ( (:\/:)(..), RL(..), unsafeFL, unsafeUnRL, concatRL, 57 EqCheck(..), filterFL ) 58 import Darcs.Match ( first_match, second_match, 59 match_a_patchread, have_nonrange_match, 60 match_first_patchset, match_second_patchset, 61 ) 62 import Darcs.Commands.Annotate ( created_as_xml ) 63 import Printer ( Doc, putDocLnWith, simplePrinters, (<+>), 64 renderString, prefix, text, vcat, vsep, 65 ($$), empty, errorDoc, insert_before_lastline ) 66 import Darcs.ColorPrinter ( fancyPrinters ) 67 import Progress ( setProgressMode, debugMessage ) 68 import Darcs.SelectChanges ( view_changes ) 69 import Darcs.Sealed ( unsafeUnseal ) 70 #include "impossible.h" 71 72 changes_description :: String 73 changes_description = "Gives a changelog-style summary of the repository history." 74 75 changes_help :: String 76 changes_help = 77 "Changes gives a changelog-style summary of the repository history,\n"++ 78 "including options for altering how the patches are selected and displayed.\n" 79 80 changes :: DarcsCommand 81 changes = DarcsCommand {command_name = "changes", 82 command_help = changes_help, 83 command_description = changes_description, 84 command_extra_args = -1, 85 command_extra_arg_help = ["[FILE or DIRECTORY]..."], 86 command_get_arg_possibilities = return [], 87 command_command = changes_cmd, 88 command_prereq = findRepository, 89 command_argdefaults = nodefaults, 90 command_advanced_options = network_options, 91 command_basic_options = [match_several_or_range, 92 match_maxcount, 93 only_to_files, 94 changes_format, 95 summary, 96 changes_reverse, 97 possibly_remote_repo_dir, 98 working_repo_dir, 99 all_interactive]} 100 101 changes_cmd :: [DarcsFlag] -> [String] -> IO () 102 changes_cmd [Context _] [] = return () 103 changes_cmd opts args | Context rootDirectory `elem` opts = 104 let repodir = fromMaybe "." (get_repourl opts) in 105 withRepositoryDirectory opts repodir $- \repository -> do 106 when (args /= []) $ fail "changes --context cannot accept other arguments" 107 changes_context repository opts 108 changes_cmd opts args = 109 let repodir = fromMaybe "." (get_repourl opts) in 110 withRepositoryDirectory opts repodir $- \repository -> do 111 unless (Debug `elem` opts) $ setProgressMode False 112 files <- sort `fmap` fixSubPaths opts args 113 unrec <- if null files then return identity 114 else get_unrecorded_in_files_unsorted repository (map (fp2fn . toFilePath) files) 115 `catch` \_ -> return identity -- this is triggered when repository is remote 116 let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files 117 filtered_changes p = maybe_reverse $ get_changes_info opts filez p 118 debugMessage "About to read the repository..." 119 patches <- read_repo repository 120 debugMessage "Done reading the repository." 121 if Interactive `elem` opts 122 then do let (fp_and_fs, _, _) = filtered_changes patches 123 fp = map fst fp_and_fs 124 view_changes opts (unsafeFL fp) 125 else do when (not (null files) && not (XMLOutput `elem` opts)) $ 126 putStrLn $ "Changes to "++unwords filez++":\n" 127 debugMessage "About to print the changes..." 128 let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters 129 ps <- read_repo repository -- read repo again to prevent holding onto 130 -- values forced by filtered_changes 131 putDocLnWith printers $ changelog opts ps $ filtered_changes patches 132 where maybe_reverse (xs,b,c) = if Reverse `elem` opts 133 then (reverse xs, b, c) 134 else (xs, b, c) 135 \end{code} 136 137 When given one or more files or directories as an argument, changes lists only 138 those patches which affect those files or the contents of those directories or, 139 of course, the directories themselves. This includes changes that happened to 140 files before they were moved or renamed. 141 142 \begin{options} 143 --from-match, --from-patch, --from-tag 144 \end{options} 145 146 If changes is given a \verb!--from-patch!, \verb!--from-match!, or 147 \verb!--from-tag! option, it outputs only those changes since that tag or 148 patch. 149 150 Without any options to limit the scope of the changes, history will be displayed 151 going back as far as possible. 152 153 \begin{options} 154 --max-count 155 \end{options} 156 157 If changes is given a \verb!--max-count! option, it only outputs up to as that 158 number of changes. 159 160 \begin{code} 161 get_changes_info :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p 162 -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc) 163 get_changes_info opts plain_fs ps = 164 case get_common_and_uncommon (p2s,p1s) of 165 (_,us:\/:_) -> filter_patches_by_names (maxCount opts) fs $ filter pf $ unsafeUnRL $ concatRL us 166 where fs = map (\x -> "./" ++ x) $ plain_fs 167 p1s = if first_match opts then unsafeUnseal $ match_first_patchset opts ps 168 else NilRL:<:NilRL 169 p2s = if second_match opts then unsafeUnseal $ match_second_patchset opts ps 170 else ps 171 pf = if have_nonrange_match opts 172 then match_a_patchread opts 173 else \_ -> True 174 175 -- | Take a list of filenames and patches and produce a list of 176 -- patches that actually touch the given files with list of touched 177 -- file names, a new file list that represents the same set of files 178 -- as in input, before the returned patches would have been applied, 179 -- and possibly an error. Additionaly, the function takes a "depth 180 -- limit" -- maxcount, that could be Nothing (return everything) or 181 -- "Just n" -- returns at most n patches touching the file (starting 182 -- from the beginning of the patch list). 183 filter_patches_by_names :: RepoPatch p => 184 Maybe Int -- ^ maxcount 185 -> [FilePath] -- ^ filenames 186 -> [PatchInfoAnd p] -- ^ patchlist 187 -> ([(PatchInfoAnd p,[FilePath])], [FilePath], Doc) 188 filter_patches_by_names (Just 0) _ _ = ([], [], empty) 189 filter_patches_by_names _ _ [] = ([], [], empty) 190 filter_patches_by_names maxcount [] (hp:ps) = 191 (hp, []) -:- filter_patches_by_names (subtract 1 `fmap` maxcount) [] ps 192 filter_patches_by_names maxcount fs (hp:ps) 193 | Just p <- hopefullyM hp = 194 case look_touch fs (invert p) of 195 (True, []) -> ([(hp, fs)], fs, empty) 196 (True, fs') -> (hp, fs) -:- filter_patches_by_names 197 (subtract 1 `fmap` maxcount) fs' ps 198 (False, fs') -> filter_patches_by_names maxcount fs' ps 199 filter_patches_by_names _ _ (hp:_) = 200 ([], [], text "Can't find changes prior to:" $$ description hp) 201 202 -- | Note, lazy pattern matching is required to make functions like 203 -- filter_patches_by_names lazy in case you are only not interested in 204 -- the first element. E.g.: 205 -- 206 -- let (fs, _, _) = filter_patches_by_names ... 207 (-:-) :: a -> ([a],b,c) -> ([a],b,c) 208 x -:- ~(xs,y,z) = (x:xs,y,z) 209 210 changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc) 211 -> Doc 212 changelog opts patchset (pis_and_fs, orig_fs, errstring) 213 | Count `elem` opts = text $ show $ length pis_and_fs 214 | MachineReadable `elem` opts = 215 if renderString errstring == "" 216 then vsep $ map (showPatchInfo.info) pis 217 else errorDoc errstring 218 | XMLOutput `elem` opts = 219 text "<changelog>" 220 $$ vcat xml_file_names 221 $$ vcat actual_xml_changes 222 $$ text "</changelog>" 223 | Summary `elem` opts || Verbose `elem` opts = 224 vsep (map (number_patch change_with_summary) pis_and_fs) 225 $$ errstring 226 | otherwise = vsep (map (number_patch description') pis_and_fs) 227 $$ errstring 228 where change_with_summary (hp, fs) 229 | Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts 230 then description hp $$ text "" $$ 231 indent (showFriendly opts (filterFL xx $ effect p)) 232 else showFriendly opts p 233 | otherwise = description hp 234 $$ indent (text "[this patch is unavailable]") 235 where xx x = case list_touched_files x of 236 ys | null $ ys `intersect` fs -> IsEq 237 _ -> NotEq 238 xml_with_summary hp 239 | Just p <- hopefullyM hp = insert_before_lastline 240 (to_xml $ info hp) (indent $ xml_summary p) 241 xml_with_summary hp = to_xml (info hp) 242 indent = prefix " " 243 actual_xml_changes = if Summary `elem` opts 244 then map xml_with_summary pis 245 else map (to_xml.info) pis 246 xml_file_names = map (created_as_xml first_change) orig_fs 247 first_change = if Reverse `elem` opts 248 then info $ head pis 249 else info $ last pis 250 number_patch f x = if NumberPatches `elem` opts 251 then case get_number (fst x) of 252 Just n -> text (show n++":") <+> f x 253 Nothing -> f x 254 else f x 255 get_number :: PatchInfoAnd p -> Maybe Int 256 get_number y = gn 1 (concatRL patchset) 257 where iy = info y 258 gn n (b:<:bs) | seq n (info b) == iy = Just n 259 | otherwise = gn (n+1) bs 260 gn _ NilRL = Nothing 261 pis = map fst pis_and_fs 262 description' = description . fst 263 264 \end{code} 265 266 \begin{options} 267 --context, --human-readable, --xml-output 268 \end{options} 269 270 When given the \verb!--context! flag, darcs changes outputs sufficient 271 information to allow the current state of the repository to be 272 recreated at a later date. This information should generally be piped to a 273 file, and then can be used later in conjunction with 274 \verb!darcs get --context! to recreate the current version. Note that 275 while the \verb!--context! flag may be used in conjunction with 276 \verb!--xml-output! or \verb!--human-readable!, in neither case will darcs 277 get be able to read the output. On the other hand, sufficient information 278 \emph{will} be output for a knowledgeable human to recreate the current 279 state of the repository. 280 \begin{code} 281 changes_context :: RepoPatch p => Repository p -> [DarcsFlag] -> IO () 282 changes_context repository opts = do 283 r <- read_repo repository 284 putStrLn "\nContext:\n" 285 when (not $ null (unsafeUnRL r) || null (unsafeUnRL $ head $ unsafeUnRL r)) $ 286 putDocLnWith simplePrinters $ changelog opts' NilRL $ 287 get_changes_info opts' [] 288 (headRL (slightly_optimize_patchset r) :<: NilRL) 289 where opts' = if HumanReadable `elem` opts || XMLOutput `elem` opts 290 then opts 291 else MachineReadable : opts 292 headRL (x:<:_) = x 293 headRL NilRL = impossible 294 \end{code}