src/Darcs/Commands/Replace.lhs

   1 %  Copyright (C) 2002-2005 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 replace}
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp #-}
  21 {-# LANGUAGE CPP #-}
  22
  23 module Darcs.Commands.Replace ( replace ) where
  24
  25 import Data.Maybe ( isJust )
  26 import Control.Monad ( unless )
  27
  28 import Darcs.Commands
  29 import Darcs.Arguments
  30 import Darcs.Repository ( withRepoLock, ($-),
  31                     add_to_pending,
  32                     amInRepository, slurp_recorded_and_unrecorded,
  33                     applyToWorking,
  34                   )
  35 import Darcs.Patch ( Prim, apply_to_slurpy, tokreplace, force_replace_slurpy )
  36 import Darcs.Ordered ( FL(..), unsafeFL, (+>+), concatFL )
  37 import Darcs.SlurpDirectory ( slurp_hasfile, Slurpy )
  38 import RegChars ( regChars )
  39 import Data.Char ( isSpace )
  40 import Darcs.Diff ( unsafeDiff )
  41 import Darcs.RepoPath ( SubPath, sp2fn, toFilePath )
  42 import Darcs.Repository.Prefs ( FileType(TextFile) )
  43 #include "impossible.h"
  44 \end{code}
  45
  46 \begin{code}
  47 replace_description :: String
  48 replace_description =
  49  "Replace a token with a new value for that token."
  50 \end{code}
  51
  52 \options{replace}
  53
  54 \haskell{replace_help}
  55
  56 The default regexp is \verb![A-Za-z_0-9]!), and if one of your tokens
  57 contains a `\verb|-|' or `\verb|.|', you will then (by default) get the ``filename''
  58 regexp, which is \verb![A-Za-z_0-9\-\.]!.
  59
  60 \begin{options}
  61 --token-chars
  62 \end{options}
  63
  64 If you prefer to choose a different set of characters to define your token
  65 (perhaps because you are programming in some other language), you may do so
  66 with the \verb!--token-chars! option.  You may prefer to define tokens in terms
  67 of delimiting characters instead of allowed characters using a flag such as
  68 \verb!--token-chars '[^ \n\t]'!, which would define a token as being
  69 white-space delimited.
  70
  71 If you do choose a non-default token definition, I recommend using
  72 \verb!_darcs/prefs/defaults! to always specify the same
  73 \verb!--token-chars!, since your replace patches will be better behaved (in
  74 terms of commutation and merges) if they have tokens defined in the same
  75 way.
  76
  77 When using darcs replace, the ``new'' token may not already appear in the
  78 file---if that is the case, the replace change would not be invertible.
  79 This limitation holds only on the already-recorded version of the file.
  80
  81 There is a potentially confusing difference, however, when a replace is
  82 used to make another replace possible:
  83 \begin{verbatim}
  84 % darcs replace newtoken aaack ./foo.c
  85 % darcs replace oldtoken newtoken ./foo.c
  86 % darcs record
  87 \end{verbatim}
  88 will be valid, even if \verb!newtoken! and \verb!oldtoken! are both present
  89 in the recorded version of foo.c, while the sequence
  90 \begin{verbatim}
  91 % [manually edit foo.c replacing newtoken with aaack]
  92 % darcs replace oldtoken newtoken ./foo.c
  93 \end{verbatim}
  94 will fail because ``newtoken'' still exists in the recorded version of
  95 \verb!foo.c!.  The reason for the difference is that when recording, a
  96 ``replace'' patch always is recorded \emph{before} any manual changes,
  97 which is usually what you want, since often you will introduce new
  98 occurrences of the ``newtoken'' in your manual changes.  In contrast,
  99 multiple ``replace'' changes are recorded in the order in which
 100 they were made.
 101
 102 \begin{code}
 103 replace_help :: String
 104 replace_help =
 105  "Replace allows you to change a specified token wherever it\n"++
 106  "occurs in the specified files.  The replace is encoded in a\n"++
 107  "special patch and will merge as expected with other patches.\n"++
 108  "Tokens here are defined by a regexp specifying the characters\n"++
 109  "which are allowed.  By default a token corresponds to a C identifier.\n"
 110 \end{code}
 111
 112 \begin{code}
 113 replace :: DarcsCommand
 114 replace = DarcsCommand {command_name = "replace",
 115                         command_help = replace_help,
 116                         command_description = replace_description,
 117                         command_extra_args = -1,
 118                         command_extra_arg_help = ["<OLD>","<NEW>",
 119                                                   "<FILE> ..."],
 120                         command_command = replace_cmd,
 121                         command_prereq = amInRepository,
 122                         command_get_arg_possibilities = list_registered_files,
 123                         command_argdefaults = nodefaults,
 124                         command_advanced_options = [ignoretimes, umask_option],
 125                         command_basic_options =
 126                             [tokens, force_replace, working_repo_dir]}
 127 \end{code}
 128
 129 \begin{code}
 130 replace_cmd :: [DarcsFlag] -> [String] -> IO ()
 131 replace_cmd opts (old:new:relfs) = withRepoLock opts $- \repository -> do
 132   fs <- fixSubPaths opts relfs
 133   toks <- choose_toks opts old new
 134   let checkToken tok =
 135         unless (is_tok toks tok) $ fail $ "'"++tok++"' is not a valid token!"
 136   checkToken old
 137   checkToken new
 138   (cur, work) <- slurp_recorded_and_unrecorded repository
 139   pswork <- (concatFL . unsafeFL) `fmap` sequence (map (repl toks cur work) fs)
 140   add_to_pending repository pswork
 141   applyToWorking repository opts pswork `catch` \e ->
 142       fail $ "Can't do replace on working!\n"
 143           ++ "Perhaps one of the files already contains '"++ new++"'?\n"
 144           ++ show e
 145   where ftf _ = TextFile
 146
 147         repl :: String -> Slurpy -> Slurpy -> SubPath -> IO (FL Prim)
 148         repl toks cur work f =
 149           if not $ slurp_hasfile (sp2fn f) work
 150           then do putStrLn $ "Skipping file '"++f_fp++"' which isn't in the repository."
 151                   return NilFL
 152           else if ForceReplace `elem` opts ||
 153                   isJust (apply_to_slurpy (tokreplace f_fp toks old new) work) ||
 154                   isJust (apply_to_slurpy (tokreplace f_fp toks old new) cur)
 155                then return (get_force_replace f toks work)
 156                else do putStrLn $ "Skipping file '"++f_fp++"'"
 157                        putStrLn $ "Perhaps the recorded version of this " ++
 158                                   "file already contains '" ++new++"'?"
 159                        putStrLn $ "Use the --force option to override."
 160                        return NilFL
 161           where f_fp = toFilePath f
 162
 163         get_force_replace :: SubPath -> String -> Slurpy -> FL Prim
 164         get_force_replace f toks s =
 165             case force_replace_slurpy (tokreplace f_fp toks new old) s of
 166             Nothing -> bug "weird forcing bug in replace."
 167             Just s' -> case unsafeDiff [] ftf s s' of
 168                        pfix -> pfix +>+ (tokreplace f_fp toks old new :>: NilFL)
 169             where f_fp = toFilePath f
 170
 171 replace_cmd _ _ = fail "Usage: darcs replace OLD NEW [FILES]"
 172 \end{code}
 173
 174 \begin{code}
 175 default_toks :: String
 176 default_toks = "A-Za-z_0-9"
 177 filename_toks :: String
 178 filename_toks = "A-Za-z_0-9\\-\\."
 179 is_tok :: String -> String -> Bool
 180 is_tok _ "" = False
 181 is_tok toks s = and $ map (regChars toks) s
 182
 183 choose_toks :: [DarcsFlag] -> String -> String -> IO String
 184 choose_toks (Toks t:_) a b
 185     | any isSpace t = fail $ bad_token_spec $ "Space is not allowed in the spec"
 186     | length t <= 2 = fail $ bad_token_spec $
 187                         "It must contain more than 2 characters, because " ++
 188                         "it should be enclosed in square brackets"
 189     | head t /= '[' || last t /= ']' = fail $ bad_token_spec $
 190                         "It should be enclosed in square brackets"
 191     | not (is_tok tok a) = fail $ bad_token_spec $ not_a_token a
 192     | not (is_tok tok b) = fail $ bad_token_spec $ not_a_token b
 193     | otherwise          = return tok
 194     where tok = init $ tail t :: String
 195           bad_token_spec msg = "Bad token spec: '"++ t ++"' ("++ msg ++")"
 196           not_a_token x = x ++ " is not a token, according to your spec"
 197 choose_toks (_:fs) a b = choose_toks fs a b
 198 choose_toks [] a b = if is_tok default_toks a && is_tok default_toks b
 199                      then return default_toks
 200                      else return filename_toks
 201 \end{code}
 202