diff options
-rw-r--r-- | Commands.hs | 132 | ||||
-rw-r--r-- | debian/changelog | 2 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 14 |
3 files changed, 85 insertions, 63 deletions
diff --git a/Commands.hs b/Commands.hs index 507c82ccc..0f3c6ac34 100644 --- a/Commands.hs +++ b/Commands.hs @@ -27,12 +27,18 @@ import Core import qualified Remotes import qualified TypeInternals +{- A subcommand can take one of several kinds of input parameters. -} +data SubCmdInput = FilesInGit FilePath | FilesNotInGit FilePath | + FilesMissing FilePath | Description String | Keys String | + Tempfile FilePath | FilesToBeCommitted FilePath + {- A subcommand runs in three stages. Each stage can return the next stage - to run. - - 1. The start stage is run before anything is printed about the - - subcommand, and can early abort it if the input does not make sense. - - It should run quickly and should not modify Annex state. + - subcommand, is passed some input, and can early abort it + - if the input does not make sense. It should run quickly and + - should not modify Annex state. - - 2. The perform stage is run after a message is printed about the subcommand - being run, and it should be where the bulk of the work happens. @@ -40,18 +46,18 @@ import qualified TypeInternals - 3. The cleanup stage is run only if the perform stage succeeds, and it - returns the overall success/fail of the subcommand. -} -type SubCmdStart = String -> Annex (Maybe SubCmdPerform) +type SubCmdStart = Annex (Maybe SubCmdPerform) type SubCmdPerform = Annex (Maybe SubCmdCleanup) type SubCmdCleanup = Annex Bool {- Runs a subcommand through its three stages. -} -doSubCmd :: String -> SubCmdStart -> String -> Annex Bool -doSubCmd cmdname start param = do - startres <- start param :: Annex (Maybe SubCmdPerform) +doSubCmd :: String -> SubCmdStart -> Annex Bool +doSubCmd cmdname start = do + startres <- start :: Annex (Maybe SubCmdPerform) case (startres) of Nothing -> return True Just perform -> do - showStart cmdname param + --showStart cmdname param performres <- perform :: Annex (Maybe SubCmdCleanup) case (performres) of Nothing -> do @@ -68,15 +74,10 @@ doSubCmd cmdname start param = do return False -{- A subcommand can broadly want one of several kinds of input parameters. - - This allows a first stage of filtering before starting a subcommand. -} -data SubCmdWants = FilesInGit | FilesNotInGit | FilesMissing - | Description | Keys | Tempfile | FilesToBeCommitted - data SubCommand = SubCommand { subcmdname :: String, - subcmdaction :: SubCmdStart, - subcmdwants :: SubCmdWants, + subcmdaction :: (SubCmdInput -> SubCmdStart), + subcmdinput :: (String -> SubCmdInput), subcmddesc :: String } subCmds :: [SubCommand] @@ -139,40 +140,53 @@ usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs showcmd c = (subcmdname c) ++ (pad 11 (subcmdname c)) ++ - (descWanted (subcmdwants c)) ++ - (pad 13 (descWanted (subcmdwants c))) ++ + (descSubCmdInput (subcmdinput c)) ++ + (pad 13 (descSubCmdInput (subcmdinput c))) ++ (subcmddesc c) indent l = " " ++ l pad n s = take (n - (length s)) $ repeat ' ' {- Generate descriptions of wanted parameters for subcommands. -} -descWanted :: SubCmdWants -> String -descWanted Description = "DESCRIPTION" -descWanted Keys = "KEY ..." -descWanted _ = "PATH ..." +descSubCmdInput :: (String -> SubCmdInput) -> String +descSubCmdInput Description = "DESCRIPTION" +descSubCmdInput Keys = "KEY ..." +descSubCmdInput _ = "PATH ..." + +{- Prepares a set of actions to run to handle a subcommand, based on + - the parameters passed to it. -} +prepSubCmd :: SubCommand -> Git.Repo -> [String] -> IO [Annex Bool] +prepSubCmd SubCommand { subcmdname = name, subcmdaction = action, + subcmdinput = input, subcmddesc = _ } repo params = do + input <- findInput input params repo + return $ map (doSubCmd name action) input {- Finds the type of parameters a subcommand wants, from among the passed - parameter list. -} -findWanted :: SubCmdWants -> [String] -> Git.Repo -> IO [String] -findWanted FilesNotInGit params repo = do +findInput :: (String -> SubCmdInput) -> [String] -> Git.Repo -> IO [SubCmdInput] +findInput FilesNotInGit params repo = do files <- mapM (Git.notInRepo repo) params - return $ foldl (++) [] files -findWanted FilesInGit params repo = do + return $ map FilesNotInGit $ notState $ foldl (++) [] files +findInput FilesInGit params repo = do files <- mapM (Git.inRepo repo) params - return $ foldl (++) [] files -findWanted FilesMissing params _ = do + return $ map FilesInGit $ notState $ foldl (++) [] files +findInput FilesMissing params _ = do files <- liftIO $ filterM missing params - return $ files + return $ map FilesMissing $ notState $ files where missing f = do e <- doesFileExist f return $ not e -findWanted Description params _ = do - return $ [unwords params] -findWanted FilesToBeCommitted params repo = do +findInput Description params _ = do + return $ map Description $ [unwords params] +findInput FilesToBeCommitted params repo = do files <- mapM (Git.stagedFiles repo) params - return $ foldl (++) [] files -findWanted _ params _ = return params + return $ map FilesToBeCommitted $ notState $ foldl (++) [] files +findInput Keys params _ = return $ map Keys params +findInput Tempfile params _ = return $ map Tempfile params + +{- filter out files from the state directory -} +notState :: [FilePath] -> [FilePath] +notState fs = filter (\f -> stateLoc /= take (length stateLoc) f) fs {- Parses command line and returns two lists of actions to be - run in the Annex monad. The first actions configure it @@ -184,20 +198,15 @@ parseCmd argv state = do when (null params) $ error usage case lookupCmd (params !! 0) of [] -> error usage - [SubCommand { subcmdname = name, subcmdaction = action, - subcmdwants = want, subcmddesc = _ }] -> do - files <- findWanted want (drop 1 params) - (TypeInternals.repo state) - let actions = map (doSubCmd name action) $ - filter notstate files + [subcommand] -> do + let repo = TypeInternals.repo state + actions <- prepSubCmd subcommand repo (drop 1 params) let configactions = map (\flag -> do flag return True) flags return (configactions, actions) _ -> error "internal error: multiple matching subcommands" where - -- never include files from the state directory - notstate f = stateLoc /= take (length stateLoc) f getopt = case getOpt Permute options argv of (flags, params, []) -> return (flags, params) (_, _, errs) -> ioError (userError (concat errs ++ usage)) @@ -206,8 +215,8 @@ parseCmd argv state = do {- The add subcommand annexes a file, storing it in a backend, and then - moving it into the annex directory and setting up the symlink pointing - to its content. -} -addStart :: FilePath -> Annex (Maybe SubCmdPerform) -addStart file = notAnnexed file $ do +addStart :: SubCmdInput -> SubCmdStart +addStart (FilesNotInGit file) = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) then return Nothing @@ -231,8 +240,8 @@ addCleanup file key = do return True {- The unannex subcommand undoes an add. -} -unannexStart :: FilePath -> Annex (Maybe SubCmdPerform) -unannexStart file = isAnnexed file $ \(key, backend) -> do +unannexStart :: SubCmdInput -> SubCmdStart +unannexStart (FilesInGit file) = isAnnexed file $ \(key, backend) -> do return $ Just $ unannexPerform file key backend unannexPerform :: FilePath -> Key -> Backend -> Annex (Maybe SubCmdCleanup) unannexPerform file key backend = do @@ -255,8 +264,8 @@ unannexCleanup file key = do return True {- Gets an annexed file from one of the backends. -} -getStart :: FilePath -> Annex (Maybe SubCmdPerform) -getStart file = isAnnexed file $ \(key, backend) -> do +getStart :: SubCmdInput -> Annex (Maybe SubCmdPerform) +getStart (FilesInGit file) = isAnnexed file $ \(key, backend) -> do inannex <- inAnnex key if (inannex) then return Nothing @@ -270,8 +279,8 @@ getPerform key backend = do {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} -dropStart :: FilePath -> Annex (Maybe SubCmdPerform) -dropStart file = isAnnexed file $ \(key, backend) -> do +dropStart :: SubCmdInput -> SubCmdStart +dropStart (FilesInGit file) = isAnnexed file $ \(key, backend) -> do inbackend <- Backend.hasKey key if (not inbackend) then return Nothing @@ -295,8 +304,8 @@ dropCleanup key = do else return True {- Drops cached content for a key. -} -dropKeyStart :: String -> Annex (Maybe SubCmdPerform) -dropKeyStart keyname = do +dropKeyStart :: SubCmdInput -> SubCmdStart +dropKeyStart (Keys keyname) = do backends <- Backend.list let key = genKey (backends !! 0) keyname present <- inAnnex key @@ -318,8 +327,8 @@ dropKeyCleanup key = do return True {- Sets cached content for a key. -} -setKeyStart :: FilePath -> Annex (Maybe SubCmdPerform) -setKeyStart tmpfile = do +setKeyStart :: SubCmdInput -> SubCmdStart +setKeyStart (Tempfile tmpfile) = do keyname <- Annex.flagGet "key" when (null keyname) $ error "please specify the key with --key" backends <- Backend.list @@ -339,8 +348,11 @@ setKeyCleanup key = do return True {- Fixes the symlink to an annexed file. -} -fixStart :: FilePath -> Annex (Maybe SubCmdPerform) -fixStart file = isAnnexed file $ \(key, _) -> do +fixStart :: SubCmdInput -> SubCmdStart +fixStart (FilesInGit file) = fixStart' file +fixStart (FilesToBeCommitted file) = fixStart' file +fixStart' :: FilePath -> SubCmdStart +fixStart' file = isAnnexed file $ \(key, _) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file if (link == l) @@ -358,8 +370,8 @@ fixCleanup file = do return True {- Stores description for the repository etc. -} -initStart :: String -> Annex (Maybe SubCmdPerform) -initStart description = do +initStart :: SubCmdInput -> SubCmdStart +initStart (Description description) = do when (null description) $ error $ "please specify a description of this repository\n" ++ usage return $ Just $ initPerform description @@ -380,8 +392,8 @@ initCleanup = do return True {- Adds a file pointing at a manually-specified key -} -fromKeyStart :: FilePath -> Annex (Maybe SubCmdPerform) -fromKeyStart file = do +fromKeyStart :: SubCmdInput -> SubCmdStart +fromKeyStart (FilesMissing file) = do keyname <- Annex.flagGet "key" when (null keyname) $ error "please specify the key with --key" backends <- Backend.list @@ -406,8 +418,8 @@ fromKeyCleanup file = do - - This only operates on the cached file content; it does not involve - moving data in the key-value backend. -} -moveStart :: FilePath -> Annex (Maybe SubCmdPerform) -moveStart file = do +moveStart :: SubCmdInput -> SubCmdStart +moveStart (FilesInGit file) = do fromName <- Annex.flagGet "fromrepository" toName <- Annex.flagGet "torepository" case (fromName, toName) of diff --git a/debian/changelog b/debian/changelog index cb6a0ef86..1709f6346 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,8 @@ git-annex (0.03) UNRELEASED; urgency=low from git before starting, and will be much faster with large repos. * Fix crash on unknown symlinks. * Added remote.annex-scp-options and remote.annex-ssh-options. + * The backends to use when adding different sets of files can be configured + via gitattributes. -- Joey Hess <joeyh@debian.org> Thu, 28 Oct 2010 13:46:59 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 52a8c712f..bbd7e8cab 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -159,8 +159,7 @@ Many git-annex subcommands will stage changes for later `git commit` by you. * --backend=name - Specify the default key-value backend to use, adding it to the front - of the list normally configured by `annex.backends`. + Specifies the key-value backend to use when adding a file. * --key=name @@ -186,7 +185,7 @@ Here are all the supported configuration settings. repositories (default: 1) * `annex.backends` -- space-separated list of names of the key-value backends to use. The first listed is used to store - new files. (default: "WORM SHA1 URL") + new files by default. (default: "WORM SHA1 URL") * `remote.<name>.annex-cost` -- When determining which repository to transfer annexed files from or to, ones with lower costs are preferred. The default cost is 100 for local repositories, and 200 for remote @@ -204,6 +203,15 @@ Here are all the supported configuration settings. * `annex.scp-options` and `annex.ssh-options` -- Default scp and ssh options to use if a remote does not have specific options. +The backend used when adding a new file to the annex can be configured +on a per-file-type basis via the `.gitattributes` file. In the file, +the `git-annex-backend` attribute can be set to the name of the backend to +use. For example, this here's how to use the WORM backend by default, +but the SHA1 backend for ogg files: + + * git-annex-backend=WORM + *.ogg git-annex-backend=SHA1 + # FILES These files are used, in your git repository: |