uninit: Support --json and --json-error-messages
Had to convert uninit to do everything that can error out inside a CommandStart. This was harder than feels nice. (Also, in passing, converted CommandCheck to use a data type, not a weird number that it was not clear how it managed to be unique.) Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
Joey Hess
parent
1904cebbb3
commit
271f3b1ab4
7 changed files with 128 additions and 77 deletions
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -11,6 +11,7 @@ import Command
|
|||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import qualified Git.Ref
|
||||
import qualified Git.Branch
|
||||
import qualified Command.Unannex
|
||||
import qualified Annex.Branch
|
||||
import qualified Annex.Queue
|
||||
|
|
@ -23,23 +24,60 @@ import Utility.FileMode
|
|||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import System.PosixCompat.Files (linkCount)
|
||||
import Control.Concurrent.STM
|
||||
|
||||
cmd :: Command
|
||||
cmd = addCheck check $
|
||||
cmd = withAnnexOptions [jsonOptions] $
|
||||
command "uninit" SectionUtility
|
||||
"de-initialize git-annex and clean out repository"
|
||||
paramNothing (withParams seek)
|
||||
|
||||
check :: Annex ()
|
||||
check = do
|
||||
b <- current_branch
|
||||
when (b == Just Annex.Branch.name) $ giveup $
|
||||
"cannot uninit when the " ++ Git.fromRef Annex.Branch.name ++ " branch is checked out"
|
||||
top <- fromRepo Git.repoPath
|
||||
currdir <- liftIO R.getCurrentDirectory
|
||||
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
|
||||
giveup "can only run uninit from the top of the git repository"
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withNothing $ do
|
||||
ok <- liftIO $ newTVarIO False
|
||||
let checkok v a = do
|
||||
liftIO $ atomically $ writeTVar ok v
|
||||
() <- a
|
||||
liftIO $ atomically $ readTVar ok
|
||||
let recordok = do
|
||||
liftIO $ atomically $ writeTVar ok True
|
||||
return True
|
||||
let recordnotok = liftIO $ atomically $ writeTVar ok False
|
||||
|
||||
whenM (checkok False $ commandAction $ checkCanUninit recordok) $ do
|
||||
let symlinksok = checkok True $ withFilesNotInGit
|
||||
(CheckGitIgnore False)
|
||||
(WarnUnmatchWorkTreeItems "uninit")
|
||||
(checksymlinks recordnotok)
|
||||
=<< workTreeItems ww []
|
||||
whenM symlinksok $ do
|
||||
withFilesInGitAnnex ww (Command.Unannex.seeker True)
|
||||
=<< workTreeItems ww []
|
||||
whenM (checkok False $ commandAction $ removeAnnexDir recordok) $
|
||||
whenM (checkok False $ commandAction $ completeUnitialize recordok) $
|
||||
liftIO exitSuccess
|
||||
where
|
||||
ww = WarnUnmatchLsFiles "uninit"
|
||||
checksymlinks recordnotok (_, f) =
|
||||
commandAction $ lookupKey f >>= \case
|
||||
Nothing -> stop
|
||||
Just k -> startCheckIncomplete recordnotok f k
|
||||
|
||||
checkCanUninit :: CommandCleanup -> CommandStart
|
||||
checkCanUninit recordok =
|
||||
starting "uninit check" (ActionItemOther Nothing) (SeekInput []) $ do
|
||||
runchecks
|
||||
next recordok
|
||||
where
|
||||
runchecks = do
|
||||
b <- current_branch
|
||||
when (b == Just Annex.Branch.name) $ giveup $
|
||||
"cannot uninit when the " ++ Git.fromRef Annex.Branch.name ++ " branch is checked out"
|
||||
top <- fromRepo Git.repoPath
|
||||
currdir <- liftIO R.getCurrentDirectory
|
||||
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
|
||||
giveup "can only run uninit from the top of the git repository"
|
||||
|
||||
current_branch =
|
||||
ifM (inRepo Git.Ref.headExists)
|
||||
( Just . Git.Ref . encodeBS . Prelude.head . lines . decodeBS <$> revhead
|
||||
|
|
@ -48,65 +86,49 @@ check = do
|
|||
revhead = inRepo $ Git.Command.pipeReadStrict
|
||||
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withNothing $ do
|
||||
withFilesNotInGit
|
||||
(CheckGitIgnore False)
|
||||
(WarnUnmatchWorkTreeItems "uninit")
|
||||
checksymlinks
|
||||
=<< workTreeItems ww []
|
||||
withFilesInGitAnnex ww (Command.Unannex.seeker True)
|
||||
=<< workTreeItems ww []
|
||||
finish
|
||||
where
|
||||
ww = WarnUnmatchLsFiles "uninit"
|
||||
checksymlinks (_, f) =
|
||||
commandAction $ lookupKey f >>= \case
|
||||
Nothing -> stop
|
||||
Just k -> startCheckIncomplete (fromRawFilePath f) k
|
||||
|
||||
{- git annex symlinks that are not checked into git could be left by an
|
||||
- interrupted add. -}
|
||||
startCheckIncomplete :: FilePath -> Key -> CommandStart
|
||||
startCheckIncomplete file _ = giveup $ unlines
|
||||
[ file ++ " points to annexed content, but is not checked into git."
|
||||
, "Perhaps this was left behind by an interrupted git annex add?"
|
||||
, "Not continuing with uninit; either delete or git annex add the file and retry."
|
||||
]
|
||||
startCheckIncomplete :: Annex () -> RawFilePath -> Key -> CommandStart
|
||||
startCheckIncomplete recordnotok file key =
|
||||
starting "uninit check" (mkActionItem (file, key)) (SeekInput []) $ do
|
||||
recordnotok
|
||||
giveup $ unlines err
|
||||
where
|
||||
err =
|
||||
[ fromRawFilePath file ++ " points to annexed content, but is not checked into git."
|
||||
, "Perhaps this was left behind by an interrupted git annex add?"
|
||||
, "Not continuing with uninit; either delete or git annex add the file and retry."
|
||||
]
|
||||
|
||||
finish :: Annex ()
|
||||
finish = do
|
||||
removeAnnexDir :: CommandCleanup -> CommandStart
|
||||
removeAnnexDir recordok = do
|
||||
Annex.Queue.flush
|
||||
annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir
|
||||
annexobjectdir <- fromRepo gitAnnexObjectDir
|
||||
leftovers <- removeUnannexed =<< listKeys InAnnex
|
||||
prepareRemoveAnnexDir annexdir
|
||||
if null leftovers
|
||||
then liftIO $ removeDirectoryRecursive annexdir
|
||||
else giveup $ unlines
|
||||
[ "Not fully uninitialized"
|
||||
, "Some annexed data is still left in " ++ fromRawFilePath annexobjectdir
|
||||
, "This may include deleted files, or old versions of modified files."
|
||||
, ""
|
||||
, "If you don't care about preserving the data, just delete the"
|
||||
, "directory."
|
||||
, ""
|
||||
, "Or, you can move it to another location, in case it turns out"
|
||||
, "something in there is important."
|
||||
, ""
|
||||
, "Or, you can run `git annex unused` followed by `git annex dropunused`"
|
||||
, "to remove data that is not used by any tag or branch, which might"
|
||||
, "take care of all the data."
|
||||
, ""
|
||||
, "Then run `git annex uninit` again to finish."
|
||||
]
|
||||
uninitialize
|
||||
-- avoid normal shutdown
|
||||
saveState False
|
||||
whenM (inRepo $ Git.Ref.exists Annex.Branch.fullname) $
|
||||
inRepo $ Git.Command.run
|
||||
[Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name]
|
||||
liftIO exitSuccess
|
||||
starting ("uninit objects") (ActionItemOther (Just (QuotedPath annexobjectdir))) (SeekInput []) $ do
|
||||
leftovers <- removeUnannexed =<< listKeys InAnnex
|
||||
prepareRemoveAnnexDir annexdir
|
||||
if null leftovers
|
||||
then do
|
||||
liftIO $ removeDirectoryRecursive annexdir
|
||||
next recordok
|
||||
else giveup $ unlines
|
||||
[ "Not fully uninitialized"
|
||||
, "Some annexed data is still left in " ++ fromRawFilePath annexobjectdir
|
||||
, "This may include deleted files, or old versions of modified files."
|
||||
, ""
|
||||
, "If you don't care about preserving the data, just delete the"
|
||||
, "directory."
|
||||
, ""
|
||||
, "Or, you can move it to another location, in case it turns out"
|
||||
, "something in there is important."
|
||||
, ""
|
||||
, "Or, you can run `git annex unused` followed by `git annex dropunused`"
|
||||
, "to remove data that is not used by any tag or branch, which might"
|
||||
, "take care of all the data."
|
||||
, ""
|
||||
, "Then run `git annex uninit` again to finish."
|
||||
]
|
||||
|
||||
{- Turn on write bits in all remaining files in the annex directory, in
|
||||
- preparation for removal.
|
||||
|
|
@ -140,3 +162,17 @@ removeUnannexed = go []
|
|||
enoughlinks f = catchBoolIO $ do
|
||||
s <- R.getFileStatus f
|
||||
return $ linkCount s > 1
|
||||
|
||||
completeUnitialize :: CommandCleanup -> CommandStart
|
||||
completeUnitialize recordok =
|
||||
starting ("uninit finish") (ActionItemOther Nothing) (SeekInput []) $ do
|
||||
uninitialize
|
||||
removeAnnexBranch
|
||||
next recordok
|
||||
|
||||
removeAnnexBranch :: Annex ()
|
||||
removeAnnexBranch = do
|
||||
-- avoid normal shutdown commit to the branch
|
||||
saveState False
|
||||
whenM (inRepo $ Git.Ref.exists Annex.Branch.fullname) $
|
||||
inRepo $ Git.Branch.delete Annex.Branch.name
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue