refactor param seeking

This commit is contained in:
Joey Hess 2010-11-11 18:54:52 -04:00
parent 5357d3a37a
commit da0de293d1
17 changed files with 138 additions and 93 deletions

View file

@ -1,4 +1,4 @@
{- git-annex command types
{- git-annex commands
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
@ -7,10 +7,17 @@
module Command where
import Control.Monad.State (liftIO)
import System.Directory
import System.Posix.Files
import Control.Monad (filterM)
import Types
import qualified Backend
import Messages
import qualified Annex
import qualified GitRepo as Git
import Locations
{- A subcommand runs in four stages.
-
@ -87,3 +94,64 @@ isAnnexed file a = do
case (r) of
Just v -> a v
Nothing -> return Nothing
{- These functions find appropriate files or other things based on a
user's parameters, and run a specified action on them. -}
withFilesInGit :: SubCmdSeekStrings
withFilesInGit a params = do
repo <- Annex.gitRepo
files <- liftIO $ mapM (Git.inRepo repo) params
return $ map a $ filter notState $ foldl (++) [] files
withFilesMissing :: SubCmdSeekStrings
withFilesMissing a params = do
files <- liftIO $ filterM missing params
return $ map a $ filter notState files
where
missing f = do
e <- doesFileExist f
return $ not e
withFilesNotInGit :: SubCmdSeekBackendFiles
withFilesNotInGit a params = do
repo <- Annex.gitRepo
newfiles <- liftIO $ mapM (Git.notInRepo repo) params
backendPairs a $ filter notState $ foldl (++) [] newfiles
withFilesUnlocked :: SubCmdSeekBackendFiles
withFilesUnlocked a params = do
-- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo
typechangedfiles <- liftIO $ mapM (Git.typeChangedFiles repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
backendPairs a $ filter notState unlockedfiles
backendPairs :: SubCmdSeekBackendFiles
backendPairs a files = do
pairs <- Backend.chooseBackends files
return $ map a pairs
withDescription :: SubCmdSeekStrings
withDescription a params = return [a $ unwords params]
withFilesToBeCommitted :: SubCmdSeekStrings
withFilesToBeCommitted a params = do
repo <- Annex.gitRepo
tocommit <- liftIO $ mapM (Git.stagedFiles repo) params
return $ map a $ filter notState $ foldl (++) [] tocommit
withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
withUnlockedFilesToBeCommitted a params = do
repo <- Annex.gitRepo
typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
return $ map a $ filter notState unlockedfiles
withKeys :: SubCmdSeekStrings
withKeys a params = return $ map a params
withTempFile :: SubCmdSeekStrings
withTempFile a params = return $ map a params
withNothing :: SubCmdSeekNothing
withNothing a _ = return [a]
{- filter out files from the state directory -}
notState :: FilePath -> Bool
notState f = stateLoc /= take (length stateLoc) f
{- filter out symlinks -}
notSymlink :: FilePath -> IO Bool
notSymlink f = do
s <- liftIO $ getSymbolicLinkStatus f
return $ not $ isSymbolicLink s