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 <guilla...@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
signature.asc
Description: Digital signature
_______________________________________________ darcs-users mailing list darcs-users@darcs.net http://lists.osuosl.org/mailman/listinfo/darcs-users
