final readonly values moves to AnnexRead
At this point I've checked all AnnexState values and these were all that remained that could move. Pity that Annex.repo can't move, but it gets modified sometimes.. A couple of AnnexState values are set by options and could be AnnexRead, but happen to use Annex when being set. Sponsored-by: Max Thoursie on Patreon
This commit is contained in:
parent
6984bcdba9
commit
8040ecf9b8
4 changed files with 12 additions and 11 deletions
8
Annex.hs
8
Annex.hs
|
@ -126,6 +126,8 @@ data AnnexRead = AnnexRead
|
||||||
, forcenumcopies :: Maybe NumCopies
|
, forcenumcopies :: Maybe NumCopies
|
||||||
, forcemincopies :: Maybe MinCopies
|
, forcemincopies :: Maybe MinCopies
|
||||||
, forcebackend :: Maybe String
|
, forcebackend :: Maybe String
|
||||||
|
, useragent :: Maybe String
|
||||||
|
, desktopnotify :: DesktopNotify
|
||||||
}
|
}
|
||||||
|
|
||||||
newAnnexRead :: GitConfig -> IO AnnexRead
|
newAnnexRead :: GitConfig -> IO AnnexRead
|
||||||
|
@ -152,6 +154,8 @@ newAnnexRead c = do
|
||||||
, forcebackend = Nothing
|
, forcebackend = Nothing
|
||||||
, forcenumcopies = Nothing
|
, forcenumcopies = Nothing
|
||||||
, forcemincopies = Nothing
|
, forcemincopies = Nothing
|
||||||
|
, useragent = Nothing
|
||||||
|
, desktopnotify = mempty
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Values that can change while running an Annex action.
|
-- Values that can change while running an Annex action.
|
||||||
|
@ -190,14 +194,12 @@ data AnnexState = AnnexState
|
||||||
, fields :: M.Map String String
|
, fields :: M.Map String String
|
||||||
, cleanupactions :: M.Map CleanupAction (Annex ())
|
, cleanupactions :: M.Map CleanupAction (Annex ())
|
||||||
, sentinalstatus :: Maybe SentinalStatus
|
, sentinalstatus :: Maybe SentinalStatus
|
||||||
, useragent :: Maybe String
|
|
||||||
, errcounter :: Integer
|
, errcounter :: Integer
|
||||||
, skippedfiles :: Bool
|
, skippedfiles :: Bool
|
||||||
, adjustedbranchrefreshcounter :: Integer
|
, adjustedbranchrefreshcounter :: Integer
|
||||||
, unusedkeys :: Maybe (S.Set Key)
|
, unusedkeys :: Maybe (S.Set Key)
|
||||||
, tempurls :: M.Map Key URLString
|
, tempurls :: M.Map Key URLString
|
||||||
, existinghooks :: M.Map Git.Hook.Hook Bool
|
, existinghooks :: M.Map Git.Hook.Hook Bool
|
||||||
, desktopnotify :: DesktopNotify
|
|
||||||
, workers :: Maybe (TMVar (WorkerPool (AnnexState, AnnexRead)))
|
, workers :: Maybe (TMVar (WorkerPool (AnnexState, AnnexRead)))
|
||||||
, cachedcurrentbranch :: (Maybe (Maybe Git.Branch, Maybe Adjustment))
|
, cachedcurrentbranch :: (Maybe (Maybe Git.Branch, Maybe Adjustment))
|
||||||
, cachedgitenv :: Maybe (AltIndexFile, FilePath, [(String, String)])
|
, cachedgitenv :: Maybe (AltIndexFile, FilePath, [(String, String)])
|
||||||
|
@ -245,14 +247,12 @@ newAnnexState c r = do
|
||||||
, fields = M.empty
|
, fields = M.empty
|
||||||
, cleanupactions = M.empty
|
, cleanupactions = M.empty
|
||||||
, sentinalstatus = Nothing
|
, sentinalstatus = Nothing
|
||||||
, useragent = Nothing
|
|
||||||
, errcounter = 0
|
, errcounter = 0
|
||||||
, skippedfiles = False
|
, skippedfiles = False
|
||||||
, adjustedbranchrefreshcounter = 0
|
, adjustedbranchrefreshcounter = 0
|
||||||
, unusedkeys = Nothing
|
, unusedkeys = Nothing
|
||||||
, tempurls = M.empty
|
, tempurls = M.empty
|
||||||
, existinghooks = M.empty
|
, existinghooks = M.empty
|
||||||
, desktopnotify = mempty
|
|
||||||
, workers = Nothing
|
, workers = Nothing
|
||||||
, cachedcurrentbranch = Nothing
|
, cachedcurrentbranch = Nothing
|
||||||
, cachedgitenv = Nothing
|
, cachedgitenv = Nothing
|
||||||
|
|
|
@ -48,7 +48,7 @@ defaultUserAgent :: U.UserAgent
|
||||||
defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion
|
defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion
|
||||||
|
|
||||||
getUserAgent :: Annex U.UserAgent
|
getUserAgent :: Annex U.UserAgent
|
||||||
getUserAgent = Annex.getState $
|
getUserAgent = Annex.getRead $
|
||||||
fromMaybe defaultUserAgent . Annex.useragent
|
fromMaybe defaultUserAgent . Annex.useragent
|
||||||
|
|
||||||
getUrlOptions :: Annex U.UrlOptions
|
getUrlOptions :: Annex U.UrlOptions
|
||||||
|
|
|
@ -78,7 +78,7 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
|
||||||
<> help "override git configuration setting"
|
<> help "override git configuration setting"
|
||||||
<> hidden
|
<> hidden
|
||||||
)
|
)
|
||||||
, globalOption (setAnnexState . setuseragent) $ strOption
|
, globalOption setuseragent $ strOption
|
||||||
( long "user-agent" <> metavar paramName
|
( long "user-agent" <> metavar paramName
|
||||||
<> help "override default User-Agent"
|
<> help "override default User-Agent"
|
||||||
<> hidden
|
<> hidden
|
||||||
|
@ -88,12 +88,12 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
|
||||||
<> help "deprecated, does not trust Amazon Glacier inventory"
|
<> help "deprecated, does not trust Amazon Glacier inventory"
|
||||||
<> hidden
|
<> hidden
|
||||||
)
|
)
|
||||||
, globalFlag (setAnnexState $ setdesktopnotify mkNotifyFinish)
|
, globalFlag (setdesktopnotify mkNotifyFinish)
|
||||||
( long "notify-finish"
|
( long "notify-finish"
|
||||||
<> help "show desktop notification after transfer finishes"
|
<> help "show desktop notification after transfer finishes"
|
||||||
<> hidden
|
<> hidden
|
||||||
)
|
)
|
||||||
, globalFlag (setAnnexState $ setdesktopnotify mkNotifyStart)
|
, globalFlag (setdesktopnotify mkNotifyStart)
|
||||||
( long "notify-start"
|
( long "notify-start"
|
||||||
<> help "show desktop notification after transfer starts"
|
<> help "show desktop notification after transfer starts"
|
||||||
<> hidden
|
<> hidden
|
||||||
|
@ -102,9 +102,9 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
|
||||||
where
|
where
|
||||||
setnumcopies n = setAnnexRead $ \rd -> rd { Annex.forcenumcopies = Just $ configuredNumCopies n }
|
setnumcopies n = setAnnexRead $ \rd -> rd { Annex.forcenumcopies = Just $ configuredNumCopies n }
|
||||||
setmincopies n = setAnnexRead $ \rd -> rd { Annex.forcemincopies = Just $ configuredMinCopies n }
|
setmincopies n = setAnnexRead $ \rd -> rd { Annex.forcemincopies = Just $ configuredMinCopies n }
|
||||||
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
|
setuseragent v = setAnnexRead $ \rd -> rd { Annex.useragent = Just v }
|
||||||
|
setdesktopnotify v = setAnnexRead $ \rd -> rd { Annex.desktopnotify = Annex.desktopnotify rd <> v }
|
||||||
setgitconfig v = Annex.addGitConfigOverride v
|
setgitconfig v = Annex.addGitConfigOverride v
|
||||||
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
|
|
||||||
|
|
||||||
{- Parser that accepts all non-option params. -}
|
{- Parser that accepts all non-option params. -}
|
||||||
cmdParams :: CmdParamsDesc -> Parser CmdParams
|
cmdParams :: CmdParamsDesc -> Parser CmdParams
|
||||||
|
|
|
@ -4,4 +4,5 @@ anything that never needs to be modified while git-annex is running can be
|
||||||
moved to AnnexRead for a performance win and also to make clean how it's
|
moved to AnnexRead for a performance win and also to make clean how it's
|
||||||
used. --[[Joey]]
|
used. --[[Joey]]
|
||||||
|
|
||||||
Many things have been moved, but there are certainly others that can be.
|
> [[done]]; all AnnexState fields have been checked and all that can be
|
||||||
|
> made readonly are. --[[Joey]]
|
||||||
|
|
Loading…
Reference in a new issue