refactor
Better to not have a single function module, and better to have a more specific type than Bool. This commit was sponsored by Jack Hill on Patreon
This commit is contained in:
parent
3b34d123ed
commit
0be23bae2f
11 changed files with 23 additions and 44 deletions
|
@ -59,7 +59,6 @@ import Utility.Tmp.Dir
|
||||||
import Utility.CopyFile
|
import Utility.CopyFile
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
import Config
|
import Config
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
@ -226,7 +225,7 @@ adjustToCrippledFileSystem = do
|
||||||
warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."
|
warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."
|
||||||
checkVersionSupported
|
checkVersionSupported
|
||||||
whenM (isNothing <$> inRepo Git.Branch.current) $ do
|
whenM (isNothing <$> inRepo Git.Branch.current) $ do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
void $ inRepo $ Git.Branch.commitCommand cmode
|
void $ inRepo $ Git.Branch.commitCommand cmode
|
||||||
[ Param "--quiet"
|
[ Param "--quiet"
|
||||||
, Param "--allow-empty"
|
, Param "--allow-empty"
|
||||||
|
@ -313,10 +312,10 @@ commitAdjustedTree' treesha (BasisBranch basis) parents =
|
||||||
go =<< catCommit basis
|
go =<< catCommit basis
|
||||||
where
|
where
|
||||||
go Nothing = do
|
go Nothing = do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
inRepo $ mkcommit cmode
|
inRepo $ mkcommit cmode
|
||||||
go (Just basiscommit) = do
|
go (Just basiscommit) = do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
inRepo $ commitWithMetaData
|
inRepo $ commitWithMetaData
|
||||||
(commitAuthorMetaData basiscommit)
|
(commitAuthorMetaData basiscommit)
|
||||||
(commitCommitterMetaData basiscommit)
|
(commitCommitterMetaData basiscommit)
|
||||||
|
@ -450,7 +449,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
|
||||||
reparent adjtree adjmergecommit (Just currentcommit) = do
|
reparent adjtree adjmergecommit (Just currentcommit) = do
|
||||||
if (commitTree currentcommit /= adjtree)
|
if (commitTree currentcommit /= adjtree)
|
||||||
then do
|
then do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
c <- inRepo $ Git.Branch.commitTree cmode
|
c <- inRepo $ Git.Branch.commitTree cmode
|
||||||
("Merged " ++ fromRef tomerge) [adjmergecommit]
|
("Merged " ++ fromRef tomerge) [adjmergecommit]
|
||||||
(commitTree currentcommit)
|
(commitTree currentcommit)
|
||||||
|
@ -541,7 +540,7 @@ reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
|
||||||
| length (commitParent basiscommit) > 1 = return $
|
| length (commitParent basiscommit) > 1 = return $
|
||||||
Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
|
Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
treesha <- reverseAdjustedTree commitparent adj csha
|
treesha <- reverseAdjustedTree commitparent adj csha
|
||||||
revadjcommit <- inRepo $ commitWithMetaData
|
revadjcommit <- inRepo $ commitWithMetaData
|
||||||
(commitAuthorMetaData basiscommit)
|
(commitAuthorMetaData basiscommit)
|
||||||
|
|
|
@ -70,7 +70,6 @@ import Annex.Branch.Transitions
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Annex.Hook
|
import Annex.Hook
|
||||||
import Utility.Directory.Stream
|
import Utility.Directory.Stream
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
{- Name of the branch that is used to store git-annex's information. -}
|
{- Name of the branch that is used to store git-annex's information. -}
|
||||||
name :: Git.Ref
|
name :: Git.Ref
|
||||||
|
@ -111,7 +110,7 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
|
||||||
fromMaybe (error $ "failed to create " ++ fromRef name)
|
fromMaybe (error $ "failed to create " ++ fromRef name)
|
||||||
<$> branchsha
|
<$> branchsha
|
||||||
go False = withIndex' True $ do
|
go False = withIndex' True $ do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
inRepo $ Git.Branch.commitAlways cmode "branch created" fullname []
|
inRepo $ Git.Branch.commitAlways cmode "branch created" fullname []
|
||||||
use sha = do
|
use sha = do
|
||||||
setIndexSha sha
|
setIndexSha sha
|
||||||
|
@ -319,7 +318,7 @@ commitIndex jl branchref message parents = do
|
||||||
commitIndex' :: JournalLocked -> Git.Ref -> String -> String -> Integer -> [Git.Ref] -> Annex ()
|
commitIndex' :: JournalLocked -> Git.Ref -> String -> String -> Integer -> [Git.Ref] -> Annex ()
|
||||||
commitIndex' jl branchref message basemessage retrynum parents = do
|
commitIndex' jl branchref message basemessage retrynum parents = do
|
||||||
updateIndex jl branchref
|
updateIndex jl branchref
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
committedref <- inRepo $ Git.Branch.commitAlways cmode message fullname parents
|
committedref <- inRepo $ Git.Branch.commitAlways cmode message fullname parents
|
||||||
setIndexSha committedref
|
setIndexSha committedref
|
||||||
parentrefs <- commitparents <$> catObject committedref
|
parentrefs <- commitparents <$> catObject committedref
|
||||||
|
@ -554,7 +553,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
|
||||||
Annex.Queue.flush
|
Annex.Queue.flush
|
||||||
if neednewlocalbranch
|
if neednewlocalbranch
|
||||||
then do
|
then do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
committedref <- inRepo $ Git.Branch.commitAlways cmode message fullname transitionedrefs
|
committedref <- inRepo $ Git.Branch.commitAlways cmode message fullname transitionedrefs
|
||||||
setIndexSha committedref
|
setIndexSha committedref
|
||||||
else do
|
else do
|
||||||
|
@ -661,7 +660,7 @@ rememberTreeish treeish graftpoint = lockJournal $ \jl -> do
|
||||||
origtree <- fromMaybe (giveup "unable to determine git-annex branch tree") <$>
|
origtree <- fromMaybe (giveup "unable to determine git-annex branch tree") <$>
|
||||||
inRepo (Git.Ref.tree branchref)
|
inRepo (Git.Ref.tree branchref)
|
||||||
addedt <- inRepo $ Git.Tree.graftTree treeish graftpoint origtree
|
addedt <- inRepo $ Git.Tree.graftTree treeish graftpoint origtree
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
c <- inRepo $ Git.Branch.commitTree cmode
|
c <- inRepo $ Git.Branch.commitTree cmode
|
||||||
"graft" [branchref] addedt
|
"graft" [branchref] addedt
|
||||||
c' <- inRepo $ Git.Branch.commitTree cmode
|
c' <- inRepo $ Git.Branch.commitTree cmode
|
||||||
|
|
|
@ -17,12 +17,12 @@ module Annex.RemoteTrackingBranch
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
|
import qualified Annex
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import qualified Git.Ref
|
import qualified Git.Ref
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
import Git.History
|
import Git.History
|
||||||
import qualified Types.Remote as Remote
|
import qualified Types.Remote as Remote
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
|
@ -74,7 +74,7 @@ makeRemoteTrackingBranchMergeCommit tb commitsha =
|
||||||
|
|
||||||
makeRemoteTrackingBranchMergeCommit' :: Sha -> Sha -> Sha -> Annex Sha
|
makeRemoteTrackingBranchMergeCommit' :: Sha -> Sha -> Sha -> Annex Sha
|
||||||
makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = do
|
makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
inRepo $ Git.Branch.commitTree
|
inRepo $ Git.Branch.commitTree
|
||||||
cmode
|
cmode
|
||||||
"remote tracking branch"
|
"remote tracking branch"
|
||||||
|
|
|
@ -12,6 +12,7 @@ import Annex.View.ViewedFile
|
||||||
import Types.View
|
import Types.View
|
||||||
import Types.MetaData
|
import Types.MetaData
|
||||||
import Annex.MetaData
|
import Annex.MetaData
|
||||||
|
import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.DiffTree as DiffTree
|
import qualified Git.DiffTree as DiffTree
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
|
@ -30,7 +31,6 @@ import Logs.View
|
||||||
import Utility.Glob
|
import Utility.Glob
|
||||||
import Types.Command
|
import Types.Command
|
||||||
import CmdLine.Action
|
import CmdLine.Action
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
@ -419,7 +419,7 @@ withViewIndex a = do
|
||||||
genViewBranch :: View -> Annex Git.Branch
|
genViewBranch :: View -> Annex Git.Branch
|
||||||
genViewBranch view = withViewIndex $ do
|
genViewBranch view = withViewIndex $ do
|
||||||
let branch = branchView view
|
let branch = branchView view
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
void $ inRepo $ Git.Branch.commit cmode True (fromRef branch) branch []
|
void $ inRepo $ Git.Branch.commit cmode True (fromRef branch) branch []
|
||||||
return branch
|
return branch
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,6 @@ import Logs.PreferredContent
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import Utility.Process.Transcript
|
import Utility.Process.Transcript
|
||||||
import Config
|
import Config
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
{- Makes a new git repository. Or, if a git repository already
|
{- Makes a new git repository. Or, if a git repository already
|
||||||
- exists, returns False. -}
|
- exists, returns False. -}
|
||||||
|
@ -55,7 +54,7 @@ initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
|
||||||
{- Initialize the master branch, so things that expect
|
{- Initialize the master branch, so things that expect
|
||||||
- to have it will work, before any files are added. -}
|
- to have it will work, before any files are added. -}
|
||||||
unlessM (Git.Config.isBare <$> gitRepo) $ do
|
unlessM (Git.Config.isBare <$> gitRepo) $ do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
void $ inRepo $ Git.Branch.commitCommand cmode
|
void $ inRepo $ Git.Branch.commitCommand cmode
|
||||||
[ Param "--quiet"
|
[ Param "--quiet"
|
||||||
, Param "--allow-empty"
|
, Param "--allow-empty"
|
||||||
|
|
|
@ -38,7 +38,6 @@ import qualified Database.Keys
|
||||||
import qualified Command.Sync
|
import qualified Command.Sync
|
||||||
import Utility.Tuple
|
import Utility.Tuple
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
@ -231,7 +230,7 @@ commitStaged msg = do
|
||||||
case v of
|
case v of
|
||||||
Left _ -> return False
|
Left _ -> return False
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
ok <- Command.Sync.commitStaged cmode msg
|
ok <- Command.Sync.commitStaged cmode msg
|
||||||
when ok $
|
when ok $
|
||||||
Command.Sync.updateBranches =<< getCurrentBranch
|
Command.Sync.updateBranches =<< getCurrentBranch
|
||||||
|
|
|
@ -14,12 +14,12 @@ import Assistant.Sync
|
||||||
import Utility.DirWatcher
|
import Utility.DirWatcher
|
||||||
import Utility.DirWatcher.Types
|
import Utility.DirWatcher.Types
|
||||||
import Annex.CurrentBranch
|
import Annex.CurrentBranch
|
||||||
|
import qualified Annex
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
import qualified Git.Ref
|
import qualified Git.Ref
|
||||||
import qualified Command.Sync
|
import qualified Command.Sync
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
{- This thread watches for changes to .git/refs/, and handles incoming
|
{- This thread watches for changes to .git/refs/, and handles incoming
|
||||||
- pushes. -}
|
- pushes. -}
|
||||||
|
@ -82,7 +82,7 @@ onChange file
|
||||||
, "into", Git.fromRef b
|
, "into", Git.fromRef b
|
||||||
]
|
]
|
||||||
void $ liftAnnex $ do
|
void $ liftAnnex $ do
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
Command.Sync.merge
|
Command.Sync.merge
|
||||||
currbranch Command.Sync.mergeConfig
|
currbranch Command.Sync.mergeConfig
|
||||||
def
|
def
|
||||||
|
|
|
@ -32,7 +32,6 @@ import Git.FilePath
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Types.Import
|
import Types.Import
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Config.CommitMode
|
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
@ -266,7 +265,7 @@ seekRemote remote branch msubdir = do
|
||||||
Nothing -> giveup $ "Unable to find base tree for branch " ++ fromRef branch
|
Nothing -> giveup $ "Unable to find base tree for branch " ++ fromRef branch
|
||||||
|
|
||||||
trackingcommit <- fromtrackingbranch Git.Ref.sha
|
trackingcommit <- fromtrackingbranch Git.Ref.sha
|
||||||
cmode <- implicitCommitMode
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||||
let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessage
|
let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessage
|
||||||
let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
|
let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
|
||||||
|
|
||||||
|
|
|
@ -1,18 +0,0 @@
|
||||||
{- git-annex configuration
|
|
||||||
-
|
|
||||||
- Copyright 2019 Joey Hess <id@joeyh.name>
|
|
||||||
-
|
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
|
||||||
-}
|
|
||||||
|
|
||||||
module Config.CommitMode where
|
|
||||||
|
|
||||||
import Annex.Common
|
|
||||||
import qualified Annex
|
|
||||||
import Git.Branch (CommitMode(..))
|
|
||||||
|
|
||||||
implicitCommitMode :: Annex CommitMode
|
|
||||||
implicitCommitMode = go . annexAllowSign <$> Annex.getGitConfig
|
|
||||||
where
|
|
||||||
go True = ManualCommit
|
|
||||||
go False = AutomaticCommit
|
|
|
@ -21,6 +21,7 @@ import qualified Git.Config
|
||||||
import qualified Git.Construct
|
import qualified Git.Construct
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Git.ConfigTypes
|
import Git.ConfigTypes
|
||||||
|
import Git.Branch (CommitMode(..))
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Types.UUID
|
import Types.UUID
|
||||||
|
@ -105,7 +106,7 @@ data GitConfig = GitConfig
|
||||||
, annexJobs :: Concurrency
|
, annexJobs :: Concurrency
|
||||||
, annexCacheCreds :: Bool
|
, annexCacheCreds :: Bool
|
||||||
, annexAutoUpgradeRepository :: Bool
|
, annexAutoUpgradeRepository :: Bool
|
||||||
, annexAllowSign :: Bool
|
, annexCommitMode :: CommitMode
|
||||||
, coreSymlinks :: Bool
|
, coreSymlinks :: Bool
|
||||||
, coreSharedRepository :: SharedRepository
|
, coreSharedRepository :: SharedRepository
|
||||||
, receiveDenyCurrentBranch :: DenyCurrentBranch
|
, receiveDenyCurrentBranch :: DenyCurrentBranch
|
||||||
|
@ -187,7 +188,9 @@ extractGitConfig r = GitConfig
|
||||||
parseConcurrency =<< getmaybe (annex "jobs")
|
parseConcurrency =<< getmaybe (annex "jobs")
|
||||||
, annexCacheCreds = getbool (annex "cachecreds") True
|
, annexCacheCreds = getbool (annex "cachecreds") True
|
||||||
, annexAutoUpgradeRepository = getbool (annex "autoupgraderepository") True
|
, annexAutoUpgradeRepository = getbool (annex "autoupgraderepository") True
|
||||||
, annexAllowSign = getbool (annex "allowsign") False
|
, annexCommitMode = if getbool (annex "allowsign") False
|
||||||
|
then ManualCommit
|
||||||
|
else AutomaticCommit
|
||||||
, coreSymlinks = getbool "core.symlinks" True
|
, coreSymlinks = getbool "core.symlinks" True
|
||||||
, coreSharedRepository = getSharedRepository r
|
, coreSharedRepository = getSharedRepository r
|
||||||
, receiveDenyCurrentBranch = getDenyCurrentBranch r
|
, receiveDenyCurrentBranch = getDenyCurrentBranch r
|
||||||
|
|
|
@ -806,7 +806,6 @@ Executable git-annex
|
||||||
Command.Whereis
|
Command.Whereis
|
||||||
Common
|
Common
|
||||||
Config
|
Config
|
||||||
Config.CommitMode
|
|
||||||
Config.Cost
|
Config.Cost
|
||||||
Config.Files
|
Config.Files
|
||||||
Config.DynamicConfig
|
Config.DynamicConfig
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue