diff options
author | Joey Hess <joey@kitenet.net> | 2011-09-19 01:37:04 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-09-19 01:38:01 -0400 |
commit | dcded89129c4647bc71b474aac6d3e334b4321c1 (patch) | |
tree | b0ad55d41caf7a3fdee9839b4c0f848f75249819 /Command.hs | |
parent | 6e80f195148ca689d85c6c8ed7f1a4f9720397a7 (diff) |
reorg
Diffstat (limited to 'Command.hs')
-rw-r--r-- | Command.hs | 52 |
1 files changed, 11 insertions, 41 deletions
diff --git a/Command.hs b/Command.hs index a568da33b..cc9bcbf0c 100644 --- a/Command.hs +++ b/Command.hs @@ -1,6 +1,6 @@ {- git-annex command infrastructure - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010-2011 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,9 +10,8 @@ module Command where import Control.Monad.State (liftIO) import System.Directory import System.Posix.Files -import Control.Monad (filterM, liftM, when) +import Control.Monad (filterM, liftM) import Control.Applicative -import Data.List import Data.Maybe import Types @@ -22,6 +21,8 @@ import qualified Annex import qualified Git import qualified Git.LsFiles as LsFiles import Utility +import Utility.Conditional +import Utility.Path import Types.Key import Trust import LocationLog @@ -75,9 +76,8 @@ stop = return Nothing {- Prepares a list of actions to run to perform a command, based on - the parameters passed to it. -} prepCommand :: Command -> [String] -> Annex [Annex Bool] -prepCommand Command { cmdseek = seek } params = do - lists <- mapM (\s -> s params) seek - return $ map doCommand $ concat lists +prepCommand Command { cmdseek = seek } params = + return . map doCommand . concat =<< mapM (\s -> s params) seek {- Runs a command through the start, perform and cleanup stages -} doCommand :: CommandStart -> CommandCleanup @@ -86,11 +86,9 @@ doCommand = start start = stage $ maybe success perform perform = stage $ maybe failure cleanup cleanup = stage $ \r -> showEndResult r >> return r - stage a b = b >>= a + stage = (=<<) success = return True - failure = do - showEndFail - return False + failure = showEndFail >> return False notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a) notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file @@ -100,13 +98,12 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file notBareRepo :: Annex a -> Annex a notBareRepo a = do - g <- Annex.gitRepo - when (Git.repoIsLocalBare g) $ + whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $ error "You cannot run this subcommand in a bare repository." a {- These functions find appropriate files or other things based on a - user's parameters, and run a specified action on them. -} + user's parameters, and prepare actions operating on them. -} withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit a params = do repo <- Annex.gitRepo @@ -170,7 +167,7 @@ runFiltered a fs = runFilteredGen a id fs backendPairs :: (BackendFile -> CommandStart) -> CommandSeek backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs) -runFilteredGen :: (a1 -> Annex (Maybe a)) -> (a1 -> FilePath) -> Annex [a1] -> Annex [Annex (Maybe a)] +runFilteredGen :: (b -> Annex (Maybe a)) -> (b -> FilePath) -> Annex [b] -> Annex [Annex (Maybe a)] runFilteredGen a d fs = do matcher <- Limit.getMatcher liftM (map $ proc matcher) fs @@ -228,33 +225,6 @@ cmdlineKey = do nokey = error "please specify the key with --key" badkey = error "bad key" -{- Given an original list of files, and an expanded list derived from it, - - ensures that the original list's ordering is preserved. - - - - The input list may contain a directory, like "dir" or "dir/". Any - - items in the expanded list that are contained in that directory will - - appear at the same position as it did in the input list. - -} -preserveOrder :: [FilePath] -> [FilePath] -> [FilePath] --- optimisation, only one item in original list, so no reordering needed -preserveOrder [_] new = new -preserveOrder orig new = collect orig new - where - collect [] n = n - collect [_] n = n -- optimisation - collect (l:ls) n = found ++ collect ls rest - where (found, rest)=partition (l `dirContains`) n - -{- Runs an action that takes a list of FilePaths, and ensures that - - its return list preserves order. - - - - This assumes that it's cheaper to call preserveOrder on the result, - - than it would be to run the action separately with each param. In the case - - of git file list commands, that assumption tends to hold. - -} -runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath] -runPreserveOrder a files = preserveOrder files <$> a files - {- Used for commands that have an auto mode that checks the number of known - copies of a key. - |