In .gitattributes, the git-annex-numcopies attribute can be used to control the number of copies to retain of different types of files.
This commit is contained in:
parent
92e5d28ca8
commit
653ad35a9f
14 changed files with 87 additions and 75 deletions
|
@ -15,24 +15,27 @@ import LocationLog
|
|||
import Types
|
||||
import Core
|
||||
import Messages
|
||||
import Utility
|
||||
|
||||
seek :: [SubCmdSeek]
|
||||
seek = [withFilesInGit start]
|
||||
seek = [withAttrFilesInGit "git-annex-numcopies" start]
|
||||
|
||||
{- Indicates a file's content is not wanted anymore, and should be removed
|
||||
- if it's safe to do so. -}
|
||||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, backend) -> do
|
||||
start :: SubCmdStartAttrFile
|
||||
start (file, attr) = isAnnexed file $ \(key, backend) -> do
|
||||
inbackend <- Backend.hasKey key
|
||||
if not inbackend
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "drop" file
|
||||
return $ Just $ perform key backend
|
||||
return $ Just $ perform key backend numcopies
|
||||
where
|
||||
numcopies = readMaybe attr :: Maybe Int
|
||||
|
||||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.removeKey backend key
|
||||
perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
|
||||
perform key backend numcopies = do
|
||||
success <- Backend.removeKey backend key numcopies
|
||||
if success
|
||||
then return $ Just $ cleanup key
|
||||
else return Nothing
|
||||
|
|
|
@ -30,9 +30,7 @@ start s = do
|
|||
Just key -> do
|
||||
showStart "dropunused" s
|
||||
backend <- keyBackend key
|
||||
-- force drop, even if this is the only copy
|
||||
Annex.flagChange "force" $ FlagBool True
|
||||
return $ Just $ Command.Drop.perform key backend
|
||||
return $ Just $ Command.Drop.perform key backend (Just 0)
|
||||
|
||||
readUnusedLog :: Annex (M.Map String Key)
|
||||
readUnusedLog = do
|
||||
|
|
|
@ -11,19 +11,22 @@ import Command
|
|||
import qualified Backend
|
||||
import Types
|
||||
import Messages
|
||||
import Utility
|
||||
|
||||
seek :: [SubCmdSeek]
|
||||
seek = [withAll withFilesInGit start]
|
||||
seek = [withAll (withAttrFilesInGit "git-annex-numcopies") start]
|
||||
|
||||
{- Checks a file's backend data for problems. -}
|
||||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, backend) -> do
|
||||
start :: SubCmdStartAttrFile
|
||||
start (file, attr) = isAnnexed file $ \(key, backend) -> do
|
||||
showStart "fsck" file
|
||||
return $ Just $ perform key backend
|
||||
return $ Just $ perform key backend numcopies
|
||||
where
|
||||
numcopies = readMaybe attr :: Maybe Int
|
||||
|
||||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.fsckKey backend key
|
||||
perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
|
||||
perform key backend numcopies = do
|
||||
success <- Backend.fsckKey backend key numcopies
|
||||
if success
|
||||
then return $ Just $ return True
|
||||
else return Nothing
|
||||
|
|
|
@ -1,29 +0,0 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.FsckFile where
|
||||
|
||||
import Command
|
||||
import qualified Backend
|
||||
import Types
|
||||
import Messages
|
||||
|
||||
seek :: [SubCmdSeek]
|
||||
seek = [withFilesInGit start]
|
||||
|
||||
{- Checks a file's backend data for problems. -}
|
||||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, backend) -> do
|
||||
showStart "fsck" file
|
||||
return $ Just $ perform key backend
|
||||
|
||||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.fsckKey backend key
|
||||
if success
|
||||
then return $ Just $ return True
|
||||
else return Nothing
|
|
@ -32,8 +32,7 @@ start file = isAnnexed file $ \(key, backend) -> do
|
|||
perform :: FilePath -> Key -> Backend -> SubCmdPerform
|
||||
perform file key backend = do
|
||||
-- force backend to always remove
|
||||
Annex.flagChange "force" $ FlagBool True
|
||||
ok <- Backend.removeKey backend key
|
||||
ok <- Backend.removeKey backend key (Just 0)
|
||||
if ok
|
||||
then return $ Just $ cleanup file key
|
||||
else return Nothing
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue