basic clean filter working
This commit is contained in:
parent
20ca89dfa3
commit
2c6454a2e2
2 changed files with 54 additions and 3 deletions
|
@ -24,6 +24,7 @@ module Annex.Content (
|
|||
withTmp,
|
||||
checkDiskSpace,
|
||||
moveAnnex,
|
||||
linkAnnex,
|
||||
sendAnnex,
|
||||
prepSendAnnex,
|
||||
removeAnnex,
|
||||
|
@ -470,6 +471,23 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
|
|||
|
||||
alreadyhave = liftIO $ removeFile src
|
||||
|
||||
{- Hard links a file into .git/annex/objects/, falling back to a copy
|
||||
- if necessary.
|
||||
-
|
||||
- Does not lock down the hard linked object, so that the user can modify
|
||||
- the source file. So, adding an object to the annex this way can
|
||||
- prevent losing the content if the source file is deleted, but does not
|
||||
- guard against modifications.
|
||||
-}
|
||||
linkAnnex :: Key -> FilePath -> Annex Bool
|
||||
linkAnnex key src = do
|
||||
dest <- calcRepo (gitAnnexLocation key)
|
||||
ifM (liftIO $ doesFileExist dest)
|
||||
( return True
|
||||
, modifyContent dest $
|
||||
liftIO $ createLinkOrCopy src dest
|
||||
)
|
||||
|
||||
{- Runs an action to transfer an object's content.
|
||||
-
|
||||
- In direct mode, it's possible for the file to change as it's being sent.
|
||||
|
|
|
@ -10,8 +10,12 @@ module Command.Clean where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import Annex.Content
|
||||
import Annex.Link
|
||||
import Git.Types
|
||||
import Annex.MetaData
|
||||
import Types.KeySource
|
||||
import Types.Key
|
||||
import Backend
|
||||
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
|
||||
cmd :: Command
|
||||
cmd = dontCheck repoExists $
|
||||
|
@ -24,6 +28,35 @@ seek = withWords start
|
|||
|
||||
start :: [String] -> CommandStart
|
||||
start [file] = do
|
||||
error ("clean " ++ file)
|
||||
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 _ = return True
|
||||
-- TODO check annex.largefiles
|
||||
|
||||
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 contaning this file.
|
||||
unlessM (linkAnnex k file) $
|
||||
error "Problem adding file to the annex"
|
||||
genMetaData k file
|
||||
=<< liftIO (getFileStatus file)
|
||||
return k
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue