From 016b6a59e7187ead0ed630699c85d0fec729a30d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 6 Nov 2010 17:06:19 -0400 Subject: [PATCH] add fsck subcommand (stub) --- CmdLine.hs | 72 ++++++++++++++++++++++------------------------ Command.hs | 2 +- Command/Fsck.hs | 39 +++++++++++++++++++++++++ debian/changelog | 1 + doc/git-annex.mdwn | 5 ++++ 5 files changed, 81 insertions(+), 38 deletions(-) create mode 100644 Command/Fsck.hs diff --git a/CmdLine.hs b/CmdLine.hs index 7aaa1c842e..3823c72476 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,8 +10,7 @@ module CmdLine (parseCmd) where import System.Console.GetOpt import Control.Monad.State (liftIO) import System.Directory -import Control.Monad (filterM) -import Monad (when) +import Control.Monad (filterM, when) import qualified GitRepo as Git import qualified Annex @@ -33,31 +32,31 @@ import qualified Command.Init import qualified Command.Fsck subCmds :: [SubCommand] -subCmds = [ - (SubCommand "add" path (withFilesNotInGit Command.Add.start) - "add files to annex") - , (SubCommand "get" path (withFilesInGit Command.Get.start) - "make content of annexed files available") - , (SubCommand "drop" path (withFilesInGit Command.Drop.start) - "indicate content of files not currently wanted") - , (SubCommand "move" path (withFilesInGit Command.Move.start) - "transfer content of files to/from another repository") - , (SubCommand "init" desc (withDescription Command.Init.start) - "initialize git-annex with repository description") - , (SubCommand "unannex" path (withFilesInGit Command.Unannex.start) - "undo accidential add command") - , (SubCommand "pre-commit" path (withFilesToBeCommitted Command.Fix.start) - "fix up symlinks before they are committed") - , (SubCommand "fromkey" key (withFilesMissing Command.FromKey.start) - "adds a file using a specific key") - , (SubCommand "dropkey" key (withKeys Command.DropKey.start) - "drops annexed content for specified keys") - , (SubCommand "setkey" key (withTempFile Command.SetKey.start) - "sets annexed content for a key using a temp file") - , (SubCommand "fix" path (withFilesInGit Command.Fix.start) - "fix up symlinks to point to annexed content") - , (SubCommand "fsck" nothing (withNothing Command.Fsck.start) - "check annex for problems") +subCmds = + [ SubCommand "add" path (withFilesNotInGit Command.Add.start) + "add files to annex" + , SubCommand "get" path (withFilesInGit Command.Get.start) + "make content of annexed files available" + , SubCommand "drop" path (withFilesInGit Command.Drop.start) + "indicate content of files not currently wanted" + , SubCommand "move" path (withFilesInGit Command.Move.start) + "transfer content of files to/from another repository" + , SubCommand "init" desc (withDescription Command.Init.start) + "initialize git-annex with repository description" + , SubCommand "unannex" path (withFilesInGit Command.Unannex.start) + "undo accidential add command" + , SubCommand "pre-commit" path (withFilesToBeCommitted Command.Fix.start) + "fix up symlinks before they are committed" + , SubCommand "fromkey" key (withFilesMissing Command.FromKey.start) + "adds a file using a specific key" + , SubCommand "dropkey" key (withKeys Command.DropKey.start) + "drops annexed content for specified keys" + , SubCommand "setkey" key (withTempFile Command.SetKey.start) + "sets annexed content for a key using a temp file" + , SubCommand "fix" path (withFilesInGit Command.Fix.start) + "fix up symlinks to point to annexed content" + , SubCommand "fsck" nothing (withNothing Command.Fsck.start) + "check annex for problems" ] where path = "PATH ..." @@ -95,15 +94,15 @@ header = "Usage: git-annex subcommand [option ..]" usage :: String usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs where - cmddescs = unlines $ map (\c -> indent $ showcmd c) subCmds + cmddescs = unlines $ map (indent . showcmd) subCmds showcmd c = - (subcmdname c) ++ - (pad 11 (subcmdname c)) ++ - (subcmdparams c) ++ - (pad 13 (subcmdparams c)) ++ - (subcmddesc c) + subcmdname c ++ + pad 11 (subcmdname c) ++ + subcmdparams c ++ + pad 13 (subcmdparams c) ++ + subcmddesc c indent l = " " ++ l - pad n s = take (n - (length s)) $ repeat ' ' + pad n s = replicate (n - length s) ' ' {- These functions find appropriate files or other things based on a user's parameters. -} @@ -128,8 +127,7 @@ withFilesMissing a params = do e <- doesFileExist f return $ not e withDescription :: SubCmdSeekStrings -withDescription a params = do - return $ [a $ unwords params] +withDescription a params = return [a $ unwords params] withFilesToBeCommitted :: SubCmdSeekStrings withFilesToBeCommitted a params = do repo <- Annex.gitRepo @@ -154,7 +152,7 @@ parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool]) parseCmd argv state = do (flags, params) <- getopt when (null params) $ error usage - case lookupCmd (params !! 0) of + case lookupCmd (head params) of [] -> error usage [subcommand] -> do actions <- prepSubCmd subcommand state (drop 1 params) diff --git a/Command.hs b/Command.hs index d557651aa3..a0e3280d6b 100644 --- a/Command.hs +++ b/Command.hs @@ -50,7 +50,7 @@ data SubCommand = SubCommand { prepSubCmd :: SubCommand -> AnnexState -> [String] -> IO [Annex Bool] prepSubCmd SubCommand { subcmdseek = seek } state params = do list <- Annex.eval state $ seek params - return $ map (\a -> doSubCmd a) list + return $ map doSubCmd list {- Runs a subcommand through the start, perform and cleanup stages -} doSubCmd :: SubCmdStart -> SubCmdCleanup diff --git a/Command/Fsck.hs b/Command/Fsck.hs new file mode 100644 index 0000000000..bd5a9ad7f0 --- /dev/null +++ b/Command/Fsck.hs @@ -0,0 +1,39 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Fsck where + +import Control.Monad.State (liftIO) +import System.Posix.Files +import System.Directory + +import Command +import qualified Annex +import Types +import Utility +import Core + +{- Checks the whole annex for problems. -} +start :: SubCmdStart +start = do + showStart "fsck" "" + return $ Just perform + +perform :: SubCmdPerform +perform = do + ok <- checkUnused + if (ok) + then return $ Just $ return True + else do + showLongNote "Possible problems detected." + return Nothing + +checkUnused :: Annex Bool +checkUnused = do + showNote "checking for unused data..." + -- TODO + return False diff --git a/debian/changelog b/debian/changelog index b433ec62fd..ae68f657b9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,7 @@ git-annex (0.03) UNRELEASED; urgency=low via gitattributes. * In .gitattributes, the git-annex-backend attribute can be set to the names of backends to use when adding different types of files. + * Add fsck subcommand. -- Joey Hess Thu, 28 Oct 2010 13:46:59 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index bbd7e8cab1..856b474e05 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -141,6 +141,11 @@ Many git-annex subcommands will stage changes for later `git commit` by you. git annex setkey --key=1287765018:3 /tmp/file +* fsck + + This subcommand checks the whole annex for consistency, and warns + about any problems found. + # OPTIONS * --force