[darcs-users] [patch191] Add Maybe variant of fixSubPaths (and 6 more) [status=amend-requested]
Eric Kow
kowey at darcs.net
Mon Mar 29 00:26:14 UTC 2010
Hi Alexey,
I'm very sorry about the delay reviewing this.
I like the general idea behind the patch, but I'm not going to apply it
yet, primarily because it conflicts with patch156. Do you think you
could have a second look at that?
I think the most important patches are
http://bugs.darcs.net/file1101/remove-implementation-of-__store_in_memory_-simplifying-matcher-code_.dpatch
http://bugs.darcs.net/file1103/re_implement-setscriptsexecutable-using-trees-instead-of-slurpies_.dpatch
(One handy trick thanks to Trent is to save the patch as an mbox file
and open in your mail client.)
Meanwhile, I'll comment on your patches below.
One general point is that I get the feeling that despite this change, we
still don't have a sense of clarity on how all the commands should deal
with their fileargs. I'd like to see us moving towards something a
little more homogeneous if this is possible (and it may not be because
the commands may have fundamentally different needs).
> Tue Mar 16 02:38:17 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Add Maybe variant of fixSubPaths
>
> Wed Mar 17 00:02:11 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate argument handling from repository work in Move.lhs
>
> Sat Mar 20 23:28:53 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Add test for absolute paths
>
> Sun Mar 21 00:09:44 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate arguments/repository code in AmendRecord.lhs
Reviewed
> Sun Mar 21 00:10:01 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate arguments/repository code in Annotate.lhs
Skipped because you later amended this with one that fixes the
outstanding conflict
> Sun Mar 21 00:10:08 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate arguments/repository code in Add.lhs
>
> Sun Mar 21 00:10:14 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Resolve issue1397: separate arguments/repository code in Changes.lhs
Reviewed
> Thu Mar 25 22:25:56 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate arguments/repository code in Annotate.lhs
>
> Fri Mar 26 16:26:06 EET 2010 Alexey Levan <exlevan at gmail.com>
> * darcs dist doesn't take any arguments
From your other email. Reviewed
> Thu Mar 25 22:26:01 EET 2010 Alexey Levan <exlevan at gmail.com>
> * Separate arguments/repository code in Diff.lhs
I'll give most of this one a miss as I have to get to bed...
Add Maybe variant of fixSubPaths
--------------------------------
> -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
I wonder if the bads would be clearer as a list comprehension
bads = [ p | (Nothing,p) <- zip fixedFs fs ]
> +fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath]
> +fixSubPaths flags fs = nub . catMaybes <$> (maybeFixSubPaths flags $
> + filter (not . null) fs)
I was curious about why you didn't just do this stuff (the nub and
the filter) in maybeFixSubPaths, but this becomes clearer in future
patches. Basically, it's to avoid throwing out information about
what the user passed in.
> hunk ./src/Darcs/Arguments.lhs 449
> - (r,o) = case extractFixPath flags of
> - Just xxx -> xxx
> - Nothing -> bug "Can't fix path in fixSubPaths"
> - fixit p = do ap <- ioAbsolute p
> - case makeSubPathOf r ap of
> - Just sp -> return $ Right sp
> - Nothing -> return $ maybe (Left p) Right $ simpleSubPath p
> + (r, o) = case extractFixPath flags of
> + Just x -> x
> + Nothing -> bug "Can't fix path in maybeFixSubPaths"
> + fixit p = do
> + ap <- ioAbsolute p
> + return $ makeSubPathOf r ap `mplus` simpleSubPath p
This appears to be just refactoring which I tend to prefer as a separate
patch. Thanks for the MonadPlus reminder...
Separate argument handling from repository work in Move.lhs
-----------------------------------------------------------
> + | length args < 2 = fail $ "The `darcs move' command requires at least" ++
> + "two arguments."
> + | length args == 2 = do
I was going to suggest you keep the pattern matching, but I guess we
don't *really* need it here because we were really just doing a length
verification and not really grabbing the values out of the match.
> + 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]
Hmm, it seems like there's a lot of packing-unpacking things here.
Perhaps fixIt above should be refactored to maybeFixSubPath? (Then what do
we do about warning messages?)
Also, thinking about this, do you catch http://bugs.darcs.net/issue1800
? (darcs HEAD does not).
> + 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'
You shouldn't need to nub here if fixSubPaths does it (but should
fixSubPaths do it?)
Thanks for catching the case where path checking fails for all the from
paths.
It may be nice if moveFilesToDir would enforce a length >= 1 list
(which is doable at the expense of code-readability perhaps)
The rest seems fine.
Add test for absolute paths
---------------------------
> +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
You don't need to print this stuff explicitly; you could just rely on
the shell harness and the fact that we're using bash -e
For example, darcs move /non_existent_path/a /non_existent_path/b 2>&1 | not grep 'bug'
> +if darcs move /non_existent_path/a /non_existent_path/b /non_existent_path/c 2>&1 | grep 'Prelude.init: empty list'; then
That seems like an odd thing to test for. Shouldn't the code just avoid
getting into a situation where this sort of thing can happen?
In general, I do think having one script that gathers all this path
handling stuff into one place is a good idea. I might probably add
tests for the original changes bug, for example
Separate arguments/repository code in AmendRecord.lhs
-----------------------------------------------------
> amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()
> -amendrecordCmd opts args =
> +amendrecordCmd opts args = if null args
> + then doAmendRecord opts Nothing
> + else do
> + files <- fixSubPaths opts args
> + if null files
> + then fail "No valid arguments were given, nothing to do."
> + else doAmendRecord opts $ Just files
This is just switching to use Alexey's convention that Nothing means no
command line arguments (which is different from some command line
arguments of which some could be bad).
> +doAmendRecord :: [DarcsFlag] -> Maybe [SubPath] -> IO ()
> +doAmendRecord opts fs = do
One mildly Hungarian coding convention might be to use mfs here
> withRepoLock (testByDefault opts) $- \(repository :: Repository p C(r u r)) -> do
> hunk ./src/Darcs/Commands/AmendRecord.lhs 137
> - files <- sort `fmap` fixSubPaths opts args
> - when (areFileArgs files) $
> - putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
I'd be quite interested to see areFileArgs go away.
Meanwhile, what happens when you do darcs amend-record .?
What should happen?
> with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do
> hunk ./src/Darcs/Commands/AmendRecord.lhs 138
> - ch <- unrecordedChanges opts repository files
> -
> - let handleChanges :: FL Prim C(r y) -> IO ()
> - handleChanges NilFL | not (hasEditMetadata opts) = putStrLn "No changes!"
> - handleChanges ch =
> + ch <- case fs of
> + Nothing -> unrecordedChanges opts repository []
> + Just files -> do
> + putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
Is it a mistake to move this putStrLn inside the CPS job?
> + unrecordedChanges opts repository files
> + case ch of
> + NilFL | not (hasEditMetadata opts) -> putStrLn "No changes!"
> + _ ->
> with_selected_changes_to_files' "add" (filter (==All) opts) (Just primSplitter)
> hunk ./src/Darcs/Commands/AmendRecord.lhs 147
> - (map toFilePath files) ch $ addChangesToPatch opts repository oldp
> - handleChanges ch
> + (fromMaybe [] $ map toFilePath <$> fs) ch $ addChangesToPatch opts repository oldp
Sounds like this last bit could be more simply expressed as (map toFilePath $ fromMaybe [] fs)
I may be mistaken, but I think this patch would also have been clearer
if it a bit was more conservative in its approach.
Separate arguments/repository code in 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
> + [] -> putStrLn "No valid arguments were given, nothing to do."
> + _ -> addFiles opts fs
> +
> +addFiles :: [DarcsFlag] -> [SubPath] -> IO ()
> +addFiles opts origfiles = withRepoLock opts $- \repository ->
> do cur <- slurp_pending repository
> hunk ./src/Darcs/Commands/Add.lhs 113
> - origfiles <- fixSubPaths opts args
> - when (null origfiles) $
> - putStrLn "Nothing specified, nothing added." >>
> - putStrLn "Maybe you wanted to say `darcs add --recursive .'?"
Seems fine to me.
> - when (nullFL ps && not (null args)) $
> + when (nullFL ps && not (null origfiles)) $
Any particular reason why 'orig'files? Just curious.
Resolve issue1397: separate arguments/repository code in Changes.lhs
--------------------------------------------------------------------
> changesCmd :: [DarcsFlag] -> [String] -> IO ()
> -changesCmd [Context _] [] = return ()
You do not appear to be catching this case anymore?
What exactly was this supposed to catch?
> -changesCmd opts args | Context rootDirectory `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
> + | Context rootDirectory `elem` opts = if not . null $ args
> + then fail "changes --context cannot accept other arguments"
> + else changesContext opts
I personally like to avoid negating things, eg
| Context rootDirectory `elem` opts = if null args
then changesContext opts
else fail "changes --context cannot accept other arguments"
But maybe your style of catching the failure cases first makes
more sense.
> + | 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
Should that that string be going out on stderr?
> +showChanges :: [DarcsFlag] -> Maybe [SubPath] -> IO ()
> +showChanges opts files =
This is again following the convention from above...
> - files <- sort `fmap` fixSubPaths opts args
> - Sealed unrec <- if null files then return (Sealed identity)
> - else Sealed `fmap` unrecordedChanges opts repository files
> + Sealed unrec <- case files of
> + Nothing -> return $ Sealed identity
> + Just files' -> Sealed `fmap` unrecordedChanges opts repository files'
> `catch` \_ -> return (Sealed identity) -- this is triggered when repository is remote
This looks like it's just taking advantage of the fact that we don't
have to check for explicit null anymore
> - else do when (not (null files) && not (XMLOutput `elem` opts)) $
> - putStrLn $ "Changes to "++unwords filez++":\n"
> + else do when (isJust files && not (XMLOutput `elem` opts)) $
> + putStrLn $ "Changes to "++unwords (fromJust filez)++":\n"
Hmm... using things like fromJust sometimes indicates that there may be
a better way still to write this. I guess something is just bugging me
about this convention
Nothing -- here I'm expecting some sort of failure, but it's actually
-- just one of the success cases
Just [] -- here's the actual failure
Just (p:ps) -- another success condition
I guess what's not clear is whose responsibility it is to deal with the
failure condition. So far, it seems like we do it in the wrapper layer
above and then expect the inner layers to just ignore it implicitly.
Is there a better way?
One way might be something like
data Args a = ExplicitNoArgs | NoGoodArgs | GoodArgs a [a]
(the names are just tentative). I don't know if that's any clearer
though. In general I like the idea of making it impossible to pass
"bad" arguments to low-level functions by just enforcing things in
types. I just haven't worked how to do it nicely yet :-)
> -getChangesInfo :: RepoPatch p => [DarcsFlag] -> [FilePath]
> +getChangesInfo :: RepoPatch p => [DarcsFlag] -> Maybe [FilePath]
> -> RL (RL (PatchInfoAnd p)) C(x y)
> -> ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)
One note is that a goal of the RepoPath work has been to push the use of
SubPath as far down as possible (make as much use of typed paths over
filepaths).
> getChangesInfo opts plain_fs ps =
> hunk ./src/Darcs/Commands/Changes.lhs 178
> (Sealed p1s, Sealed p2s) ->
> case get_common_and_uncommon (p2s,p1s) of
> (_,us:\/:_) ->
> - filterPatchesByNames (maxCount opts) fs $ filterRL pf us
> - where fs = map (\x -> "./" ++ x) $ plain_fs
> - sp1s = if firstMatch opts
> + let ps' = filterRL pf us in
> + case plain_fs of
> + Nothing -> foldr (\x xs -> (x, []) -:- xs) ([], [], empty) $
> + maybe id take (maxCount opts) ps'
Oh, so this is breaking up some of the max-count logic up in the
interests of consolidating the file path handling. Hmm, wouldn't
it be easier to maintain if the max-count stuff was kept together?
I suppose it may make sense to apply your convention to
filterPatchesByNames below.
> + Just fs -> let fs' = map (\x -> "./" ++ x) fs in
> + filterPatchesByNames (maxCount opts) fs' ps'
> + where sp1s = if firstMatch opts
> then matchFirstPatchset opts ps
> else Sealed $ NilRL:<:NilRL
> sp2s = if secondMatch opts
> hunk ./src/Darcs/Commands/Changes.lhs 208
> -> [Sealed2 (PatchInfoAnd p)] -- ^ patchlist
> -> ([(Sealed2 (PatchInfoAnd p),[FilePath])], [FilePath], Doc)
> filterPatchesByNames (Just 0) _ _ = ([], [], empty)
> filterPatchesByNames _ _ [] = ([], [], empty)
> -filterPatchesByNames maxcount [] (hp:ps) =
> - (hp, []) -:- filterPatchesByNames (subtract 1 `fmap` maxcount) [] ps
> +filterPatchesByNames _ [] _ = ([], [], empty)
The reason this does not break darcs changes --max-count with no arguments
is that
> -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
What exactly motivates this change? What was wrong with just passing
a repository down?
darcs dist doesn't take any arguments
-------------------------------------
> -distCmd opts args = withRepoReadLock opts $- \repository -> do
> +distCmd opts _ = withRepoReadLock opts $- \repository -> do
> - path_list <- if null args
> - then return [""]
> - else map toFilePath `fmap` fixSubPaths opts args
Hmm, I notice that darcs dist indeed complains when you pass it args,
but I'm a bit confused by where this complaining is currently taking
place. Have we lost the ability to complain if the user passes in
some args? Should we check for it explicitly?
> - else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
> + else createPartialsPristineDirectoryTree repository [""] (toFilePath ddir)
Separate arguments/repository code in Annotate.lhs
--------------------------------------------------
> -annotateCmd opts [] = withRepository opts $- \repository -> do
> - when (not $ haveNonrangeMatch opts) $
> - fail $ "Annotate requires either a patch pattern or a " ++
> - "file or directory argument."
> +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."
> + [_] -> 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"
Your change certainly seems to make it a good deal clearer, separating the path
validation from the core logic.
> -annotateCmd opts args@[_] = withRepository opts $- \repository -> do
> +annotatePath :: [DarcsFlag] -> SubPath -> IO ()
> +annotatePath opts file = withRepository opts $- \repository -> do
> r <- read_repo repository
> hunk ./src/Darcs/Commands/Annotate.lhs 161
> - (rel_file_or_directory:_) <- fixSubPaths opts args
> - let file_or_directory = rel_file_or_directory
One of the benefits of being able to move all the validation up and
just use types downwards.
> - if toFilePath file_or_directory == "." || toFilePath file_or_directory == ""
> + let file' = toFilePath file
> + if file' == "." || file' == ""
Seems like a nice refactor here (saves a lot of toFilePath file), again
with my usual grumbling about refactors sometimes making patches hard to
read when they're mixed in :-)
Separate arguments/repository code in 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
Same application of the convention above.
> +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
> + 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
> - restrict <- restrictSubpaths repository subpaths
> - restrict `fmap` readUnrecorded repository >>= (flip writePlainTree (toFilePath ndir))
> + then withCurrentDirectory ndir . getPartialSecondMatch repository opts $
> + fromMaybe [] pathList
> + else withCurrentDirectory formerdir $ do
> + restrict <- restrictSubpaths repository (fromMaybe [] sps)
> + unrec <- readUnrecorded repository
> + writePlainTree (restrict unrec) $ toFilePath ndir
> thediff <- withCurrentDirectory (toFilePath odir ++ "/..") $
> hunk ./src/Darcs/Commands/Diff.lhs 213
> - 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`
> mapM (\f -> rundiff
> (takeFileName (toFilePath odir) ++ "/" ++ toFilePath f)
> (takeFileName (toFilePath ndir) ++ "/" ++ toFilePath f)) fs
> hunk ./src/Darcs/Commands/Diff.lhs 237
> return ()
> return output
>
> + withTempDirs :: String -> (AbsolutePath -> AbsolutePath -> IO a) -> IO a
> + withTempDirs x f = withTempDir ("old-" ++ x) $ \odir ->
> + withTempDir ("new" ++ x) $ \ndir -> f odir ndir
> +
> getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> [PatchInfo]
> getDiffInfo opts ps =
> let infos = mapRL info . concatRL
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 195 bytes
Desc: not available
URL: <http://lists.osuosl.org/pipermail/darcs-users/attachments/20100329/5984cf38/attachment-0001.pgp>
More information about the darcs-users
mailing list