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:
Joey Hess 2019-11-11 18:20:35 -04:00
parent 3b34d123ed
commit 0be23bae2f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 23 additions and 44 deletions

View file

@ -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)

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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