2010-12-03 04:33:41 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
|
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Command.Uninit where
|
|
|
|
|
2011-10-27 19:47:11 +00:00
|
|
|
import qualified Data.ByteString.Lazy.Char8 as B
|
|
|
|
|
2011-10-05 20:02:51 +00:00
|
|
|
import Common.Annex
|
2010-12-03 04:33:41 +00:00
|
|
|
import Command
|
2011-06-30 17:16:57 +00:00
|
|
|
import qualified Git
|
2011-12-14 19:56:11 +00:00
|
|
|
import qualified Git.Command
|
2010-12-03 04:33:41 +00:00
|
|
|
import qualified Annex
|
|
|
|
import qualified Command.Unannex
|
2011-08-17 18:14:43 +00:00
|
|
|
import Init
|
2011-10-04 04:40:47 +00:00
|
|
|
import qualified Annex.Branch
|
|
|
|
import Annex.Content
|
2010-12-03 04:33:41 +00:00
|
|
|
|
2011-10-29 19:19:05 +00:00
|
|
|
def :: [Command]
|
|
|
|
def = [addCheck check $ command "uninit" paramPaths seek
|
2010-12-30 19:06:26 +00:00
|
|
|
"de-initialize git-annex and clean out repository"]
|
|
|
|
|
2011-10-27 20:31:35 +00:00
|
|
|
check :: Annex ()
|
|
|
|
check = do
|
2011-10-27 19:47:11 +00:00
|
|
|
b <- current_branch
|
|
|
|
when (b == Annex.Branch.name) $ error $
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
"cannot uninit when the " ++ show b ++ " branch is checked out"
|
2011-10-27 19:47:11 +00:00
|
|
|
where
|
2011-12-15 22:11:42 +00:00
|
|
|
current_branch = Git.Ref . Prelude.head . lines . B.unpack <$> revhead
|
2011-12-14 19:56:11 +00:00
|
|
|
revhead = inRepo $ Git.Command.pipeRead
|
2011-11-08 19:34:10 +00:00
|
|
|
[Params "rev-parse --abbrev-ref HEAD"]
|
2011-07-04 20:19:04 +00:00
|
|
|
|
2011-10-27 20:31:35 +00:00
|
|
|
seek :: [CommandSeek]
|
2011-11-11 03:35:08 +00:00
|
|
|
seek = [withFilesInGit $ whenAnnexed startUnannex, withNothing start]
|
2011-10-27 20:31:35 +00:00
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
startUnannex :: FilePath -> (Key, Backend) -> CommandStart
|
2011-11-11 03:35:08 +00:00
|
|
|
startUnannex file info = do
|
2011-07-04 20:19:04 +00:00
|
|
|
-- Force fast mode before running unannex. This way, if multiple
|
|
|
|
-- files link to a key, it will be left in the annex and hardlinked
|
|
|
|
-- to by each.
|
|
|
|
Annex.changeState $ \s -> s { Annex.fast = True }
|
2011-11-11 03:35:08 +00:00
|
|
|
Command.Unannex.start file info
|
2010-12-03 04:33:41 +00:00
|
|
|
|
2011-09-15 20:50:49 +00:00
|
|
|
start :: CommandStart
|
2011-07-04 19:50:30 +00:00
|
|
|
start = next perform
|
2010-12-03 04:33:41 +00:00
|
|
|
|
2010-12-30 18:19:16 +00:00
|
|
|
perform :: CommandPerform
|
2011-07-04 19:50:30 +00:00
|
|
|
perform = next cleanup
|
|
|
|
|
|
|
|
cleanup :: CommandCleanup
|
|
|
|
cleanup = do
|
2011-11-11 05:52:58 +00:00
|
|
|
annexdir <- fromRepo gitAnnexDir
|
2011-08-17 18:14:43 +00:00
|
|
|
uninitialize
|
2011-07-04 20:19:04 +00:00
|
|
|
mapM_ removeAnnex =<< getKeysPresent
|
2011-11-08 19:34:10 +00:00
|
|
|
liftIO $ removeDirectoryRecursive annexdir
|
2011-07-04 20:19:04 +00:00
|
|
|
-- avoid normal shutdown
|
2011-07-04 19:50:30 +00:00
|
|
|
saveState
|
2011-12-14 19:56:11 +00:00
|
|
|
inRepo $ Git.Command.run "branch"
|
|
|
|
[Param "-D", Param $ show Annex.Branch.name]
|
2011-11-11 05:52:58 +00:00
|
|
|
liftIO exitSuccess
|