basic recursion done; skipping git stuff still todo
This commit is contained in:
parent
645bc94d3d
commit
1260adbd77
4 changed files with 30 additions and 8 deletions
17
Commands.hs
17
Commands.hs
|
@ -26,20 +26,21 @@ import qualified Remotes
|
||||||
- actions to be run in the Annex monad. -}
|
- actions to be run in the Annex monad. -}
|
||||||
parseCmd :: [String] -> IO ([Flag], [Annex ()])
|
parseCmd :: [String] -> IO ([Flag], [Annex ()])
|
||||||
parseCmd argv = do
|
parseCmd argv = do
|
||||||
(flags, files) <- getopt
|
(flags, params) <- getopt
|
||||||
case (length files) of
|
case (length params) of
|
||||||
0 -> error header
|
0 -> error header
|
||||||
_ -> do
|
_ -> do
|
||||||
let c = lookupCmd (files !! 0)
|
let (cmd, locs) = takeCmd params $ lookupCmd (params !! 0)
|
||||||
if (0 == length c)
|
files <- mapM recurseFiles locs
|
||||||
then ret flags defaultCmd files
|
return (flags, map cmd $ foldl (++) [] files)
|
||||||
else ret flags (snd $ c !! 0) $ drop 1 files
|
|
||||||
where
|
where
|
||||||
ret flags cmd files = return (flags, makeactions cmd files)
|
|
||||||
makeactions cmd files = map cmd files
|
|
||||||
getopt = case getOpt Permute options argv of
|
getopt = case getOpt Permute options argv of
|
||||||
(flags, nonopts, []) -> return (flags, nonopts)
|
(flags, nonopts, []) -> return (flags, nonopts)
|
||||||
(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
|
(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
|
||||||
|
takeCmd files cmds =
|
||||||
|
if (0 == length cmds)
|
||||||
|
then (defaultCmd, files)
|
||||||
|
else ((snd $ cmds !! 0), drop 1 files)
|
||||||
lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds
|
lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds
|
||||||
cmds = [ ("add", addCmd)
|
cmds = [ ("add", addCmd)
|
||||||
, ("get", getCmd)
|
, ("get", getCmd)
|
||||||
|
|
2
TODO
2
TODO
|
@ -2,6 +2,8 @@
|
||||||
|
|
||||||
* --push/--pull/--want
|
* --push/--pull/--want
|
||||||
|
|
||||||
|
* isn't pull the same as get?
|
||||||
|
|
||||||
* recurse on directories
|
* recurse on directories
|
||||||
|
|
||||||
* how to handle git mv file?
|
* how to handle git mv file?
|
||||||
|
|
14
Utility.hs
14
Utility.hs
|
@ -7,12 +7,14 @@ module Utility (
|
||||||
parentDir,
|
parentDir,
|
||||||
relPathCwdToDir,
|
relPathCwdToDir,
|
||||||
relPathDirToDir,
|
relPathDirToDir,
|
||||||
|
recurseFiles,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.IO
|
import System.Posix.IO
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
import System.Path
|
import System.Path
|
||||||
|
import System.IO.HVFS
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
|
||||||
|
@ -87,3 +89,15 @@ 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
|
||||||
|
|
|
@ -42,6 +42,11 @@ Enough broad picture, here's how it actually looks:
|
||||||
* `git annex $file` is a shorthand. If the file
|
* `git annex $file` is a shorthand. If the file
|
||||||
is already known, it does `git annex get`, otherwise it does `git annex add`.
|
is already known, it does `git annex get`, otherwise it does `git annex add`.
|
||||||
|
|
||||||
|
Oh yeah, "$file" in the above can be any number of files, or directories.
|
||||||
|
git-annex automatically recurses into directories, but skips files that are
|
||||||
|
checked into git (as well as skipping `.git` itself), so "git annex ." works
|
||||||
|
fine.
|
||||||
|
|
||||||
## copies
|
## copies
|
||||||
|
|
||||||
git-annex can be configured to try to keep N copies of a file's content
|
git-annex can be configured to try to keep N copies of a file's content
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue