better memoize core.sharedrepository handling

It was memoized, but that was not used consistently. Move it to
Types.GitConfig so it will auto-memoize.
This commit is contained in:
Joey Hess 2015-05-19 15:04:24 -04:00
parent b47c9fd587
commit 167539a354
4 changed files with 21 additions and 25 deletions

View file

@ -42,7 +42,6 @@ import Annex.Fixup
import Git.CatFile
import Git.CheckAttr
import Git.CheckIgnore
import Git.SharedRepository
import qualified Git.Hook
import qualified Git.Queue
import Types.Key
@ -115,7 +114,6 @@ data AnnexState = AnnexState
, uuidmap :: Maybe UUIDMap
, preferredcontentmap :: Maybe (FileMatcherMap Annex)
, requiredcontentmap :: Maybe (FileMatcherMap Annex)
, shared :: Maybe SharedRepository
, forcetrust :: TrustMap
, trustmap :: Maybe TrustMap
, groupmap :: Maybe GroupMap
@ -161,7 +159,6 @@ newState c r = AnnexState
, uuidmap = Nothing
, preferredcontentmap = Nothing
, requiredcontentmap = Nothing
, shared = Nothing
, forcetrust = M.empty
, trustmap = Nothing
, groupmap = Nothing

View file

@ -614,39 +614,39 @@ preseedTmp key file = go =<< inAnnex key
- allow reading it, per core.sharedRepository setting. -}
freezeContent :: FilePath -> Annex ()
freezeContent file = unlessM crippledFileSystem $
liftIO . go =<< fromRepo getSharedRepository
withShared go
where
go GroupShared = modifyFileMode file $
go GroupShared = liftIO $ modifyFileMode file $
removeModes writeModes .
addModes [ownerReadMode, groupReadMode]
go AllShared = modifyFileMode file $
go AllShared = liftIO $ modifyFileMode file $
removeModes writeModes .
addModes readModes
go _ = modifyFileMode file $
go _ = liftIO $ modifyFileMode file $
removeModes writeModes .
addModes [ownerReadMode]
{- Adjusts read mode of annexed file per core.sharedRepository setting. -}
chmodContent :: FilePath -> Annex ()
chmodContent file = unlessM crippledFileSystem $
liftIO . go =<< fromRepo getSharedRepository
withShared go
where
go GroupShared = modifyFileMode file $
go GroupShared = liftIO $ modifyFileMode file $
addModes [ownerReadMode, groupReadMode]
go AllShared = modifyFileMode file $
go AllShared = liftIO $ modifyFileMode file $
addModes readModes
go _ = modifyFileMode file $
go _ = liftIO $ modifyFileMode file $
addModes [ownerReadMode]
{- Allows writing to an annexed file that freezeContent was called on
- before. -}
thawContent :: FilePath -> Annex ()
thawContent file = unlessM crippledFileSystem $
liftIO . go =<< fromRepo getSharedRepository
withShared go
where
go GroupShared = groupWriteRead file
go AllShared = groupWriteRead file
go _ = allowWrite file
go GroupShared = liftIO $ groupWriteRead file
go AllShared = liftIO $ groupWriteRead file
go _ = liftIO $ allowWrite file
{- Finds files directly inside a directory like gitAnnexBadDir
- (not in subdirectories) and returns the corresponding keys. -}

View file

@ -15,6 +15,7 @@ module Annex.Perms (
freezeContentDir,
thawContentDir,
modifyContent,
withShared,
) where
import Common.Annex
@ -26,12 +27,7 @@ import Config
import System.Posix.Types
withShared :: (SharedRepository -> Annex a) -> Annex a
withShared a = maybe startup a =<< Annex.getState Annex.shared
where
startup = do
shared <- fromRepo getSharedRepository
Annex.changeState $ \s -> s { Annex.shared = Just shared }
a shared
withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig
setAnnexFilePerm :: FilePath -> Annex ()
setAnnexFilePerm = setAnnexPerm False
@ -90,12 +86,12 @@ createAnnexDirectory dir = walk dir [] =<< top
-}
freezeContentDir :: FilePath -> Annex ()
freezeContentDir file = unlessM crippledFileSystem $
liftIO . go =<< fromRepo getSharedRepository
withShared go
where
dir = parentDir file
go GroupShared = groupWriteRead dir
go AllShared = groupWriteRead dir
go _ = preventWrite dir
go GroupShared = liftIO $ groupWriteRead dir
go AllShared = liftIO $ groupWriteRead dir
go _ = liftIO $ preventWrite dir
thawContentDir :: FilePath -> Annex ()
thawContentDir file = unlessM crippledFileSystem $

View file

@ -16,6 +16,7 @@ import Common
import qualified Git
import qualified Git.Config
import qualified Git.Construct
import Git.SharedRepository
import Utility.DataUnits
import Config.Cost
import Types.Distribution
@ -58,6 +59,7 @@ data GitConfig = GitConfig
, annexStartupScan :: Bool
, annexHardLink :: Bool
, coreSymlinks :: Bool
, coreSharedRepository :: SharedRepository
, gcryptId :: Maybe String
, annexDifferences :: Differences
, annexUsedRefSpec :: Maybe RefSpec
@ -97,6 +99,7 @@ extractGitConfig r = GitConfig
, annexStartupScan = getbool (annex "startupscan") True
, annexHardLink = getbool (annex "hardlink") False
, coreSymlinks = getbool "core.symlinks" True
, coreSharedRepository = getSharedRepository r
, gcryptId = getmaybe "core.gcrypt-id"
, annexDifferences = getDifferences r
, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec