[darcs-devel] [patch191] Add Maybe variant of fixSubPaths (and 15 more)
Eric Kow
bugs at darcs.net
Sat Nov 20 22:38:07 UTC 2010
Eric Kow <kowey at darcs.net> added the comment:
Hi Reinier and Alexey,
Here's another review pass. Thanks for your effort in cleaning up the
patch! Unfortunately you were bitten by recent experimental changes to
our process that Guillaume pointed out.
I'm reviewing Reinier's version of the bundle (due to the screened
branch). To make life easier, I'm reviewing the whole bundle in one
go as if it were a single coalesced patch.
Note that I'm a bit dissatisfied with the test case (see below). Part
of me is tempted not to apply the patch in a Zooko-like spirit of being
very demanding about testing in the interests of faster progress (*),
but I feel a bit like I've played a big part in this patch stalling
unnecessarily and making work for everybody, so I'm applying it a little
bit out of guilt.
Well, guilt and the fact that it really is an improvement :-)
Applied, thanks!
GENERAL COMMENTS
----------------------------------------------------------------------
There are two more commands that take subpaths, I think: revert and
darcs show contents. I think we may need a follow-up patch to cover
these and other subpath commands I may not have thought of.
I've prefixed the more important comments with NOTE
Please send your recent addendum as a new patch to screened
branch.
./src/Darcs/Arguments.lhs
----------------------------------------------------------------------
> --- | @fixSubPaths files@ returns the @SubPath at s for the paths in @files@ that
> --- are inside the repository, preserving their order. Paths in @files@ that are
> --- outside the repository directory are not in the result.
> +-- | @maybeFixSubPaths files@ tries to turn the file paths in its argument into
> +-- @SubPath at s.
> --
> -- When converting a relative path to an absolute one, this function first tries
> -- to interpret the relative path with respect to the current working directory.
> hunk ./src/Darcs/Arguments.lhs 496
> -- If that fails, it tries to interpret it with respect to the repository
> --- directory. Only when that fails does it omit the path from the result.
> +-- directory. Only when that fails does it put a @Nothing@ in the result at the
> +-- position of the path that cannot be converted.
> --
> -- It is intended for validating file arguments to darcs commands.
OK so the core of fixSubPaths has been tweaked and broken out as a new
function maybeFixSubPaths which preserves the number/order of the input
paths and puts Nothing in place of all the bad paths.
> hunk ./src/Darcs/Arguments.lhs 500
> -fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath]
> -fixSubPaths flags fs =
> - withCurrentDirectory o $
> - do fixedfs <- mapM fixit $ filter (not.null) fs
> - let (good, bad) = partitionEither fixedfs
> - unless (null bad) $
> - putStrLn $ "Ignoring non-repository paths: " ++ unwords bad
> - return $ nub good
> +maybeFixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [Maybe SubPath]
> +maybeFixSubPaths flags fs = withCurrentDirectory o $ do
> + fixedFs <- mapM fixit fs
> + let bads = snd . unzip . filter (isNothing . fst) $ zip fixedFs fs
> + unless (null bads) . putStrLn $ "Ignoring non-repository paths: " ++
> + intercalate ", " bads
> + return fixedFs
This maybeFixSubPaths function is slightly more than just a map.
It also does report any non-repository paths, if there are any:
Ignoring non-repository paths: ../baz, /quux/yoda, /blah
> +-- | @fixSubPaths files@ returns the @SubPath at s for the paths in @files@ that
> +-- are inside the repository, preserving their order. Paths in @files@ that are
> +-- outside the repository directory are not in the result.
> +--
> +-- When converting a relative path to an absolute one, this function first tries
> +-- to interpret the relative path with respect to the current working directory.
> +-- If that fails, it tries to interpret it with respect to the repository
> +-- directory. Only when that fails does it omit the path from the result.
> +--
> +-- It is intended for validating file arguments to darcs commands.
> +fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath]
> +fixSubPaths flags fs = nub . catMaybes <$> (maybeFixSubPaths flags $
> + filter (not . null) fs)
The old fixSubPaths is still around. Do we really need it?
./src/Darcs/Commands/Add.lhs
----------------------------------------------------------------------
> addCmd :: [DarcsFlag] -> [String] -> IO ()
> -addCmd opts args = withRepoLock opts $- \repository ->
> +addCmd opts args
> + | null args = putStrLn $ "Nothing specified, nothing added." ++
> + "Maybe you wanted to say `darcs add --recursive .'?"
> + | otherwise = do
> + fs <- fixSubPaths opts args
> + case fs of
> + [] -> fail "No valid arguments were given"
> + _ -> addFiles opts fs
This is part of a general pattern of separating the inner command logic
from an outer traffic-control layer which basically figures out what
variant of the command to run depending on the kind of arguments you
gave it.
Alexey added an extra distinction between
darcs add
and
darcs add /only/non-repository /paths/here
which previously were indistinguishable from each other because the
non-repository paths were thrown out.
NOTE: I notice we're using fail to complain here. Is that really
the right thing to do UI-wise? You're just continuing current
practice, which is fine, but maybe what we need is a fail-like
function for dying on user error?
> hunk ./src/Darcs/Commands/Add.lhs 117
> - when (null args) $
> - putStrLn "Nothing specified, nothing added." >>
> - putStrLn "Maybe you wanted to say `darcs add --recursive .'?"
> - origfiles <- fixSubPaths opts args
> hunk ./src/Darcs/Commands/Add.lhs 131
> - when (nullFL ps && not (null args)) $
> + when (nullFL ps && not (null origfiles)) $
./src/Darcs/Commands/AmendRecord.lhs
----------------------------------------------------------------------
> amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()
> -amendrecordCmd opts args =
> +amendrecordCmd opts args = if null args
> + then doAmendRecord opts []
> + else do
> + files <- fixSubPaths opts args
> + if null files
> + then fail "No valid arguments were given, nothing to do."
> + else doAmendRecord opts files
Same pattern and same distinction.
NOTE: Is it worth trying to unify our user-error message?
> +doAmendRecord :: [DarcsFlag] -> [SubPath] -> IO ()
> +doAmendRecord opts files =
> withRepoLock opts $- \(repository :: Repository p C(r u r)) -> do
> hunk ./src/Darcs/Commands/AmendRecord.lhs 139
> - files <- sort `fmap` fixSubPaths opts args
> - when (areFileArgs files) $
> - putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
> withSelectedPatchFromRepo "amend" repository opts $ \ (_ :> oldp) -> do
> hunk ./src/Darcs/Commands/AmendRecord.lhs 140
> + when ((not.null) files) (putStrLn $ "Amending changes in "++unwords (map show files)++":\n")
./src/Darcs/Commands/Annotate.lhs
----------------------------------------------------------------------
> annotateCmd :: [DarcsFlag] -> [String] -> IO ()
> -annotateCmd opts [] = withRepository opts $- \repository -> do
> - when (not $ haveNonrangeMatch opts) $
> - fail $ "Annotate requires either a patch pattern or a " ++
> - "file or directory argument."
[and much later]
> -annotateCmd opts [""] = annotateCmd opts []
> +annotateCmd opts args = case args of
> + [] -> if haveNonrangeMatch opts
> + then annotatePattern opts
> + else fail $ "Annotate requires either a patch pattern or a " ++
> + "file or directory argument."
> + [""] -> annotateCmd opts []
> + [_] -> do
> + f <- head <$> maybeFixSubPaths opts args
> + case f of
> + Nothing -> fail "invalid argument"
> + Just f' -> annotatePath opts f'
> + _ -> fail "annotate accepts at most one argument"
It does seem indeed easier to read with the arg processing separated
from the actual business end code.
I'm not terribly excited about the xs@[_] -> blah (head xs) above
but I guess there's not too much we can do about it unless we wanted
to go introduce a
maybeFixSubPath :: [DarcsFlag] -> FilePath -> IO (Maybe SubPath)
which brings up questions about where the invalid-path UI code should
go.
Maybe this is better?
f <- maybeFixSubPaths opts args
case f of
[Nothing] -> fail "invalid argument"
[Just f'] -> annotatePath opts f'
_ -> error "blah" -- using Darcs.Bug so we can find it
> +annotatePattern :: [DarcsFlag] -> IO ()
> +annotatePattern opts =
> + withRepository opts $- \repository -> do
> Sealed2 p <- matchPatch opts `fmap` readRepo repository
> -annotateCmd opts [file] = withRepository opts $- \repository -> do
> +annotatePath :: [DarcsFlag] -> SubPath -> IO ()
> +annotatePath opts file = withRepository opts $- \repository -> do
> r <- readRepo repository
> hunk ./src/Darcs/Commands/Annotate.lhs 163
> - fixed_args <- fixSubPaths opts [file]
> - (rel_file_or_directory:_) <- case fixed_args of
> - [] -> fail ("The supplied path " ++ file ++ " is not usable")
> - fs -> return fs
> - let file_or_directory = rel_file_or_directory
OK
> Just cp -> lookupCreationPop cp
> - if toFilePath file_or_directory == "." || toFilePath file_or_directory == ""
> + let file' = toFilePath file
> + if null file'
NOTE: Is this really OK? I'm assuming that we do this because we know
how subpaths get converted to filepaths, and that the one for the
current directory is ""
Chatty aside: For some reason I like comparing empty string against ""
instead of checking if its null. I guess I just like to treat strings
as being conceptually self-contained things, not necessary lists of
characters. I guess 'null' could just mean 'is the empty string' so
that's just me being silly.
> hunk ./src/Darcs/Commands/Annotate.lhs 178
> - else case lookup_thing (toFilePath file_or_directory) pop of
> - Nothing -> fail $ "There is no file or directory named '"++
> - toFilePath file_or_directory++"'"
> + else case lookup_thing file' pop of
> + Nothing -> fail $ "There is no file or directory named '"++file'++"'"
> hunk ./src/Darcs/Commands/Annotate.lhs 182
> - errorDoc $ text ("The directory '" ++ toFilePath rel_file_or_directory ++
> + errorDoc $ text ("The directory '" ++ file' ++
> hunk ./src/Darcs/Commands/Annotate.lhs 188
> - errorDoc $ text ("The file '" ++ toFilePath rel_file_or_directory ++
> + errorDoc $ text ("The file '" ++ file' ++
Basic code-duplication refactor.
> - | otherwise -> annotateFile repository opts pinfo file_or_directory pt
> -
> -annotateCmd _ _ = fail "annotate accepts at most one argument"
> + | otherwise -> annotateFile repository opts pinfo file pt
Tidied away in the 2-layer pattern by Alexey.
./src/Darcs/Commands/Changes.lhs
----------------------------------------------------------------------
> changesCmd :: [DarcsFlag] -> [String] -> IO ()
> -changesCmd opts args | GenContext `elem` opts =
> - let repodir = fromMaybe "." (getRepourl opts) in
> - withRepositoryDirectory opts repodir $- \repository -> do
> - when (args /= []) $ fail "changes --context cannot accept other arguments"
> - changesContext repository opts
> -changesCmd opts args =
> +changesCmd opts args
> + | GenContext `elem` opts = if not . null $ args
> + then fail "changes --context cannot accept other arguments"
> + else changesContext opts
> + | null args = showChanges opts Nothing
> + | otherwise = do
> + fs <- fixSubPaths opts args
> + case fs of
> + [] -> putStrLn "No valid arguments were given, nothing to do."
> + _ -> showChanges opts . Just . nub $ sort fs
Yeah, this is an improvement.
NOTE: The nub is actually not because fixSubPaths does it. That said,
I wonder if fixSubPaths doing nub is really wise? I wonder what was
the initial motivation.
NOTE: Well, now we're not being very consistent here about this user
error complaint. Do we fail? Do we putStrLn? How do we exit?
> + else do when (isJust files && not (XMLOutput `elem` opts)) $
> + putStrLn $ "Changes to "++unwords (fromJust filez)++":\n"
As above, I'm not thrilled about this sort of
pack-and-immediately-unsafely-unpack thing, particularly since the thing
we're unpacking filez is not the same as files (we just know it has the
same shape).
Is this an improvement? Or is it just longer?
else do unless (XMLOutput `elem` opts) $
case filez of
Just fs -> putStrLn "Changes to " ++ unwords fs ++ ":\n"
Nothing -> return ()
> -getChangesInfo :: RepoPatch p => [DarcsFlag] -> [FilePath]
> +getChangesInfo :: RepoPatch p => [DarcsFlag] -> Maybe [FilePath]
> -> PatchSet p C(x y)
> -> ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)
> getChangesInfo opts plain_fs ps =
> hunk ./src/Darcs/Commands/Changes.lhs 178
> case (sp1s, sp2s) of
> (Sealed p1s, Sealed p2s) ->
> case findCommonWithThem p2s p1s of
> - _ :>> us -> filterPatchesByNames (maxCount opts) fs $ filterRL pf $ reverseFL us
> - where fs = map (\x -> "./" ++ x) $ plain_fs
> - sp1s = if firstMatch opts
> + _ :>> us ->
> + let ps' = filterRL pf (reverseFL us) in
> + case plain_fs of
> + Nothing -> foldr (\x xs -> (x, []) -:- xs) ([], [], empty) $
> + maybe id take (maxCount opts) ps'
> + Just fs -> let fs' = map (\x -> "./" ++ x) fs in
> + filterPatchesByNames (maxCount opts) fs' ps'
> + where sp1s = if firstMatch opts
Looks like just unpacking/rearranging the code above (see
filterPatchesByNames). Seems very slightly gratuitous to me.
> hunk ./src/Darcs/Commands/Changes.lhs 209
> filterPatchesByNames (Just 0) _ _ = ([], [], empty)
> +filterPatchesByNames _ [] _ = ([], [], empty)
> filterPatchesByNames _ _ [] = ([], [], empty)
> hunk ./src/Darcs/Commands/Changes.lhs 211
> -filterPatchesByNames maxcount [] (hp:ps) =
> - (hp, []) -:- filterPatchesByNames (subtract 1 `fmap` maxcount) [] ps
> filterPatchesByNames maxcount fs ((Sealed2 hp):ps)
> | Just p <- hopefullyM hp =
> case lookTouch fs (invert p) of
This changes the meaning of filterPatchesByNames to remove the special
handling of "no files", which does seem a bit cleaner. The cost is
duplicating the handling of maxcount.
Maybe it would be better to encode the distinction into
filterPatchesByNames by having it take Maybe [FilePath] instead?
> -changesContext :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()
> -changesContext repository opts = do
> +changesContext :: [DarcsFlag] -> IO ()
> +changesContext opts = do
> + let repodir = fromMaybe "." $ getRepourl opts
> + withRepositoryDirectory opts repodir $- \repository -> do
> FlippedSeal ps' <- contextPatches `fmap` readRepo repository
> let ps = mapRL (\p -> (seal2 p, [])) ps'
> unless fancy $ putStrLn "\nContext:\n"
Re-arranged logic; the new code used to be part of changesCmd.
I dimly recall that we recently did a refactor of this stuff repodir
stuff though, but I don't remember where/when.
./src/Darcs/Commands/Diff.lhs
----------------------------------------------------------------------
> diffCmd :: [DarcsFlag] -> [String] -> IO ()
> -diffCmd opts args = withRepository opts $- \repository -> do
> - when (not (null [i | LastN i <- opts])
> - && not (null [p | AfterPatch p <- opts])
> - ) $
> - fail ("using --patch and --last at the same time with the 'diff' command"
> - ++ " doesn't make sense. Use --from-patch to create a diff from this"
> - ++ " patch to the present, or use just '--patch' to view this specific"
> - ++ " patch.")
> +diffCmd opts args
> + | not (null [i | LastN i <- opts]) &&
> + not (null [p | AfterPatch p <- opts]) =
> + fail $ "using --patch and --last at the same time with the 'diff'" ++
> + " command doesn't make sense. Use --from-patch to create a diff" ++
> + " from this patch to the present, or use just '--patch' to view" ++
> + " this specific patch."
> + | null args = doDiff opts Nothing
> + | otherwise = doDiff opts . Just =<< fixSubPaths opts args
Sounds like a standard Alexey refactor.
NOTE: don't we also want to introduce the no-args vs no-valid-args
distinction? We seem to be missing it here
> +doDiff :: [DarcsFlag] -> Maybe [SubPath] -> IO ()
> +doDiff opts sps = withRepository opts $- \repository -> do
> + let pathList = map sp2fn `fmap` sps
> formerdir <- getCurrentDirectory
> hunk ./src/Darcs/Commands/Diff.lhs 198
> - subpaths <- if null args then return []
> - else fixSubPaths opts args
> - let path_list = map sp2fn subpaths
> - thename <- return $ takeFileName formerdir
> - withTempDir ("old-"++thename) $ \odir -> do
> - setCurrentDirectory formerdir
> - withTempDir ("new-"++thename) $ \ndir -> do
NOTE: (question) Was the setCurrentDirectory formerdir removed
from withTempDirs below because it was really superfluous? Or
was it just an oversight?
> + withTempDirs (takeFileName formerdir) $ \odir ndir -> do
> if firstMatch opts
> hunk ./src/Darcs/Commands/Diff.lhs 200
> - then withCurrentDirectory odir $
> - getPartialFirstMatch repository opts path_list
> - else if null path_list
> - then createPristineDirectoryTree repository (toFilePath odir)
> - else createPartialsPristineDirectoryTree repository path_list (toFilePath odir)
> + then withCurrentDirectory odir . getPartialFirstMatch repository opts $
> + fromMaybe [] pathList
> + else case pathList of
> + Nothing -> createPristineDirectoryTree repository $ toFilePath odir
> + Just pl -> createPartialsPristineDirectoryTree repository pl $ toFilePath odir
> if secondMatch opts
> hunk ./src/Darcs/Commands/Diff.lhs 206
> - then withCurrentDirectory ndir $
> - getPartialSecondMatch repository opts path_list
> - else withCurrentDirectory formerdir $ do
> - readUnrecorded repository subpaths >>= (flip writePlainTree (toFilePath ndir))
> + then withCurrentDirectory ndir . getPartialSecondMatch repository opts $
> + fromMaybe [] pathList
> + else withCurrentDirectory formerdir $
> + readUnrecorded repository (fromMaybe [] sps) >>= (flip writePlainTree (toFilePath ndir))
Changes here are actually fairly superficial: taking the change from [SubPath]
to Maybe [SubPath] into account, replacing parens with "$".
In the interests of minimising the amount of time reviewers spend
squinting at patches, I'd avoid making minor syntactic changes like the
parens/$ thing unless it was (a) done separately and (b) really does
improve clarity (and isn't just a matter of taste). Maybe I shouldn't
be one to talk. I did something a bit similar in my HINT patches.
> hunk ./src/Darcs/Commands/Diff.lhs 211
> - case path_list of
> - [] -> rundiff (takeFileName $ toFilePath odir) (takeFileName $ toFilePath ndir)
> - fs -> vcat `fmap`
> + case pathList of
> + Nothing -> rundiff (takeFileName $ toFilePath odir) (takeFileName $ toFilePath ndir)
> + Just fs -> vcat `fmap`
Yep.
General thought. I'm not really sure it's that helpful to introduce the
distinction between [] (x:xs) and Nothing and (Just xs) in this inner
layer. Is it really an improvement? I get that the new one lets you
distinguish between implicit and explicit empty. I guess it's just that
there isn't really an explicit empty here so we're effectively dealing
with a third case that we'd previously made impossible.
> + withTempDirs :: String -> (AbsolutePath -> AbsolutePath -> IO a) -> IO a
> + withTempDirs x f = withTempDir ("old-" ++ x) $ \odir ->
> + withTempDir ("new" ++ x) $ \ndir -> f odir ndir
> +
Note the setCurrentDirectory going away. I hope that doesn't change
something; it doesn't appear to.
./src/Darcs/Commands/Dist.lhs
----------------------------------------------------------------------
> distCmd :: [DarcsFlag] -> [String] -> IO ()
> -distCmd opts args = withRepoReadLock opts $- \repository -> do
> +distCmd opts _ = withRepoReadLock opts $- \repository -> do
> distname <- getDistName opts
> verb <- return $ Verbose `elem` opts
> predist <- getPrefval "predist"
> hunk ./src/Darcs/Commands/Dist.lhs 107
> formerdir <- getCurrentDirectory
> - path_list <- if null args
> - then return [""]
> - else map toFilePath `fmap` fixSubPaths opts args
> resultfile <- return (formerdir</>distname++".tar.gz")
> withTempDir "darcsdist" $ \tempdir -> do
> setCurrentDirectory (formerdir)
> hunk ./src/Darcs/Commands/Dist.lhs 113
> withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do
> if haveNonrangeMatch opts
> then withCurrentDirectory ddir $ getNonrangeMatch repository opts
> - else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
> + else createPartialsPristineDirectoryTree repository [""] (toFilePath ddir)
The new code is closer to what dist advertises itself as doing,
but it looks like the old code has more functionality (tarball with just
some of files in the repo?). Anyway the old code was blocked off by
commandExtraArgs = 0 in the definition of the dist command, so the new
code is better. I guess if it turns out that dist taking args is
actually a useful feature, somebody could always request it.
./src/Darcs/Commands/Move.lhs
----------------------------------------------------------------------
> hunk ./src/Darcs/Commands/Move.lhs 91
> -moveCmd _ [] = fail "The `darcs move' command requires at least two arguments."
> -moveCmd _ [_] = fail "The `darcs move' command requires at least two arguments."
> +moveCmd opts args
> + | length args < 2 = fail $ "The `darcs move' command requires at least" ++
> + "two arguments."
> + | length args == 2 = do
> + xs <- maybeFixSubPaths opts args
> + case xs of
> + [Just from, Just to]
> + | from == to -> fail "Cannot rename a file or directory onto itself!"
> + | otherwise -> moveFile opts from to
> + _ -> fail "Both source and destination must be valid."
> + | otherwise = let (froms, to) = (init args, last args) in do
> + x <- head <$> maybeFixSubPaths opts [to]
> + case x of
> + Nothing -> fail "Invalid destination directory."
> + Just to' -> do
> + xs <- nub . sort <$> fixSubPaths opts froms
> + case xs of
> + [] -> fail "Nothing to move."
> + froms' -> moveFilesToDir opts froms' to'
Seems better indeed. Same traffic-control/business end separation with
some subtle checking on the command line args.
I really like the fact that
darcs mv foo bar /invalid
no longer thinks that you're trying to move foo to bar.
> addfile ./tests/invalid_absolute_paths.sh
> hunk ./tests/invalid_absolute_paths.sh 1
> +## Regression test for patch178
I think the description should be about the functionality, not the patch
number... but maybe you've found a new useful practice.
> +. lib # Load some portability helpers.
> +rm -rf R # Another script may have left a mess.
> +darcs init --repo R # Create our test repos.
> +cd R
> +
> +if darcs move /non_existent_path/a /non_existent_path/b 2>&1 | grep 'bug'; then
> + echo 'Not OK 1: darcs move causes a bug'
> + exit 1
> +else
> + echo 'OK 1'
> +fi
> +
> +if darcs move /non_existent_path/a /non_existent_path/b /non_existent_path/c 2>&1 | grep 'Prelude.init: empty list'; then
> + echo 'Not OK 2: darcs move causes an error'
> + exit 1
> +else
> + echo 'OK 2'
> +fi
> +
> +if darcs annotate /non_existent_path/a 2>&1 | grep 'Pattern match failure'; then
> + echo 'Not OK 3: darcs annotate causes an error'
> + exit 1
> +else
> + echo 'OK 3'
> +fi
The test could be made a lot simpler and maybe easier to read
if you just rely on the test harness exiting on error.
For example
darcs move /non_existent_path/a /non_existent_path/b > log
not grep bug log
NOTE: The test doesn't seem sufficiently aggressive to me. Shouldn't it
be checking that the moves are interpreted correctly? Shouldn't it be
checking that eg darcs move a b /invalid fails in the right way?
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
For a faster response, try +44 (0)1273 64 2905 or
xmpp:kowey at jabber.fr (Jabber or Google Talk only)
__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch191>
__________________________________
More information about the darcs-devel
mailing list