summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-04 15:30:06 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-04 15:32:47 -0400
commitde1b6019bb6fc1225a2a02cabba8bc3cf193744b (patch)
tree3780c56e7ca43e1f13e928efe8f65a9c11f90591 /Command
parent0e9dbe79e9a738cb8e3873214ad66b9c0aa0a8a8 (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.hs68
-rw-r--r--Command/Smudge.hs71
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