1 % Copyright (C) 2003 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{annotate} 19 \begin{code} 20 {-# LANGUAGE CPP #-} 21 {-# OPTIONS_GHC -cpp #-} 22 23 #include "gadts.h" 24 25 module Darcs.Commands.Annotate ( annotate, created_as_xml ) where 26 27 import Control.Monad ( when ) 28 import Data.List ( sort ) 29 30 import Darcs.Commands ( DarcsCommand(..), nodefaults ) 31 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, 32 summary, unified, human_readable, 33 xmloutput, creatorhash, 34 fixSubPaths, 35 list_registered_files, 36 match_one, 37 ) 38 import Darcs.SlurpDirectory ( slurp ) 39 import Darcs.Repository ( Repository, PatchSet, amInRepository, withRepository, ($-), read_repo, 40 getMarkedupFile ) 41 import Darcs.Patch ( RepoPatch, Named, LineMark(..), patch2patchinfo, xml_summary ) 42 import qualified Darcs.Patch ( summary ) 43 import Darcs.Ordered ( mapRL, concatRL ) 44 import qualified Data.ByteString.Char8 as BC ( unpack, ByteString ) 45 import Darcs.PrintPatch ( printPatch, contextualPrintPatch ) 46 import Darcs.Patch.Info ( PatchInfo, human_friendly, to_xml, make_filename, 47 showPatchInfo ) 48 import Darcs.PopulationData ( Population(..), PopTree(..), DirMark(..), 49 nameI, modifiedByI, modifiedHowI, 50 createdByI, creationNameI, 51 ) 52 import Darcs.Population ( getRepoPopVersion, lookup_pop, lookup_creation_pop, 53 modified_to_xml, 54 ) 55 import Darcs.Hopefully ( info ) 56 import Darcs.RepoPath ( SubPath, toFilePath ) 57 import Darcs.Match ( match_patch, have_nonrange_match, get_first_match ) 58 import Darcs.Lock ( withTempDir ) 59 import Darcs.Sealed ( Sealed2(..), unseal2 ) 60 import Printer ( putDocLn, text, errorDoc, ($$), prefix, (<+>), 61 Doc, empty, vcat, (<>), renderString, packedString ) 62 #include "impossible.h" 63 64 annotate_description :: String 65 annotate_description = "Display which patch last modified something." 66 67 annotate_help :: String 68 annotate_help = 69 "Annotate displays which patches created or last modified a directory\n"++ 70 "file or line. It can also display the contents of a particular patch\n"++ 71 "in darcs format.\n" 72 73 annotate :: DarcsCommand 74 annotate = DarcsCommand {command_name = "annotate", 75 command_help = annotate_help, 76 command_description = annotate_description, 77 command_extra_args = -1, 78 command_extra_arg_help = ["[FILE or DIRECTORY]..."], 79 command_command = annotate_cmd, 80 command_prereq = amInRepository, 81 command_get_arg_possibilities = list_registered_files, 82 command_argdefaults = nodefaults, 83 command_advanced_options = [], 84 command_basic_options = [summary,unified, 85 human_readable, 86 xmloutput, 87 match_one, creatorhash, 88 working_repo_dir]} 89 \end{code} 90 91 \begin{options} 92 --human-readable, --summary, --unified, --xml--output 93 \end{options} 94 95 When called with just a patch name, annotate outputs the patch in darcs format, 96 which is the same as \verb!--human-readable!. 97 98 \verb!--xml-output! is the alternative to \verb!--human-readable!. 99 100 \verb!--summary! can be used with either the \verb!--xml-output! or the 101 \verb!--human-readable! options to alter the results. It is documented 102 fully in the `common options' portion of the manual. 103 104 Giving the \verb!--unified! flag implies \verb!--human-readable!, and causes 105 the output to remain in a darcs-specific format that is similar to that produced 106 by \verb!diff --unified!. 107 \begin{code} 108 annotate_cmd :: [DarcsFlag] -> [String] -> IO () 109 annotate_cmd opts [] = withRepository opts $- \repository -> do 110 when (not $ have_nonrange_match opts) $ 111 fail $ "Annotate requires either a patch pattern or a " ++ 112 "file or directory argument." 113 Sealed2 p <- match_patch opts `fmap` read_repo repository 114 if Summary `elem` opts 115 then do putDocLn $ showpi $ patch2patchinfo p 116 putDocLn $ show_summary p 117 else if Unified `elem` opts 118 then withTempDir "context" $ \_ -> 119 do get_first_match repository opts 120 c <- slurp "." 121 contextualPrintPatch c p 122 else printPatch p 123 where showpi | MachineReadable `elem` opts = showPatchInfo 124 | XMLOutput `elem` opts = to_xml 125 | otherwise = human_friendly 126 show_summary :: RepoPatch p => Named p C(x y) -> Doc 127 show_summary = if XMLOutput `elem` opts 128 then xml_summary 129 else Darcs.Patch.summary 130 \end{code} 131 132 If a directory name is given, annotate will output details of the last 133 modifying patch for each file in the directory and the directory itself. The 134 details look like this: 135 136 \begin{verbatim} 137 # Created by [bounce handling patch 138 # mark**20040526202216] as ./test/m7/bounce_handling.pl 139 bounce_handling.pl 140 \end{verbatim} 141 142 If a patch name and a directory are given, these details are output for the time after 143 that patch was applied. If a directory and a tag name are given, the 144 details of the patches involved in the specified tagged version will be output. 145 \begin{code} 146 annotate_cmd opts args@[_] = withRepository opts $- \repository -> do 147 r <- read_repo repository 148 (rel_file_or_directory:_) <- fixSubPaths opts args 149 let file_or_directory = rel_file_or_directory 150 pinfo <- if have_nonrange_match opts 151 then return $ patch2patchinfo `unseal2` (match_patch opts r) 152 else case mapRL info $ concatRL r of 153 [] -> fail "Annotate does not currently work correctly on empty repositories." 154 (x:_) -> return x 155 pop <- getRepoPopVersion "." pinfo 156 157 -- deal with --creator-hash option 158 let maybe_creation_pi = find_creation_patchinfo opts r 159 lookup_thing = case maybe_creation_pi of 160 Nothing -> lookup_pop 161 Just cp -> lookup_creation_pop cp 162 163 if toFilePath file_or_directory == "" 164 then case pop of (Pop _ pt) -> annotate_pop opts pinfo pt 165 else case lookup_thing (toFilePath file_or_directory) pop of 166 Nothing -> fail $ "There is no file or directory named '"++ 167 toFilePath file_or_directory++"'" 168 Just (Pop _ pt@(PopDir i _)) 169 | modifiedHowI i == RemovedDir && modifiedByI i /= pinfo -> 170 errorDoc $ text ("The directory '" ++ toFilePath rel_file_or_directory ++ 171 "' was removed by") 172 $$ human_friendly (modifiedByI i) 173 | otherwise -> annotate_pop opts pinfo pt 174 Just (Pop _ pt@(PopFile i)) 175 | modifiedHowI i == RemovedFile && modifiedByI i /= pinfo -> 176 errorDoc $ text ("The file '" ++ toFilePath rel_file_or_directory ++ 177 "' was removed by") 178 $$ human_friendly (modifiedByI i) 179 | otherwise -> annotate_file repository opts pinfo file_or_directory pt 180 181 annotate_cmd _ _ = fail "annotate accepts at most one argument" 182 183 annotate_pop :: [DarcsFlag] -> PatchInfo -> PopTree -> IO () 184 annotate_pop opts pinfo pt = putDocLn $ p2format pinfo pt 185 where p2format = if XMLOutput `elem` opts 186 then p2xml 187 else p2s 188 189 indent :: Doc -> [Doc] 190 -- This is a bit nasty: 191 indent = map (text . i) . lines . renderString 192 where i "" = "" 193 i ('#':s) = ('#':s) 194 i s = " "++s 195 196 -- Annotate a directory listing 197 p2s :: PatchInfo -> PopTree -> Doc 198 p2s pinfo (PopFile inf) = 199 created_str 200 $$ f <+> file_change 201 where f = packedString $ nameI inf 202 file_created = text "Created by" 203 <+> showPatchInfo (fromJust $ createdByI inf) 204 <+> text "as" 205 <+> packedString (fromJust $ creationNameI inf) 206 created_str = prefix "# " file_created 207 file_change = if modifiedByI inf == pinfo 208 then text $ show (modifiedHowI inf) 209 else empty 210 p2s pinfo (PopDir inf pops) = 211 created_str 212 $$ dir <+> dir_change 213 $$ vcat (map (vcat . indent . p2s pinfo) $ sort pops) 214 where dir = packedString (nameI inf) <> text "/" 215 dir_created = 216 if createdByI inf /= Nothing 217 then text "Created by " 218 <+> showPatchInfo (fromJust $ createdByI inf) 219 <+> text "as" 220 <+> packedString (fromJust $ creationNameI inf) <> text "/" 221 else text "Root directory" 222 created_str = prefix "# " dir_created 223 dir_change = if modifiedByI inf == pinfo 224 then text $ show (modifiedHowI inf) 225 else empty 226 227 escapeXML :: String -> Doc 228 escapeXML = text . strReplace '\'' "'" . strReplace '"' """ . 229 strReplace '>' ">" . strReplace '<' "<" . strReplace '&' "&" 230 231 strReplace :: Char -> String -> String -> String 232 strReplace _ _ [] = [] 233 strReplace x y (z:zs) 234 | x == z = y ++ (strReplace x y zs) 235 | otherwise = z : (strReplace x y zs) 236 237 created_as_xml :: PatchInfo -> String -> Doc 238 created_as_xml pinfo as = text "<created_as original_name='" 239 <> escapeXML as 240 <> text "'>" 241 $$ to_xml pinfo 242 $$ text "</created_as>" 243 --removed_by_xml :: PatchInfo -> String 244 --removed_by_xml pinfo = "<removed_by>\n"++to_xml pinfo++"</removed_by>\n" 245 246 p2xml_open :: PatchInfo -> PopTree -> Doc 247 p2xml_open _ (PopFile inf) = 248 text "<file name='" <> escapeXML f <> text "'>" 249 $$ created 250 $$ modified 251 where f = BC.unpack $ nameI inf 252 created = case createdByI inf of 253 Nothing -> empty 254 Just ci -> created_as_xml ci 255 (BC.unpack $ fromJust $ creationNameI inf) 256 modified = modified_to_xml inf 257 p2xml_open _ (PopDir inf _) = 258 text "<directory name='" <> escapeXML f <> text "'>" 259 $$ created 260 $$ modified 261 where f = BC.unpack $ nameI inf 262 created = case createdByI inf of 263 Nothing -> empty 264 Just ci -> created_as_xml ci 265 (BC.unpack $ fromJust $ creationNameI inf) 266 modified = modified_to_xml inf 267 268 p2xml_close :: PatchInfo -> PopTree -> Doc 269 p2xml_close _(PopFile _) = text "</file>" 270 p2xml_close _ (PopDir _ _) = text "</directory>" 271 272 p2xml :: PatchInfo -> PopTree -> Doc 273 p2xml pinf p@(PopFile _) = p2xml_open pinf p $$ p2xml_close pinf p 274 p2xml pinf p@(PopDir _ pops) = p2xml_open pinf p 275 $$ vcat (map (p2xml pinf) $ sort pops) 276 $$ p2xml_close pinf p 277 \end{code} 278 279 If a file name is given, the last modifying patch details of that file will be output, along 280 with markup indicating patch details when each line was last (and perhaps next) modified. 281 282 If a patch name and a file name are given, these details are output for the time after 283 that patch was applied. 284 285 \begin{code} 286 annotate_file :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> PatchInfo -> SubPath -> PopTree -> IO () 287 annotate_file repository opts pinfo f (PopFile inf) = do 288 if XMLOutput `elem` opts 289 then putDocLn $ p2xml_open pinfo (PopFile inf) 290 else if createdByI inf /= Nothing 291 then putAnn $ text ("File "++toFilePath f++" created by ") 292 <> showPatchInfo ci <> text (" as " ++ createdname) 293 else putAnn $ text $ "File "++toFilePath f 294 mk <- getMarkedupFile repository ci createdname 295 old_pis <- (dropWhile (/= pinfo).mapRL info.concatRL) `fmap` read_repo repository 296 mapM_ (annotate_markedup opts pinfo old_pis) mk 297 when (XMLOutput `elem` opts) $ putDocLn $ p2xml_close pinfo (PopFile inf) 298 where ci = fromJust $ createdByI inf 299 createdname = BC.unpack $ fromJust $ creationNameI inf 300 annotate_file _ _ _ _ _ = impossible 301 302 annotate_markedup :: [DarcsFlag] -> PatchInfo -> [PatchInfo] 303 -> (BC.ByteString, LineMark) -> IO () 304 annotate_markedup opts | XMLOutput `elem` opts = xml_markedup 305 | otherwise = text_markedup 306 307 text_markedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO () 308 text_markedup _ _ (l,None) = putLine ' ' l 309 text_markedup pinfo old_pis (l,RemovedLine wheni) 310 | wheni == pinfo = putLine '-' l 311 | wheni `elem` old_pis = return () 312 | otherwise = putLine ' ' l 313 text_markedup pinfo old_pis (l,AddedLine wheni) 314 | wheni == pinfo = putLine '+' l 315 | wheni `elem` old_pis = do putAnn $ text "Following line added by " 316 <> showPatchInfo wheni 317 putLine ' ' l 318 | otherwise = return () 319 text_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem) 320 | whenadd == pinfo = do putAnn $ text "Following line removed by " 321 <> showPatchInfo whenrem 322 putLine '+' l 323 | whenrem == pinfo = do putAnn $ text "Following line added by " 324 <> showPatchInfo whenadd 325 putLine '-' l 326 | whenadd `elem` old_pis && not (whenrem `elem` old_pis) = 327 do putAnn $ text "Following line removed by " <> showPatchInfo whenrem 328 putAnn $ text "Following line added by " <> showPatchInfo whenadd 329 putLine ' ' l 330 | otherwise = return () 331 332 putLine :: Char -> BC.ByteString -> IO () 333 putLine c s = putStrLn $ c : BC.unpack s 334 putAnn :: Doc -> IO () 335 putAnn s = putDocLn $ prefix "# " s 336 337 xml_markedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO () 338 xml_markedup _ _ (l,None) = putLine ' ' l 339 xml_markedup pinfo old_pis (l,RemovedLine wheni) 340 | wheni == pinfo = putDocLn $ text "<removed_line>" 341 $$ escapeXML (BC.unpack l) 342 $$ text "</removed_line>" 343 | wheni `elem` old_pis = return () 344 | otherwise = putDocLn $ text "<normal_line>" 345 $$ text "<removed_by>" 346 $$ to_xml wheni 347 $$ text "</removed_by>" 348 $$ escapeXML (BC.unpack l) 349 $$ text "</normal_line>" 350 xml_markedup pinfo old_pis (l,AddedLine wheni) 351 | wheni == pinfo = putDocLn $ text "<added_line>" 352 $$ escapeXML (BC.unpack l) 353 $$ text "</added_line>" 354 | wheni `elem` old_pis = putDocLn $ text "<normal_line>" 355 $$ text "<added_by>" 356 $$ to_xml wheni 357 $$ text "</added_by>" 358 $$ escapeXML (BC.unpack l) 359 $$ text "</normal_line>" 360 | otherwise = return () 361 xml_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem) 362 | whenadd == pinfo = 363 putDocLn $ text "<added_line>" 364 $$ text "<removed_by>" 365 $$ to_xml whenrem 366 $$ text "</removed_by>" 367 $$ escapeXML (BC.unpack l) 368 $$ text "</added_line>" 369 | whenrem == pinfo = 370 putDocLn $ text "<removed_line>" 371 $$ text "<added_by>" 372 $$ to_xml whenadd 373 $$ text "</added_by>" 374 $$ escapeXML (BC.unpack l) 375 $$ text "</removed_line>" 376 | whenadd `elem` old_pis && not (whenrem `elem` old_pis) = 377 putDocLn $ text "<normal_line>" 378 $$ text "<removed_by>" 379 $$ to_xml whenrem 380 $$ text "</removed_by>" 381 $$ text "<added_by>" 382 $$ to_xml whenadd 383 $$ text "</added_by>" 384 $$ escapeXML (BC.unpack l) 385 $$ text "</normal_line>" 386 | otherwise = return () 387 \end{code} 388 389 \begin{options} 390 --creator-hash HASH 391 \end{options} 392 393 The \verb!--creator-hash! option should only be used in combination with a 394 file or directory to be annotated. In this case, the name of that file or 395 directory is interpreted to be its name \emph{at the time it was created}, 396 and the hash given along with \verb!--creator-hash! indicates the patch 397 that created the file or directory. This allows you to (relatively) easily 398 examine a file even if it has been renamed multiple times. 399 400 \begin{code} 401 find_creation_patchinfo :: [DarcsFlag] -> PatchSet p C(x) -> Maybe PatchInfo 402 find_creation_patchinfo [] _ = Nothing 403 find_creation_patchinfo (CreatorHash h:_) r = find_hash h $ mapRL info $ concatRL r 404 find_creation_patchinfo (_:fs) r = find_creation_patchinfo fs r 405 406 find_hash :: String -> [PatchInfo] -> Maybe PatchInfo 407 find_hash _ [] = Nothing 408 find_hash h (pinf:pinfs) 409 | take (length h) (make_filename pinf) == h = Just pinf 410 | otherwise = find_hash h pinfs 411 \end{code}