module Darcs.UI.Commands.Replace
( replace
, defaultToks
) where
import Prelude ()
import Darcs.Prelude
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B
import Data.Char ( isSpace )
import Data.Maybe ( fromJust, isJust )
import Control.Exception ( catch, IOException )
import Control.Monad ( unless, filterM, void )
import Darcs.Util.Tree( readBlob, modifyTree, findFile, TreeItem(..), Tree
, makeBlobBS )
import Darcs.Util.Path( SubPath, toFilePath, AbsolutePath )
import Darcs.UI.Flags
( DarcsFlag
, verbosity, useCache, dryRun, umask, diffAlgorithm, fixSubPaths )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdateWorking(..) )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.Repository.Diff( treeDiff )
import Darcs.Patch ( PrimPatch, tokreplace, forceTokReplace
, maybeApplyToTree )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.RegChars ( regChars )
import Darcs.Repository
( withRepoLock
, RepoJob(..)
, addToPending
, applyToWorking
, readUnrecorded
)
import Darcs.Patch.TokenReplace ( defaultToks )
import Darcs.Repository.Prefs ( FileType(TextFile) )
import Darcs.Util.Path ( floatSubPath )
import Darcs.Patch.Witnesses.Ordered ( FL(..), (+>+), concatFL, toFL, nullFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal, FreeLeft, Gap(..), unFreeLeft, unseal )
replaceDescription :: String
replaceDescription :: String
replaceDescription = "Substitute one word for another."
replaceHelp :: String
replaceHelp :: String
replaceHelp =
"In addition to line-based patches, Darcs supports a limited form of\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"lexical substitution. Files are treated as sequences of words, and\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"each occurrence of the old word is replaced by the new word.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"This is intended to provide a clean way to rename a function or\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"variable. Such renamings typically affect lines all through the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"source code, so a traditional line-based patch would be very likely to\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"conflict with other branches, requiring manual merging.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Files are tokenized according to one simple rule: words are strings of\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"valid token characters, and everything between them (punctuation and\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"whitespace) is discarded. By default, valid token characters are\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"letters, numbers and the underscore (i.e. `[A-Za-z0-9_]`). However if\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"the old and/or new token contains either a hyphen or period, BOTH\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"hyphen and period are treated as valid (i.e. `[A-Za-z0-9_.-]`).\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"The set of valid characters can be customized using the `--token-chars`\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"option. The argument must be surrounded by square brackets. If a\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"hyphen occurs between two characters in the set, it is treated as a\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"set range. For example, in most locales `[A-Z]` denotes all uppercase\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"letters. If the first character is a caret, valid tokens are taken to\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"be the complement of the remaining characters. For example, `[^:\\n]`\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"could be used to match fields in the passwd(5), where records and\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"fields are separated by newlines and colons respectively.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"If you choose to use `--token-chars`, you are STRONGLY encouraged to do\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"so consistently. The consequences of using multiple replace patches\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"with different `--token-chars` arguments on the same file are not well\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"tested nor well understood.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"By default Darcs will refuse to perform a replacement if the new token\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"is already in use, because the replacements would be not be\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"distinguishable from the existing tokens. This behaviour can be\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"overridden by supplying the `--force` option, but an attempt to `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"rollback` the resulting patch will affect these existing tokens.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Limitations:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"The tokenizer treats files as byte strings, so it is not possible for\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"`--token-chars` to include multi-byte characters, such as the non-ASCII\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"parts of UTF-8. Similarly, trying to replace a \"high-bit\" character\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"from a unibyte encoding will also result in replacement of the same\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"byte in files with different encodings. For example, an acute a from\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"ISO 8859-1 will also match an alpha from ISO 8859-7.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Due to limitations in the patch file format, `--token-chars` arguments\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"cannot contain literal whitespace. For example, `[^ \\n\\t]` cannot be\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"used to declare all characters except the space, tab and newline as\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"valid within a word, because it contains a literal space.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Unlike POSIX regex(7) bracket expressions, character classes (such as\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"`[[:alnum:]]`) are NOT supported by `--token-chars`, and will be silently\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"treated as a simple set of characters.\n"
replace :: DarcsCommand [DarcsFlag]
replace :: DarcsCommand [DarcsFlag]
replace = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
-> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
{ commandProgramName :: String
commandProgramName = "darcs"
, commandName :: String
commandName = "replace"
, commandHelp :: String
commandHelp = String
replaceHelp
, commandDescription :: String
commandDescription = String
replaceDescription
, commandExtraArgs :: Int
commandExtraArgs = -1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [ "<OLD>"
, "<NEW>"
, "<FILE> ..."
]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
replaceCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
replaceArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec DarcsOptDescr DarcsFlag Any (UseIndex -> UMask -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (UseIndex -> UMask -> Any)
forall a.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
replaceAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String -> Bool -> Maybe String -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String -> Bool -> Maybe String -> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> Bool -> Maybe String -> a)
replaceBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
replaceOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
replaceOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
replaceOpts
}
where
replaceBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> Bool -> Maybe String -> a)
replaceBasicOpts = PrimOptSpec
DarcsOptDescr DarcsFlag (Bool -> Maybe String -> a) (Maybe String)
PrimDarcsOption (Maybe String)
O.tokens PrimOptSpec
DarcsOptDescr DarcsFlag (Bool -> Maybe String -> a) (Maybe String)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Maybe String -> Bool -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> Maybe String -> a)
PrimDarcsOption Bool
O.forceReplace OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Maybe String -> Bool -> Maybe String -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> Bool -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
PrimDarcsOption (Maybe String)
O.repoDir
replaceAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
replaceAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) UseIndex
PrimDarcsOption UseIndex
O.useIndex PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) UseIndex
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
PrimDarcsOption UMask
O.umask
replaceOpts :: DarcsOption
a
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
replaceOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> Bool -> Maybe String -> a)
replaceBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a)
(UseIndex -> UMask -> UseCache -> HooksConfig -> a)
-> DarcsOption
a
(Maybe String
-> Bool
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> a)
forall b c a.
DarcsOption
(Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> a)
(UseIndex -> UMask -> UseCache -> HooksConfig -> a)
forall a.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
replaceAdvancedOpts
replaceArgs :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO [String]
replaceArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
replaceArgs fps :: (AbsolutePath, AbsolutePath)
fps flags :: [DarcsFlag]
flags args :: [String]
args =
if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2
then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args
replaceCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
replaceCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
replaceCmd fps :: (AbsolutePath, AbsolutePath)
fps opts :: [DarcsFlag]
opts (old :: String
old : new :: String
new : relfs :: [String]
relfs@(_ : _)) =
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdateWorking
YesUpdateWorking (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$
\repository :: Repository rt p wR wU wR
repository -> do
[SubPath]
fs <- (AbsolutePath, AbsolutePath) -> [String] -> IO [SubPath]
fixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
relfs
String
toks <- Maybe String -> String -> String -> IO String
chooseToks (PrimDarcsOption (Maybe String)
O.tokens PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
old String
new
let checkToken :: String -> f ()
checkToken tok :: String
tok = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> String -> Bool
isTok String
toks String
tok) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
String -> f ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ "'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tok String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' is not a valid token!"
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
forall (f :: * -> *). MonadFail f => String -> f ()
checkToken [ String
old, String
new ]
Tree IO
working <- Repository rt p wR wU wR -> Maybe [SubPath] -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> Maybe [SubPath] -> IO (Tree IO)
readUnrecorded Repository rt p wR wU wR
repository Maybe [SubPath]
forall a. Maybe a
Nothing
[SubPath]
files <- (SubPath -> IO Bool) -> [SubPath] -> IO [SubPath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Tree IO -> SubPath -> IO Bool
forall (m :: * -> *). Tree m -> SubPath -> IO Bool
exists Tree IO
working) [SubPath]
fs
Sealed replacePs :: FL (PrimOf p) wU wX
replacePs <- (forall wX. FL (FL (PrimOf p)) wU wX -> FL (PrimOf p) wU wX)
-> Sealed (FL (FL (PrimOf p)) wU) -> Sealed (FL (PrimOf p) wU)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL (FL (PrimOf p)) wU wX -> FL (PrimOf p) wU wX
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (Sealed (FL (FL (PrimOf p)) wU) -> Sealed (FL (PrimOf p) wU))
-> ([FreeLeft (FL (PrimOf p))] -> Sealed (FL (FL (PrimOf p)) wU))
-> [FreeLeft (FL (PrimOf p))]
-> Sealed (FL (PrimOf p) wU)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FreeLeft (FL (PrimOf p))] -> Sealed (FL (FL (PrimOf p)) wU)
forall (a :: * -> * -> *) wX. [FreeLeft a] -> Sealed (FL a wX)
toFL ([FreeLeft (FL (PrimOf p))] -> Sealed (FL (PrimOf p) wU))
-> IO [FreeLeft (FL (PrimOf p))] -> IO (Sealed (FL (PrimOf p) wU))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(SubPath -> IO (FreeLeft (FL (PrimOf p))))
-> [SubPath] -> IO [FreeLeft (FL (PrimOf p))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Tree IO -> SubPath -> IO (FreeLeft (FL (PrimOf p)))
forall (prim :: * -> * -> *).
(PrimPatch prim, ApplyState prim ~ Tree) =>
String -> Tree IO -> SubPath -> IO (FreeLeft (FL prim))
doReplace String
toks Tree IO
working) [SubPath]
files
Repository rt p wR wU wR
-> UpdateWorking -> FL (PrimOf p) wU wX -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wU wR
repository UpdateWorking
YesUpdateWorking FL (PrimOf p) wU wX
replacePs
IO (Repository rt p wR wX wR) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository rt p wR wX wR) -> IO ())
-> IO (Repository rt p wR wX wR) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wR
-> Verbosity
-> FL (PrimOf p) wU wX
-> IO (Repository rt p wR wX wR)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wU wR
repository (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wX
replacePs IO (Repository rt p wR wX wR)
-> (IOException -> IO (Repository rt p wR wX wR))
-> IO (Repository rt p wR wX wR)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) ->
String -> IO (Repository rt p wR wX wR)
forall a. String -> a
bug (String -> IO (Repository rt p wR wX wR))
-> String -> IO (Repository rt p wR wX wR)
forall a b. (a -> b) -> a -> b
$ "Can't do replace on working!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
where
exists :: Tree m -> SubPath -> IO Bool
exists tree :: Tree m
tree file :: SubPath
file = if Maybe (Blob m) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Blob m) -> Bool) -> Maybe (Blob m) -> Bool
forall a b. (a -> b) -> a -> b
$ Tree m -> AnchoredPath -> Maybe (Blob m)
forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Blob m)
findFile Tree m
tree (SubPath -> AnchoredPath
floatSubPath SubPath
file)
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SubPath -> String
forall a. FilePathLike a => a -> String
skipmsg SubPath
file
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
skipmsg :: a -> String
skipmsg f :: a
f = "Skipping file '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. FilePathLike a => a -> String
toFilePath a
f
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' which isn't in the repository."
doReplace :: forall prim . (PrimPatch prim,
ApplyState prim ~ Tree) => String -> Tree IO
-> SubPath -> IO (FreeLeft (FL prim))
doReplace :: String -> Tree IO -> SubPath -> IO (FreeLeft (FL prim))
doReplace toks :: String
toks work :: Tree IO
work f :: SubPath
f = do
Maybe (Tree IO)
workReplaced <- prim Any Any -> Tree IO -> IO (Maybe (Tree IO))
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> Tree IO -> IO (Maybe (Tree IO))
maybeApplyToTree prim Any Any
forall wX wY. prim wX wY
replacePatch Tree IO
work
case Maybe (Tree IO)
workReplaced of
Just _ -> do
FreeLeft (FL prim) -> IO (FreeLeft (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeLeft (FL prim) -> IO (FreeLeft (FL prim)))
-> FreeLeft (FL prim) -> IO (FreeLeft (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY wZ. prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> FreeLeft prim -> FreeLeft (FL prim) -> FreeLeft (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
(q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) ((forall wX wY. prim wX wY) -> FreeLeft prim
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap forall wX wY. prim wX wY
replacePatch) FreeLeft (FL prim)
forall (a :: * -> * -> *). FreeLeft (FL a)
gapNilFL
Nothing
| PrimDarcsOption Bool
O.forceReplace PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts -> SubPath -> String -> Tree IO -> IO (FreeLeft (FL prim))
forall (prim :: * -> * -> *).
PrimPatch prim =>
SubPath -> String -> Tree IO -> IO (FreeLeft (FL prim))
getForceReplace SubPath
f String
toks Tree IO
work
| Bool
otherwise -> String -> IO ()
putStrLn String
existsMsg IO () -> IO (FreeLeft (FL prim)) -> IO (FreeLeft (FL prim))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FreeLeft (FL prim) -> IO (FreeLeft (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return FreeLeft (FL prim)
forall (a :: * -> * -> *). FreeLeft (FL a)
gapNilFL
where
existsMsg :: String
existsMsg = "Skipping file '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'\nPerhaps the working"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " version of this file already contains '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
new
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'?\nUse the --force option to override."
gapNilFL :: FreeLeft (FL a)
gapNilFL = (forall wX. FL a wX wX) -> FreeLeft (FL a)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL a wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
fp :: String
fp = SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath SubPath
f
replacePatch :: prim wX wY
replacePatch = String -> String -> String -> String -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
String -> String -> String -> String -> prim wX wY
tokreplace String
fp String
toks String
old String
new
ftf :: p -> FileType
ftf _ = FileType
TextFile
getForceReplace :: PrimPatch prim => SubPath -> String -> Tree IO
-> IO (FreeLeft (FL prim))
getForceReplace :: SubPath -> String -> Tree IO -> IO (FreeLeft (FL prim))
getForceReplace f :: SubPath
f toks :: String
toks tree :: Tree IO
tree = do
let path :: AnchoredPath
path = SubPath -> AnchoredPath
floatSubPath SubPath
f
ByteString
content <- Blob IO -> IO ByteString
forall (m :: * -> *). Blob m -> m ByteString
readBlob (Blob IO -> IO ByteString) -> Blob IO -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (Blob IO) -> Blob IO
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Blob IO) -> Blob IO) -> Maybe (Blob IO) -> Blob IO
forall a b. (a -> b) -> a -> b
$ Tree IO -> AnchoredPath -> Maybe (Blob IO)
forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Blob m)
findFile Tree IO
tree AnchoredPath
path
let newcontent :: ByteString
newcontent = String -> ByteString -> ByteString -> ByteString -> ByteString
forceTokReplace String
toks (String -> ByteString
BC.pack String
new) (String -> ByteString
BC.pack String
old)
([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.toChunks ByteString
content)
tree' :: Tree IO
tree' = Tree IO -> AnchoredPath -> Maybe (TreeItem IO) -> Tree IO
forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
modifyTree Tree IO
tree AnchoredPath
path (Maybe (TreeItem IO) -> Tree IO)
-> (Blob IO -> Maybe (TreeItem IO)) -> Blob IO -> Tree IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeItem IO -> Maybe (TreeItem IO)
forall a. a -> Maybe a
Just (TreeItem IO -> Maybe (TreeItem IO))
-> (Blob IO -> TreeItem IO) -> Blob IO -> Maybe (TreeItem IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob IO -> TreeItem IO
forall (m :: * -> *). Blob m -> TreeItem m
File (Blob IO -> Tree IO) -> Blob IO -> Tree IO
forall a b. (a -> b) -> a -> b
$ ByteString -> Blob IO
forall (m :: * -> *). Monad m => ByteString -> Blob m
makeBlobBS ByteString
newcontent
FreeLeft (FL prim)
normaliseNewTokPatch <- DiffAlgorithm
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL prim))
forall (m :: * -> *) (w :: (* -> * -> *) -> *)
(prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff (PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String -> FileType
forall p. p -> FileType
ftf Tree IO
tree Tree IO
tree'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall wX. FL prim Any wX -> Bool) -> Sealed (FL prim Any) -> Bool
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. FL prim Any wX -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL (FreeLeft (FL prim) -> Sealed (FL prim Any)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft FreeLeft (FL prim)
normaliseNewTokPatch)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Don't be surprised!\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "I've changed all instances of '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
new String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' to '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' first\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "so that darcs replace can token-replace them"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " back into '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
new String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' again."
FreeLeft (FL prim) -> IO (FreeLeft (FL prim))
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeLeft (FL prim) -> IO (FreeLeft (FL prim)))
-> (FreeLeft (FL prim) -> FreeLeft (FL prim))
-> FreeLeft (FL prim)
-> IO (FreeLeft (FL prim))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ)
-> FreeLeft (FL prim) -> FreeLeft (FL prim) -> FreeLeft (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
(q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. FL prim wX wY -> FL prim wY wZ -> FL prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+) FreeLeft (FL prim)
normaliseNewTokPatch (FreeLeft (FL prim) -> IO (FreeLeft (FL prim)))
-> FreeLeft (FL prim) -> IO (FreeLeft (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> FreeLeft (FL prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap ((forall wX wY. FL prim wX wY) -> FreeLeft (FL prim))
-> (forall wX wY. FL prim wX wY) -> FreeLeft (FL prim)
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
String -> String -> String -> String -> prim wX wY
tokreplace (SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath SubPath
f) String
toks String
old String
new prim wX wY -> FL prim wY wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
replaceCmd _ _ [_, _] = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "You need to supply a list of files to replace in!"
replaceCmd _ _ _ = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Usage: darcs replace <OLD> <NEW> <FILE>..."
filenameToks :: String
filenameToks :: String
filenameToks = "A-Za-z_0-9\\-\\."
isTok :: String -> String -> Bool
isTok :: String -> String -> Bool
isTok _ "" = Bool
False
isTok toks :: String
toks s :: String
s = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> Char -> Bool
regChars String
toks) String
s
chooseToks :: Maybe String -> String -> String -> IO String
chooseToks :: Maybe String -> String -> String -> IO String
chooseToks (Just t :: String
t) a :: String
a b :: String
b
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 =
String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ "It must contain more than 2 characters, because it"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " should be enclosed in square brackets"
| String -> Char
forall a. [a] -> a
head String
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '[' Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
last String
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ']' =
String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec "It should be enclosed in square brackets"
| '^' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Char
forall a. [a] -> a
head String
tok Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tok Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 =
String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec "Must be at least one character in the complementary set"
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
t =
String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec "Space is not allowed in the spec"
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
a = String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
spaceyToken String
a
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
b = String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
spaceyToken String
b
| Bool -> Bool
not (String -> String -> Bool
isTok String
tok String
a) = String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
notAToken String
a
| Bool -> Bool
not (String -> String -> Bool
isTok String
tok String
b) = String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
badTokenSpec (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
notAToken String
b
| Bool
otherwise = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
tok
where
tok :: String
tok = String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
t :: String
badTokenSpec :: String -> m a
badTokenSpec msg :: String
msg = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "Bad token spec: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
spaceyToken :: String -> String
spaceyToken x :: String
x = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " must not contain any space"
notAToken :: String -> String
notAToken x :: String
x = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not a token, according to your spec"
chooseToks Nothing a :: String
a b :: String
b =
if String -> String -> Bool
isTok String
defaultToks String
a Bool -> Bool -> Bool
&& String -> String -> Bool
isTok String
defaultToks String
b
then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultToks
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filenameToks