merge clean into smudge command

The git filter config can be used to map the single git-annex command to
the 2 actions, and this avoids "git annex clean" being used for this thing,
it might have a better use for that name later.

Command/Clean.hs

@@ -1,68 +0,0 @@
-{- git-annex command
- -
- - Copyright 2015 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Command.Clean where
-
-import Common.Annex
-import Command
-import Annex.Content
-import Annex.MetaData
-import Annex.FileMatcher
-import Types.KeySource
-import Types.Key
-import Backend
-import Logs.Location
-
-import qualified Data.ByteString.Lazy as B
-
-cmd :: Command
-cmd = noMessages $ dontCheck repoExists $
-	command "clean" SectionPlumbing 
-		"git clean filter"
-		paramFile (withParams seek)
-
-seek :: CmdParams -> CommandSeek
-seek = withWords start
-
-start :: [String] -> CommandStart
-start [file] = do
-	ifM (shouldAnnex file)
-		( do
-			k <- ingest file
-			liftIO $ putStrLn (key2file k)
-		, liftIO $ B.hGetContents stdin >>= B.hPut stdout -- cat file
-		)
-	stop
-start [] = error "clean filter run without filename; upgrade git"
-start _ = error "clean filter passed multiple filenames"
-
-shouldAnnex :: FilePath -> Annex Bool
-shouldAnnex file = do
-	matcher <- largeFilesMatcher
-	checkFileMatcher matcher file
-
-ingest :: FilePath -> Annex Key
-ingest file = do
-	backend <- chooseBackend file
-	let source = KeySource
-		{ keyFilename = file
-		, contentLocation = file
-		, inodeCache = Nothing
-		}
-	k <- fst . fromMaybe (error "failed to generate a key")
-		<$> genKey source backend
-	-- Hard link (or copy) file content to annex
-	-- to prevent it from being lost when git checks out
-	-- a branch not containing this file.
-	r <- linkAnnex k file
-	case r of
-		LinkAnnexFailed -> error "Problem adding file to the annex"
-		LinkAnnexOk -> logStatus k InfoPresent
-		LinkAnnexNoop -> noop
-	genMetaData k file
-		=<< liftIO (getFileStatus file)
-	return k

Command/Smudge.hs

@@ -10,20 +10,37 @@ module Command.Smudge where
 import Common.Annex
 import Command
 import Types.Key
+import Annex.Content
+import Annex.MetaData
+import Annex.FileMatcher
+import Types.KeySource
+import Backend
+import Logs.Location
 
 import qualified Data.ByteString.Lazy as B
 
 cmd :: Command
-cmd = noCommit $ noMessages $ dontCheck repoExists $
+cmd = noCommit $ noMessages $
 	command "smudge" SectionPlumbing 
 		"git smudge filter"
-		paramFile (withParams seek)
+		paramFile (seek <$$> optParser)
 
-seek :: CmdParams -> CommandSeek
-seek = withWords start
+data SmudgeOptions = SmudgeOptions
+	{ smudgeFile :: FilePath
+	, cleanOption :: Bool
+	}
 
-start :: [String] -> CommandStart
-start [_file] = do
+optParser :: CmdParamsDesc -> Parser SmudgeOptions
+optParser desc = SmudgeOptions
+	<$> argument str ( metavar desc )
+	<*> switch ( long "clean" <> help "clean filter" )
+
+seek :: SmudgeOptions -> CommandSeek
+seek o = commandAction $
+	(if cleanOption o then clean else smudge) (smudgeFile o)
+
+smudge :: FilePath -> CommandStart
+smudge _file = do
 	liftIO $ fileEncoding stdin
 	s <- liftIO $ hGetContents stdin
 	case parsePointer s of
@@ -35,8 +52,46 @@ start [_file] = do
 				(B.hPut stdout)
 				=<< catchMaybeIO (B.readFile content)
 	stop
-start [] = error "smudge filter run without filename; upgrade git"
-start _ = error "smudge filter passed multiple filenames"
+
+clean :: FilePath -> CommandStart
+clean file = do
+	ifM (shouldAnnex file)
+		( do
+			k <- ingest file
+			liftIO $ emitPointer k
+		, liftIO $ B.hGetContents stdin >>= B.hPut stdout -- cat file
+		)
+	stop
+
+shouldAnnex :: FilePath -> Annex Bool
+shouldAnnex file = do
+	matcher <- largeFilesMatcher
+	checkFileMatcher matcher file
+
+ingest :: FilePath -> Annex Key
+ingest file = do
+	backend <- chooseBackend file
+	let source = KeySource
+		{ keyFilename = file
+		, contentLocation = file
+		, inodeCache = Nothing
+		}
+	k <- fst . fromMaybe (error "failed to generate a key")
+		<$> genKey source backend
+	-- Hard link (or copy) file content to annex
+	-- to prevent it from being lost when git checks out
+	-- a branch not containing this file.
+	r <- linkAnnex k file
+	case r of
+		LinkAnnexFailed -> error "Problem adding file to the annex"
+		LinkAnnexOk -> logStatus k InfoPresent
+		LinkAnnexNoop -> noop
+	genMetaData k file
+		=<< liftIO (getFileStatus file)
+	return k
+
+emitPointer :: Key -> IO ()
+emitPointer = putStrLn . key2file
 
 parsePointer :: String -> Maybe Key
 parsePointer s