src/Darcs/Commands/Annotate.lhs

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