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

View file

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

View file

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

View file

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