diff options
Diffstat (limited to 'Logs')
| -rw-r--r-- | Logs/Group.hs | 24 | ||||
| -rw-r--r-- | Logs/PreferredContent.hs | 25 | ||||
| -rw-r--r-- | Logs/Remote.hs | 1 | ||||
| -rw-r--r-- | Logs/Trust.hs | 32 | ||||
| -rw-r--r-- | Logs/UUID.hs | 28 |
5 files changed, 65 insertions, 45 deletions
diff --git a/Logs/Group.hs b/Logs/Group.hs index 9fd748650..de0d1e598 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -6,10 +6,12 @@ -} module Logs.Group ( + groupLog, groupChange, groupSet, lookupGroups, groupMap, + groupMapLoad, getStandardGroup, ) where @@ -47,18 +49,18 @@ groupChange NoUUID _ = error "unknown UUID; cannot modify" groupSet :: UUID -> S.Set Group -> Annex () groupSet u g = groupChange u (const g) -{- Read the groupLog into a map. The map is cached for speed. -} +{- The map is cached for speed. -} groupMap :: Annex GroupMap -groupMap = do - cached <- Annex.getState Annex.groupmap - case cached of - Just m -> return m - Nothing -> do - m <- makeGroupMap . simpleMap . - parseLog (Just . S.fromList . words) <$> - Annex.Branch.get groupLog - Annex.changeState $ \s -> s { Annex.groupmap = Just m } - return m +groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap + +{- Loads the map, updating the cache. -} +groupMapLoad :: Annex GroupMap +groupMapLoad = do + m <- makeGroupMap . simpleMap . + parseLog (Just . S.fromList . words) <$> + Annex.Branch.get groupLog + Annex.changeState $ \s -> s { Annex.groupmap = Just m } + return m makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap makeGroupMap byuuid = GroupMap byuuid bygroup diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index f3454cc7d..003efaeae 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -6,9 +6,11 @@ -} module Logs.PreferredContent ( + preferredContentLog, preferredContentSet, isPreferredContent, preferredContentMap, + preferredContentMapLoad, preferredContentMapRaw, checkPreferredContentExpression, setStandardGroup, @@ -60,19 +62,20 @@ isPreferredContent mu notpresent file = do Just matcher -> Utility.Matcher.matchMrun matcher $ \a -> a notpresent fi -{- Read the preferredContentLog into a map. The map is cached for speed. -} +{- The map is cached for speed. -} preferredContentMap :: Annex Annex.PreferredContentMap -preferredContentMap = do +preferredContentMap = maybe preferredContentMapLoad return + =<< Annex.getState Annex.preferredcontentmap + +{- Loads the map, updating the cache. -} +preferredContentMapLoad :: Annex Annex.PreferredContentMap +preferredContentMapLoad = do groupmap <- groupMap - cached <- Annex.getState Annex.preferredcontentmap - case cached of - Just m -> return m - Nothing -> do - m <- simpleMap - . parseLogWithUUID ((Just .) . makeMatcher groupmap) - <$> Annex.Branch.get preferredContentLog - Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } - return m + m <- simpleMap + . parseLogWithUUID ((Just .) . makeMatcher groupmap) + <$> Annex.Branch.get preferredContentLog + Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } + return m preferredContentMapRaw :: Annex (M.Map UUID String) preferredContentMapRaw = simpleMap . parseLog Just diff --git a/Logs/Remote.hs b/Logs/Remote.hs index b75573a41..d4991e272 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -6,6 +6,7 @@ -} module Logs.Remote ( + remoteLog, readRemoteLog, configSet, keyValToConfig, diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 1a29f8cf0..cd437bf89 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -6,11 +6,13 @@ -} module Logs.Trust ( + trustLog, TrustLevel(..), trustGet, trustSet, trustPartition, lookupTrust, + trustMapLoad, trustMapRaw, ) where @@ -65,27 +67,29 @@ trustPartition level ls candidates <- trustGet level return $ partition (`elem` candidates) ls -{- Read the trustLog into a map, overriding with any - - values from forcetrust or the git config. The map is cached for speed. -} +{- trustLog in a map, overridden with any values from forcetrust or + - the git config. The map is cached for speed. -} trustMap :: Annex TrustMap -trustMap = do - cached <- Annex.getState Annex.trustmap - case cached of - Just m -> return m - Nothing -> do - overrides <- Annex.getState Annex.forcetrust - logged <- trustMapRaw - configured <- M.fromList . catMaybes - <$> (mapM configuredtrust =<< remoteList) - let m = M.union overrides $ M.union configured logged - Annex.changeState $ \s -> s { Annex.trustmap = Just m } - return m +trustMap = maybe trustMapLoad return =<< Annex.getState Annex.trustmap + +{- Loads the map, updating the cache, -} +trustMapLoad :: Annex TrustMap +trustMapLoad = do + overrides <- Annex.getState Annex.forcetrust + logged <- trustMapRaw + configured <- M.fromList . catMaybes + <$> (mapM configuredtrust =<< remoteList) + let m = M.union overrides $ M.union configured logged + Annex.changeState $ \s -> s { Annex.trustmap = Just m } + return m where configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$> maybe Nothing readTrustLevel <$> getTrustLevel (Types.Remote.repo r) +{- Does not include forcetrust or git config values, just those from the + - log file. -} trustMapRaw :: Annex TrustMap trustMapRaw = simpleMap . parseLog (Just . parseTrustLog) <$> Annex.Branch.get trustLog diff --git a/Logs/UUID.hs b/Logs/UUID.hs index d825e1127..7b7090223 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -8,34 +8,38 @@ - - uuid.log stores a list of known uuids, and their descriptions. - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} module Logs.UUID ( + uuidLog, describeUUID, recordUUID, - uuidMap + uuidMap, + uuidMapLoad ) where import qualified Data.Map as M import Data.Time.Clock.POSIX +import Types.UUID import Common.Annex +import qualified Annex import qualified Annex.Branch import Logs.UUIDBased import qualified Annex.UUID {- Filename of uuid.log. -} -logfile :: FilePath -logfile = "uuid.log" +uuidLog :: FilePath +uuidLog = "uuid.log" {- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () describeUUID uuid desc = do ts <- liftIO getPOSIXTime - Annex.Branch.change logfile $ + Annex.Branch.change uuidLog $ showLog id . changeLog ts uuid desc . fixBadUUID . parseLog Just {- Temporarily here to fix badly formatted uuid logs generated by @@ -76,14 +80,20 @@ recordUUID u = go . M.lookup u =<< uuidMap go _ = noop set = describeUUID u "" +{- The map is cached for speed. -} +uuidMap :: Annex UUIDMap +uuidMap = maybe uuidMapLoad return =<< Annex.getState Annex.uuidmap + {- Read the uuidLog into a simple Map. - - The UUID of the current repository is included explicitly, since - it may not have been described and so otherwise would not appear. -} -uuidMap :: Annex (M.Map UUID String) -uuidMap = do - m <- (simpleMap . parseLog Just) <$> Annex.Branch.get logfile +uuidMapLoad :: Annex UUIDMap +uuidMapLoad = do + m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog u <- Annex.UUID.getUUID - return $ M.insertWith' preferold u "" m + let m' = M.insertWith' preferold u "" m + Annex.changeState $ \s -> s { Annex.uuidmap = Just m' } + return m' where preferold = flip const |