reorg remaining direct mode code
Only used for upgrading, so put it under there.
This commit is contained in:
parent
e395ba2cb0
commit
9b1331881c
5 changed files with 64 additions and 84 deletions
|
@ -1,68 +0,0 @@
|
|||
{- git-annex direct mode
|
||||
-
|
||||
- This only contains some remnants needed to convert away from direct mode.
|
||||
-
|
||||
- Copyright 2012-2014 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Annex.Direct (
|
||||
switchHEADBack,
|
||||
setIndirect,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import qualified Annex
|
||||
import qualified Git.Config
|
||||
import qualified Git.Ref
|
||||
import qualified Git.Branch
|
||||
import Git.Types
|
||||
import Config
|
||||
|
||||
setIndirect :: Annex ()
|
||||
setIndirect = do
|
||||
setbare
|
||||
switchHEADBack
|
||||
setConfig (annexConfig "direct") val
|
||||
Annex.changeGitConfig $ \c -> c { annexDirect = False }
|
||||
where
|
||||
val = Git.Config.boolConfig False
|
||||
coreworktree = ConfigKey "core.worktree"
|
||||
indirectworktree = ConfigKey "core.indirect-worktree"
|
||||
setbare = do
|
||||
-- core.worktree is not compatable with
|
||||
-- core.bare; git does not allow both to be set, so
|
||||
-- unset it when enabling direct mode, caching in
|
||||
-- core.indirect-worktree
|
||||
moveconfig indirectworktree coreworktree
|
||||
setConfig (ConfigKey Git.Config.coreBare) val
|
||||
moveconfig src dest = getConfigMaybe src >>= \case
|
||||
Nothing -> noop
|
||||
Just wt -> do
|
||||
unsetConfig src
|
||||
setConfig dest wt
|
||||
reloadConfig
|
||||
|
||||
{- Converts a directBranch back to the original branch.
|
||||
-
|
||||
- Any other ref is left unchanged.
|
||||
-}
|
||||
fromDirectBranch :: Ref -> Ref
|
||||
fromDirectBranch directhead = case splitc '/' $ fromRef directhead of
|
||||
("refs":"heads":"annex":"direct":rest) ->
|
||||
Ref $ "refs/heads/" ++ intercalate "/" rest
|
||||
_ -> directhead
|
||||
|
||||
switchHEADBack :: Annex ()
|
||||
switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
|
||||
where
|
||||
switch currhead = do
|
||||
let orighead = fromDirectBranch currhead
|
||||
inRepo (Git.Ref.sha currhead) >>= \case
|
||||
Just headsha
|
||||
| orighead /= currhead -> do
|
||||
inRepo $ Git.Branch.update "leaving direct mode" orighead headsha
|
||||
inRepo $ Git.Branch.checkout orighead
|
||||
inRepo $ Git.Branch.delete currhead
|
||||
_ -> inRepo $ Git.Branch.checkout orighead
|
|
@ -35,7 +35,7 @@ import Annex.WorkTree
|
|||
import Config
|
||||
import Config.Files
|
||||
import Config.Smudge
|
||||
import qualified Annex.Direct as Direct
|
||||
import qualified Upgrade.V5.Direct as Direct
|
||||
import qualified Annex.AdjustedBranch as AdjustedBranch
|
||||
import Annex.Environment
|
||||
import Annex.Hook
|
||||
|
|
|
@ -17,10 +17,9 @@ import Annex.CatFile
|
|||
import Annex.WorkTree
|
||||
import Annex.UUID
|
||||
import Logs.Location
|
||||
import qualified Upgrade.V5.Direct as Direct
|
||||
import qualified Annex.Content as Content
|
||||
import qualified Database.Keys
|
||||
import qualified Annex.Direct as Direct
|
||||
import qualified Annex.Content.Direct as Direct
|
||||
import qualified Git
|
||||
import qualified Git.LsFiles
|
||||
import qualified Git.Branch
|
||||
|
|
|
@ -1,11 +1,15 @@
|
|||
{- git-annex file content managing for old direct mode repositories
|
||||
{- git-annex direct mode
|
||||
-
|
||||
- This only contains some remnants needed to convert away from direct mode.
|
||||
-
|
||||
- Copyright 2012-2014 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Annex.Content.Direct (
|
||||
module Upgrade.V5.Direct (
|
||||
switchHEADBack,
|
||||
setIndirect,
|
||||
goodContent,
|
||||
associatedFiles,
|
||||
removeAssociatedFiles,
|
||||
|
@ -13,16 +17,64 @@ module Annex.Content.Direct (
|
|||
) where
|
||||
|
||||
import Annex.Common
|
||||
import Annex.Perms
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import Logs.Location
|
||||
import Logs.File
|
||||
import qualified Git.Config
|
||||
import qualified Git.Ref
|
||||
import qualified Git.Branch
|
||||
import Git.Types
|
||||
import Config
|
||||
import Annex.Perms
|
||||
import Utility.InodeCache
|
||||
import Utility.CopyFile
|
||||
import Annex.ReplaceFile
|
||||
import Annex.Link
|
||||
import Annex.InodeSentinal
|
||||
|
||||
setIndirect :: Annex ()
|
||||
setIndirect = do
|
||||
setbare
|
||||
switchHEADBack
|
||||
setConfig (annexConfig "direct") val
|
||||
Annex.changeGitConfig $ \c -> c { annexDirect = False }
|
||||
where
|
||||
val = Git.Config.boolConfig False
|
||||
coreworktree = ConfigKey "core.worktree"
|
||||
indirectworktree = ConfigKey "core.indirect-worktree"
|
||||
setbare = do
|
||||
-- core.worktree is not compatable with
|
||||
-- core.bare; git does not allow both to be set, so
|
||||
-- unset it when enabling direct mode, caching in
|
||||
-- core.indirect-worktree
|
||||
moveconfig indirectworktree coreworktree
|
||||
setConfig (ConfigKey Git.Config.coreBare) val
|
||||
moveconfig src dest = getConfigMaybe src >>= \case
|
||||
Nothing -> noop
|
||||
Just wt -> do
|
||||
unsetConfig src
|
||||
setConfig dest wt
|
||||
reloadConfig
|
||||
|
||||
{- Converts a directBranch back to the original branch.
|
||||
-
|
||||
- Any other ref is left unchanged.
|
||||
-}
|
||||
fromDirectBranch :: Ref -> Ref
|
||||
fromDirectBranch directhead = case splitc '/' $ fromRef directhead of
|
||||
("refs":"heads":"annex":"direct":rest) ->
|
||||
Ref $ "refs/heads/" ++ intercalate "/" rest
|
||||
_ -> directhead
|
||||
|
||||
switchHEADBack :: Annex ()
|
||||
switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
|
||||
where
|
||||
switch currhead = do
|
||||
let orighead = fromDirectBranch currhead
|
||||
inRepo (Git.Ref.sha currhead) >>= \case
|
||||
Just headsha
|
||||
| orighead /= currhead -> do
|
||||
inRepo $ Git.Branch.update "leaving direct mode" orighead headsha
|
||||
inRepo $ Git.Branch.checkout orighead
|
||||
inRepo $ Git.Branch.delete currhead
|
||||
_ -> inRepo $ Git.Branch.checkout orighead
|
||||
|
||||
{- Absolute FilePaths of Files in the tree that are associated with a key. -}
|
||||
associatedFiles :: Key -> Annex [FilePath]
|
||||
associatedFiles key = do
|
||||
|
@ -36,9 +88,7 @@ associatedFilesRelative :: Key -> Annex [FilePath]
|
|||
associatedFilesRelative key = do
|
||||
mapping <- calcRepo $ gitAnnexMapping key
|
||||
liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h ->
|
||||
-- Read strictly to ensure the file is closed
|
||||
-- before changeAssociatedFiles tries to write to it.
|
||||
-- (Especially needed on Windows.)
|
||||
-- Read strictly to ensure the file is closed promptly
|
||||
lines <$> hGetContentsStrict h
|
||||
|
||||
{- Removes the list of associated files. -}
|
|
@ -618,13 +618,11 @@ Executable git-annex
|
|||
Annex.Common
|
||||
Annex.Concurrent
|
||||
Annex.Content
|
||||
Annex.Content.Direct
|
||||
Annex.Content.LowLevel
|
||||
Annex.Content.PointerFile
|
||||
Annex.CurrentBranch
|
||||
Annex.Difference
|
||||
Annex.DirHashes
|
||||
Annex.Direct
|
||||
Annex.Drop
|
||||
Annex.Environment
|
||||
Annex.Export
|
||||
|
@ -1011,6 +1009,7 @@ Executable git-annex
|
|||
Upgrade.V3
|
||||
Upgrade.V4
|
||||
Upgrade.V5
|
||||
Upgrade.V5.Direct
|
||||
Upgrade.V6
|
||||
Utility.Aeson
|
||||
Utility.Android
|
||||
|
|
Loading…
Reference in a new issue