add forget command
Works, more or less. --dead is not implemented, and so far a new branch is made, but keys no longer present anywhere are not scrubbed. git annex sync fails to push the synced/git-annex branch after a forget, because it's not a fast-forward of the existing synced branch. Could be fixed by making git-annex sync use assistant-style sync branches.
This commit is contained in:
parent
fcd5c167ef
commit
4a915cd3cd
5 changed files with 51 additions and 5 deletions
|
@ -402,6 +402,7 @@ handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git.
|
||||||
handleTransitions localts refs = do
|
handleTransitions localts refs = do
|
||||||
m <- M.fromList <$> mapM getreftransition refs
|
m <- M.fromList <$> mapM getreftransition refs
|
||||||
let remotets = M.elems m
|
let remotets = M.elems m
|
||||||
|
liftIO $ print ("transitions", localts, remotets)
|
||||||
if all (localts ==) remotets
|
if all (localts ==) remotets
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else do
|
else do
|
||||||
|
|
41
Command/Forget.hs
Normal file
41
Command/Forget.hs
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
{- git-annex command
|
||||||
|
-
|
||||||
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Command.Forget where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
|
import Command
|
||||||
|
import qualified Annex.Branch as Branch
|
||||||
|
import Logs.Transitions
|
||||||
|
import qualified Annex
|
||||||
|
|
||||||
|
import Data.Time.Clock.POSIX
|
||||||
|
|
||||||
|
def :: [Command]
|
||||||
|
def = [command "forget" paramNothing seek
|
||||||
|
SectionMaintenance "prune git-annex branch history"]
|
||||||
|
|
||||||
|
seek :: [CommandSeek]
|
||||||
|
seek = [withNothing start]
|
||||||
|
|
||||||
|
start :: CommandStart
|
||||||
|
start = do
|
||||||
|
showStart "forget" "git-annex"
|
||||||
|
next $ perform =<< Annex.getState Annex.force
|
||||||
|
|
||||||
|
perform :: Bool -> CommandPerform
|
||||||
|
perform True = do
|
||||||
|
now <- liftIO getPOSIXTime
|
||||||
|
let ts = addTransition now ForgetGitHistory noTransitions
|
||||||
|
recordTransitions Branch.change ts
|
||||||
|
-- get branch committed before contining with the transition
|
||||||
|
Branch.update
|
||||||
|
void $ Branch.performTransitions ts True
|
||||||
|
next $ return True
|
||||||
|
perform False = do
|
||||||
|
showLongNote "To forget git-annex branch history, you must specify --force. This deletes metadata!"
|
||||||
|
stop
|
|
@ -67,6 +67,7 @@ import qualified Command.Map
|
||||||
import qualified Command.Direct
|
import qualified Command.Direct
|
||||||
import qualified Command.Indirect
|
import qualified Command.Indirect
|
||||||
import qualified Command.Upgrade
|
import qualified Command.Upgrade
|
||||||
|
import qualified Command.Forget
|
||||||
import qualified Command.Version
|
import qualified Command.Version
|
||||||
import qualified Command.Help
|
import qualified Command.Help
|
||||||
#ifdef WITH_ASSISTANT
|
#ifdef WITH_ASSISTANT
|
||||||
|
@ -139,6 +140,7 @@ cmds = concat
|
||||||
, Command.Direct.def
|
, Command.Direct.def
|
||||||
, Command.Indirect.def
|
, Command.Indirect.def
|
||||||
, Command.Upgrade.def
|
, Command.Upgrade.def
|
||||||
|
, Command.Forget.def
|
||||||
, Command.Version.def
|
, Command.Version.def
|
||||||
, Command.Help.def
|
, Command.Help.def
|
||||||
#ifdef WITH_ASSISTANT
|
#ifdef WITH_ASSISTANT
|
||||||
|
|
|
@ -50,6 +50,9 @@ describeTransition :: Transition -> String
|
||||||
describeTransition ForgetGitHistory = "forget git history"
|
describeTransition ForgetGitHistory = "forget git history"
|
||||||
describeTransition ForgetDeadRemotes = "forget dead remotes"
|
describeTransition ForgetDeadRemotes = "forget dead remotes"
|
||||||
|
|
||||||
|
noTransitions :: Transitions
|
||||||
|
noTransitions = S.empty
|
||||||
|
|
||||||
addTransition :: POSIXTime -> Transition -> Transitions -> Transitions
|
addTransition :: POSIXTime -> Transition -> Transitions -> Transitions
|
||||||
addTransition ts t = S.insert $ TransitionLine ts t
|
addTransition ts t = S.insert $ TransitionLine ts t
|
||||||
|
|
||||||
|
@ -91,8 +94,7 @@ transitionList = map transition . S.elems
|
||||||
|
|
||||||
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
|
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
|
||||||
- here since it depends on this module. -}
|
- here since it depends on this module. -}
|
||||||
recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition -> Annex ()
|
recordTransitions :: (FilePath -> (String -> String) -> Annex ()) -> Transitions -> Annex ()
|
||||||
recordTransition changer o = do
|
recordTransitions changer t = do
|
||||||
t <- liftIO getPOSIXTime
|
|
||||||
changer transitionsLog $
|
changer transitionsLog $
|
||||||
showTransitions . addTransition t o . parseTransitionsStrictly "local"
|
showTransitions . S.union t . parseTransitionsStrictly "local"
|
||||||
|
|
|
@ -488,7 +488,7 @@ subdirectories).
|
||||||
be located.
|
be located.
|
||||||
|
|
||||||
To also prune references to remotes that have been marked as dead,
|
To also prune references to remotes that have been marked as dead,
|
||||||
specify --forget-dead.
|
specify --dead.
|
||||||
|
|
||||||
When this rewritten branch is merged into other clones of
|
When this rewritten branch is merged into other clones of
|
||||||
the repository, git-annex will automatically perform the same rewriting
|
the repository, git-annex will automatically perform the same rewriting
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue