now finds files in git or not depending on what command wants

This commit is contained in:
Joey Hess 2010-10-16 14:58:35 -04:00
parent bfa581a218
commit e80160380a
3 changed files with 41 additions and 32 deletions

View file

@ -21,35 +21,57 @@ import LocationLog
import Types import Types
import Core import Core
import qualified Remotes import qualified Remotes
import qualified BackendTypes
data CmdWants = FilesInGit | FilesNotInGit | RepoName
data Command = Command {
cmdname :: String,
cmdaction :: (String -> Annex ()),
cmdwants :: CmdWants
}
cmds :: [Command]
cmds = [ (Command "add" addCmd FilesNotInGit)
, (Command "get" getCmd FilesInGit)
, (Command "drop" dropCmd FilesInGit)
, (Command "want" wantCmd FilesInGit)
, (Command "push" pushCmd RepoName)
, (Command "pull" pullCmd RepoName)
, (Command "unannex" unannexCmd FilesInGit)
]
{- Finds the type of parameters a command wants, from among the passed
- parameter list. -}
findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String]
findWanted FilesNotInGit params repo = do
files <- mapM (Git.notInRepo repo) params
return $ foldl (++) [] files
findWanted FilesInGit params repo = do
files <- mapM (Git.inRepo repo) params
return $ foldl (++) [] files
findWanted RepoName params _ = do
return $ params
{- Parses command line and returns a list of flags and a list of {- Parses command line and returns a list of flags and a list of
- actions to be run in the Annex monad. -} - actions to be run in the Annex monad. -}
parseCmd :: [String] -> IO ([Flag], [Annex ()]) parseCmd :: [String] -> AnnexState -> IO ([Flag], [Annex ()])
parseCmd argv = do parseCmd argv state = do
(flags, params) <- getopt (flags, params) <- getopt
case (length params) of case (length params) of
0 -> error header 0 -> error header
_ -> case (lookupCmd (params !! 0)) of _ -> case (lookupCmd (params !! 0)) of
[] -> error header [] -> error header
[(_,cmd)] -> do [Command _ action want] -> do
let locs = drop 1 params f <- findWanted want (drop 1 params)
files <- mapM recurseFiles locs (BackendTypes.repo state)
return (flags, map cmd $ foldl (++) [] files) return (flags, map action f)
where where
getopt = case getOpt Permute options argv of getopt = case getOpt Permute options argv of
(flags, nonopts, []) -> return (flags, nonopts) (flags, params, []) -> return (flags, params)
(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds
cmds = [ ("add", addCmd)
, ("get", getCmd)
, ("drop", dropCmd)
, ("want", wantCmd)
, ("push", pushCmd)
, ("pull", pullCmd)
, ("unannex", unannexCmd)
]
header = "Usage: git-annex [" ++ header = "Usage: git-annex [" ++
(join "|" $ map fst cmds) ++ "] file ..." (join "|" $ map cmdname cmds) ++ "] file ..."
options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ]
{- Annexes a file, storing it in a backend, and then moving it into {- Annexes a file, storing it in a backend, and then moving it into

View file

@ -6,8 +6,7 @@ module Utility (
hGetContentsStrict, hGetContentsStrict,
parentDir, parentDir,
relPathCwdToDir, relPathCwdToDir,
relPathDirToDir, relPathDirToDir
recurseFiles,
) where ) where
import System.IO import System.IO
@ -89,15 +88,3 @@ relPathDirToDir from to =
dotdots = take ((length pfrom) - numcommon) $ repeat ".." dotdots = take ((length pfrom) - numcommon) $ repeat ".."
numcommon = length $ common numcommon = length $ common
path = join s $ dotdots ++ uncommon path = join s $ dotdots ++ uncommon
{- Recursively returns all files and symlinks (to anything) in the specified
- path. If the path is a file, returns only it. Does not follow symlinks to
- directories. -}
recurseFiles :: FilePath -> IO [FilePath]
recurseFiles path = do
find <- recurseDirStat SystemFS path
return $ filesOnly find
where
filesOnly l = map (\(f,s) -> f) $ filter isFile l
isFile (f, HVFSStatEncap s) =
vIsRegularFile s || vIsSymbolicLink s

View file

@ -12,9 +12,9 @@ import qualified GitRepo as Git
main = do main = do
args <- getArgs args <- getArgs
(flags, actions) <- parseCmd args
gitrepo <- Git.repoFromCwd gitrepo <- Git.repoFromCwd
state <- new gitrepo state <- new gitrepo
(flags, actions) <- parseCmd args state
tryRun state $ [startup flags] ++ actions ++ [shutdown] tryRun state $ [startup flags] ++ actions ++ [shutdown]
{- Runs a list of Annex actions. Catches exceptions, not stopping {- Runs a list of Annex actions. Catches exceptions, not stopping