now finds files in git or not depending on what command wants
This commit is contained in:
parent
bfa581a218
commit
e80160380a
3 changed files with 41 additions and 32 deletions
56
Commands.hs
56
Commands.hs
|
@ -21,35 +21,57 @@ import LocationLog
|
|||
import Types
|
||||
import Core
|
||||
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
|
||||
- actions to be run in the Annex monad. -}
|
||||
parseCmd :: [String] -> IO ([Flag], [Annex ()])
|
||||
parseCmd argv = do
|
||||
parseCmd :: [String] -> AnnexState -> IO ([Flag], [Annex ()])
|
||||
parseCmd argv state = do
|
||||
(flags, params) <- getopt
|
||||
case (length params) of
|
||||
0 -> error header
|
||||
_ -> case (lookupCmd (params !! 0)) of
|
||||
[] -> error header
|
||||
[(_,cmd)] -> do
|
||||
let locs = drop 1 params
|
||||
files <- mapM recurseFiles locs
|
||||
return (flags, map cmd $ foldl (++) [] files)
|
||||
[Command _ action want] -> do
|
||||
f <- findWanted want (drop 1 params)
|
||||
(BackendTypes.repo state)
|
||||
return (flags, map action f)
|
||||
where
|
||||
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))
|
||||
lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds
|
||||
cmds = [ ("add", addCmd)
|
||||
, ("get", getCmd)
|
||||
, ("drop", dropCmd)
|
||||
, ("want", wantCmd)
|
||||
, ("push", pushCmd)
|
||||
, ("pull", pullCmd)
|
||||
, ("unannex", unannexCmd)
|
||||
]
|
||||
lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds
|
||||
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" ]
|
||||
|
||||
{- Annexes a file, storing it in a backend, and then moving it into
|
||||
|
|
15
Utility.hs
15
Utility.hs
|
@ -6,8 +6,7 @@ module Utility (
|
|||
hGetContentsStrict,
|
||||
parentDir,
|
||||
relPathCwdToDir,
|
||||
relPathDirToDir,
|
||||
recurseFiles,
|
||||
relPathDirToDir
|
||||
) where
|
||||
|
||||
import System.IO
|
||||
|
@ -89,15 +88,3 @@ relPathDirToDir from to =
|
|||
dotdots = take ((length pfrom) - numcommon) $ repeat ".."
|
||||
numcommon = length $ common
|
||||
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
|
||||
|
|
|
@ -12,9 +12,9 @@ import qualified GitRepo as Git
|
|||
|
||||
main = do
|
||||
args <- getArgs
|
||||
(flags, actions) <- parseCmd args
|
||||
gitrepo <- Git.repoFromCwd
|
||||
state <- new gitrepo
|
||||
(flags, actions) <- parseCmd args state
|
||||
tryRun state $ [startup flags] ++ actions ++ [shutdown]
|
||||
|
||||
{- Runs a list of Annex actions. Catches exceptions, not stopping
|
||||
|
|
Loading…
Reference in a new issue