diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-12-04 15:30:06 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-12-04 15:32:47 -0400 |
commit | de1b6019bb6fc1225a2a02cabba8bc3cf193744b (patch) | |
tree | 3780c56e7ca43e1f13e928efe8f65a9c11f90591 /Command | |
parent | 0e9dbe79e9a738cb8e3873214ad66b9c0aa0a8a8 (diff) |
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.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Clean.hs | 68 | ||||
-rw-r--r-- | Command/Smudge.hs | 71 |
2 files changed, 63 insertions, 76 deletions
diff --git a/Command/Clean.hs b/Command/Clean.hs deleted file mode 100644 index 15dcdfacb..000000000 --- a/Command/Clean.hs +++ /dev/null @@ -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 diff --git a/Command/Smudge.hs b/Command/Smudge.hs index 6c4b9604a..07a3e1805 100644 --- a/Command/Smudge.hs +++ b/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 |