On Sat, May 15, 2010 at 18:10:09 +0000, gh wrote:
> To solve this issue, I chose to pass the list of extra arguments
> to the function commandPrereq, so as to enable darcs to check that
> the path given as an extra parameter is not an already existing
> repository. I am not sure if this was the best way to implement
> this new syntax.
Thanks for the high-level explanation.
Rado, would you like to try some Darcs patch review?
resolve issue1268: enable to write darcs init x
------------------------------------------------
> Guillaume Hoffmann <guillaumh@gmail.com>**20100515180529
> Ignore-this: f60be7edd43dd876defcc028d2c1cfb4
> ] hunk ./src/Darcs/Commands.lhs 135
> commandExtraArgs :: Int,
> commandExtraArgHelp :: [String],
> commandCommand :: [DarcsFlag] -> [String] -> IO (),
> - commandPrereq :: [DarcsFlag] -> IO (Either String ()),
> + commandPrereq :: [DarcsFlag] -> [String] -> IO (Either String ()),
> commandGetArgPossibilities :: IO [String],
> commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String],
> commandBasicOptions :: [DarcsOption],
> hunk ./src/Darcs/Commands.lhs 141
> commandAdvancedOptions :: [DarcsOption]}
> | SuperCommand {commandName, commandHelp, commandDescription :: String,
> - commandPrereq :: [DarcsFlag] -> IO (Either String ()),
> + commandPrereq :: [DarcsFlag] -> [String] -> IO (Either String ()),
> commandSubCommands :: [CommandControl]}
>
> commandAlloptions :: DarcsCommand -> ([DarcsOption], [DarcsOption])
> hunk ./src/Darcs/Commands/Convert.lhs 125
> commandExtraArgs = -1,
> commandExtraArgHelp = ["<SOURCE>", "[<DESTINATION>]"],
> commandCommand = convertCmd,
> - commandPrereq = \_ -> return $ Right (),
> + commandPrereq = \_ _ -> return $ Right (),
> commandGetArgPossibilities = return [],
> commandArgdefaults = nodefaults,
> commandAdvancedOptions = networkOptions,
> hunk ./src/Darcs/Commands/Get.lhs 272
> "sequence, you may get different results after reordering with `darcs\n" ++
> "optimize', so tagging is preferred.\n"
>
> -contextExists :: [DarcsFlag] -> IO (Either String ())
> -contextExists opts =
> +contextExists :: [DarcsFlag] -> [String] -> IO (Either String ())
> +contextExists opts _ =
> case getContext opts of
> Nothing -> return $ Right ()
> Just f -> do exists <- doesFileExist $ toFilePath f
> hunk ./src/Darcs/Commands/Help.lhs 62
> commandExtraArgs = -1,
> commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]] "],
> commandCommand = \ x y -> helpCmd x y >> exitWith ExitSuccess,
> - commandPrereq = \_ -> return $ Right (),
> + commandPrereq = \_ _ -> return $ Right (),
> commandGetArgPossibilities = return [],
> commandArgdefaults = nodefaults,
> commandAdvancedOptions = [],
> hunk ./src/Darcs/Commands/Help.lhs 89
> listAvailableCommands =
> do here <- getCurrentDirectory
> is_valid <- mapM
> - (\c-> withCurrentDirectory here $ (commandPrereq c) [])
> + (\c-> withCurrentDirectory here $ (commandPrereq c) [] [])
> (extractCommands commandControlList)
> putStr $ unlines $ map (commandName . fst) $
> filter (isRight.snd) $
> hunk ./src/Darcs/Commands/Init.lhs 22
> \begin{code}
> module Darcs.Commands.Init ( initialize, initializeCmd ) where
> import Darcs.Commands ( DarcsCommand(..), nodefaults )
> -import Darcs.Arguments ( DarcsFlag, workingRepoDir,
> +import Darcs.Arguments ( DarcsFlag( WorkRepoDir ), workingRepoDir,
> inventoryChoices )
> import Darcs.Repository ( amNotInRepository, createRepository )
>
> hunk ./src/Darcs/Commands/Init.lhs 27
> initializeDescription :: String
> -initializeDescription = "Make the current directory a repository."
> +initializeDescription = "Make the current directory or the specified directory a repository."
>
> initializeHelp :: String
> initializeHelp =
> hunk ./src/Darcs/Commands/Init.lhs 76
> initialize = DarcsCommand {commandName = "initialize",
> commandHelp = initializeHelp,
> commandDescription = initializeDescription,
> - commandExtraArgs = 0,
> - commandExtraArgHelp = [],
> + commandExtraArgs = -1,
> + commandExtraArgHelp = ["[<DIRECTORY>]"],
> commandPrereq = amNotInRepository,
> commandCommand = initializeCmd,
> commandGetArgPossibilities = return [],
> hunk ./src/Darcs/Commands/Init.lhs 87
> workingRepoDir]}
>
> initializeCmd :: [DarcsFlag] -> [String] -> IO ()
> -initializeCmd opts _ = createRepository opts
> +initializeCmd opts [outname] = initializeCmd (WorkRepoDir outname:opts) []
> +initializeCmd opts [] = createRepository opts
> +initializeCmd _ _ = fail "You must provide 'init' with either zero or one argument."
> \end{code}
>
> hunk ./src/Darcs/Flags.hs 170
>
> showChangesOnlyToFiles :: [DarcsFlag] -> Bool
> showChangesOnlyToFiles = getBoolFlag OnlyChangesToFiles ChangesToAllFiles
> +
> hunk ./src/Darcs/Repository/Internal.hs 237
> currentDirIsRepository :: IO Bool
> currentDirIsRepository = isRight `liftM` maybeIdentifyRepository [] "."
>
> -amInRepository :: [DarcsFlag] -> IO (Either String ())
> -amInRepository (WorkRepoDir d:_) =
> +amInRepository :: [DarcsFlag] -> [String] -> IO (Either String ())
> +amInRepository (WorkRepoDir d:_) _ =
> do setCurrentDirectory d `catchall` (fail $ "can't set directory to "++d)
> air <- currentDirIsRepository
> if air
> hunk ./src/Darcs/Repository/Internal.hs 244
> then return (Right ())
> else return (Left "You need to be in a repository directory to run this command.")
> -amInRepository (_:fs) = amInRepository fs
> -amInRepository [] =
> +amInRepository (_:fs) _ = amInRepository fs []
> +amInRepository [] _ =
> seekRepo (Left "You need to be in a repository directory to run this command.")
>
> -- | hunt upwards for the darcs repository
> hunk ./src/Darcs/Repository/Internal.hs 271
> -- The performGC in this function is a workaround for a library/GHC bug,
> -- http://hackage.haskell.org/trac/ghc/ticket/2924 -- (doesn't seem to be a
> -- problem on fast machines, but virtual ones trip this from time to time)
> -amNotInRepository :: [DarcsFlag] -> IO (Either String ())
> -amNotInRepository (WorkRepoDir d:_) = do createDirectoryIfMissing False d
> - `catchall` (performGC >> createDirectoryIfMissing False d)
> - -- note that the above could always fail
> - setCurrentDirectory d
> - amNotInRepository []
> -amNotInRepository (_:f) = amNotInRepository f
> -amNotInRepository [] =
> +amNotInRepository :: [DarcsFlag] -> [String] -> IO (Either String ())
> +amNotInRepository flags [outname] = amNotInRepository (WorkRepoDir outname:flags) []
> +amNotInRepository (WorkRepoDir d:_) _ = do createDirectoryIfMissing False d
> + `catchall` (performGC >> createDirectoryIfMissing False d)
> + -- note that the above could always fail
> + setCurrentDirectory d
> + amNotInRepository [] []
> +amNotInRepository (_:f) _ = amNotInRepository f []
> +amNotInRepository [] _ =
> do air <- currentDirIsRepository
> if air then return (Left $ "You may not run this command in a repository.")
> else return $ Right ()
> hunk ./src/Darcs/Repository/Internal.hs 284
>
> -findRepository :: [DarcsFlag] -> IO (Either String ())
> -findRepository (WorkRepoUrl d:_) | is_file d =
> +findRepository :: [DarcsFlag] -> [String] -> IO (Either String ())
> +findRepository (WorkRepoUrl d:_) _ | is_file d =
> do setCurrentDirectory d `catchall` (fail $ "can't set directory to "++d)
> hunk ./src/Darcs/Repository/Internal.hs 287
> - findRepository []
> -findRepository (WorkRepoDir d:_) =
> + findRepository [] []
> +findRepository (WorkRepoDir d:_) _ =
> do setCurrentDirectory d `catchall` (fail $ "can't set directory to "++d)
> hunk ./src/Darcs/Repository/Internal.hs 290
> - findRepository []
> -findRepository (_:fs) = findRepository fs
> -findRepository [] = seekRepo (Right ())
> + findRepository [] []
> +findRepository (_:fs) _ = findRepository fs []
> +findRepository [] _ = seekRepo (Right ())
>
> make_new_pending :: forall p C(r u t y). RepoPatch p
> => Repository p C(r u t) -> FL Prim C(t y) -> IO ()
> hunk ./src/Darcs/RunCommand.hs 89
> | Help `elem` opts -> viewDoc $ text $ getCommandHelp msuper cmd
> | ListOptions `elem` opts -> do
> setProgressMode False
> - commandPrereq cmd opts
> + commandPrereq cmd opts extra
> file_args <- commandGetArgPossibilities cmd
> putStrLn $ getOptionsOptions (opts1++opts2) ++ unlines file_args
> | otherwise -> considerRunning msuper cmd (addVerboseIfDebug opts) extra
> hunk ./src/Darcs/RunCommand.hs 101
> -> [DarcsFlag] -> [String] -> IO ()
> considerRunning msuper cmd opts old_extra = do
> cwd <- getCurrentDirectory
> - location <- commandPrereq cmd opts
> + location <- commandPrereq cmd opts old_extra
> case location of
> Left complaint -> fail $ "Unable to " ++
> formatPath ("darcs " ++ superName msuper ++ commandName cmd) ++
>
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
|
Thanks for the quick review [hope I can encourage you to do more of
this],
On Sun, May 30, 2010 at 18:10:29 +0000, Radoslav Dorcik wrote:
> #2 comment
>
> It would be great to write automatic test for this new darcs init
> format; at least in form of shell script.
At first I was going to resist this, but then I realised that actually
such a test could be useful for making sure that darcs init *fails* in
the right places (which I is the kind of thing I suspect people don't
generally do enough testing of, ie. what shouldn't work)
> For me it looks like too much impact on places not directly related
> with this issue. I would go with different approach; try to
> concentrate all this short-cut for init command into Init.hs
> only. Unforunately such approach leads probably to different behavior
> in some edge cases (my attached patch fails on issue279_get_extra.sh).
>
> It would be helpful if darcs experienced developers provide suggestion
> which way is better to go.
I believe here we've got a confrontation between two principles:
- the less invasive a change the better
- the more uniform/coherent/consistent the code the better
Looking through the code, it seems that right now, all the commands
check their prereqs with the commandPrereq function (and this includes
things such as the context file existing). There are some lightweight
prereqs for darcs get that don't seem to get checked (for example, that
if you say darcs get foo bar), but it seems like that could easily
change.
So what should we do here? Maybe it would be good if you and Guillaume
could work together to figure out why your (Rado)'s draft fails the test
currently. Also one thing to think about: how are prereqs currently
handled and should it be improved?
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
|
