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 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
|
||||||
|
|
15
Utility.hs
15
Utility.hs
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue