add fsck subcommand (stub)

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 Control.Monad (filterM, when)
-import Monad (when)
 
 import qualified GitRepo as Git
 import qualified Annex
@@ -33,31 +32,31 @@ import qualified Command.Init
 import qualified Command.Fsck
 
 subCmds :: [SubCommand]
-subCmds =  [
+subCmds =
-	  (SubCommand "add" path	(withFilesNotInGit Command.Add.start)
+	[ SubCommand "add" path	(withFilesNotInGit Command.Add.start)
-		"add files to annex")
+		"add files to annex"
-	, (SubCommand "get" path	(withFilesInGit Command.Get.start)
+	, SubCommand "get" path	(withFilesInGit Command.Get.start)
-		"make content of annexed files available")
+		"make content of annexed files available"
-	, (SubCommand "drop" path	(withFilesInGit Command.Drop.start)
+	, SubCommand "drop" path	(withFilesInGit Command.Drop.start)
-		"indicate content of files not currently wanted")
+		"indicate content of files not currently wanted"
-	, (SubCommand "move" path	(withFilesInGit Command.Move.start)
+	, SubCommand "move" path	(withFilesInGit Command.Move.start)
-		"transfer content of files to/from another repository")
+		"transfer content of files to/from another repository"
-	, (SubCommand "init" desc	(withDescription Command.Init.start)
+	, SubCommand "init" desc	(withDescription Command.Init.start)
-		"initialize git-annex with repository description")
+		"initialize git-annex with repository description"
-	, (SubCommand "unannex" path	(withFilesInGit Command.Unannex.start)
+	, SubCommand "unannex" path	(withFilesInGit Command.Unannex.start)
-		"undo accidential add command")
+		"undo accidential add command"
-	, (SubCommand "pre-commit" path (withFilesToBeCommitted Command.Fix.start)
+	, SubCommand "pre-commit" path (withFilesToBeCommitted Command.Fix.start)
-		"fix up symlinks before they are committed")
+		"fix up symlinks before they are committed"
-	, (SubCommand "fromkey" key	(withFilesMissing Command.FromKey.start)
+	, SubCommand "fromkey" key	(withFilesMissing Command.FromKey.start)
-		"adds a file using a specific key")
+		"adds a file using a specific key"
-	, (SubCommand "dropkey"	key	(withKeys Command.DropKey.start)
+	, SubCommand "dropkey"	key	(withKeys Command.DropKey.start)
-		"drops annexed content for specified keys")
+		"drops annexed content for specified keys"
-	, (SubCommand "setkey" key	(withTempFile Command.SetKey.start)
+	, SubCommand "setkey" key	(withTempFile Command.SetKey.start)
-		"sets annexed content for a key using a temp file")
+		"sets annexed content for a key using a temp file"
-	, (SubCommand "fix" path	(withFilesInGit Command.Fix.start)
+	, SubCommand "fix" path	(withFilesInGit Command.Fix.start)
-		"fix up symlinks to point to annexed content")
+		"fix up symlinks to point to annexed content"
-	, (SubCommand "fsck" nothing	(withNothing Command.Fsck.start)
+	, SubCommand "fsck" nothing	(withNothing Command.Fsck.start)
-		"check annex for problems")
+		"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) ++
+			subcmdname c ++
-			(pad 11 (subcmdname c)) ++
+			pad 11 (subcmdname c) ++
-			(subcmdparams c) ++
+			subcmdparams c ++
-			(pad 13 (subcmdparams c)) ++
+			pad 13 (subcmdparams c) ++
-			(subcmddesc 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
+withDescription a params = return [a $ unwords 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)

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

Command/Fsck.hs

@@ -0,0 +1,39 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - 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

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 <joeyh@debian.org>  Thu, 28 Oct 2010 13:46:59 -0400
 

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