improved git-annex branch changing

All changes to files in the branch are now made via pure functions that
transform the old file into the new. This will allow adding locking
to prevent read/write races. It also makes the code nicer, and purer.

I noticed a behavior change, really a sort of bug fix. Before,
'git annex untrust foo --trust bar' would change both trust levels
permanantly, now the --trust doesn't get stored.
This commit is contained in:
Joey Hess 2011-10-03 15:41:25 -04:00
parent 6dfb94b2d7
commit f77979b8b5
7 changed files with 34 additions and 30 deletions

View file

@ -213,9 +213,19 @@ updateRef ref
liftIO $ Git.UnionMerge.merge g [ref] liftIO $ Git.UnionMerge.merge g [ref]
return $ Just ref return $ Just ref
{- Records changed content of a file into the journal. -} {- Applies a function to modifiy the content of a file. -}
change :: FilePath -> String -> Annex () change :: FilePath -> (String -> String) -> Annex ()
change file content = do change file a = do
lock
get file >>= return . a >>= set file
unlock
where
lock = return ()
unlock = return ()
{- Records new content of a file into the journal. -}
set :: FilePath -> String -> Annex ()
set file content = do
setJournalFile file content setJournalFile file content
setCache file content setCache file content

View file

@ -15,7 +15,6 @@ module LocationLog (
LogStatus(..), LogStatus(..),
logChange, logChange,
readLog, readLog,
writeLog,
keyLocations, keyLocations,
loggedKeys, loggedKeys,
logFile, logFile,

View file

@ -16,7 +16,6 @@ module PresenceLog (
addLog, addLog,
readLog, readLog,
parseLog, parseLog,
writeLog,
logNow, logNow,
compactLog, compactLog,
currentLog, currentLog,
@ -75,9 +74,8 @@ instance Read LogLine where
ret v = [(v, "")] ret v = [(v, "")]
addLog :: FilePath -> LogLine -> Annex () addLog :: FilePath -> LogLine -> Annex ()
addLog file line = do addLog file line = Branch.change file $ \s ->
ls <- readLog file showLog $ compactLog (line : parseLog s)
writeLog file (compactLog $ line:ls)
{- Reads a log file. {- Reads a log file.
- Note that the LogLines returned may be in any order. -} - Note that the LogLines returned may be in any order. -}
@ -90,9 +88,9 @@ parseLog = filter parsable . map read . lines
-- some lines may be unparseable, avoid them -- some lines may be unparseable, avoid them
parsable l = status l /= Undefined parsable l = status l /= Undefined
{- Stores a set of lines in a log file -} {- Generates a log file. -}
writeLog :: FilePath -> [LogLine] -> Annex () showLog :: [LogLine] -> String
writeLog file ls = Branch.change file (unlines $ map show ls) showLog = unlines . map show
{- Generates a new LogLine with the current date. -} {- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> Annex LogLine logNow :: LogStatus -> String -> Annex LogLine

View file

@ -32,11 +32,10 @@ remoteLog = "remote.log"
{- Adds or updates a remote's config in the log. -} {- Adds or updates a remote's config in the log. -}
configSet :: UUID -> RemoteConfig -> Annex () configSet :: UUID -> RemoteConfig -> Annex ()
configSet u c = do configSet u c = Branch.change remoteLog $
m <- readRemoteLog serialize . M.insert u c . remoteLogParse
Branch.change remoteLog $ unlines $ sort $
map toline $ M.toList $ M.insert u c m
where where
serialize = unlines . sort . map toline . M.toList
toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c') toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')
{- Map of remotes by uuid containing key/value config maps. -} {- Map of remotes by uuid containing key/value config maps. -}

View file

@ -64,11 +64,9 @@ trustSet :: UUID -> TrustLevel -> Annex ()
trustSet uuid level = do trustSet uuid level = do
when (null uuid) $ when (null uuid) $
error "unknown UUID; cannot modify trust level" error "unknown UUID; cannot modify trust level"
m <- trustMap Branch.change trustLog $
when (M.lookup uuid m /= Just level) $ do serialize . M.insert uuid level . M.fromList . trustMapParse
let m' = M.insert uuid level m Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
Branch.change trustLog (serialize m')
Annex.changeState $ \s -> s { Annex.trustmap = Just m' }
where where
serialize m = unlines $ map showpair $ M.toList m serialize m = unlines $ map showpair $ M.toList m
showpair (u, t) = u ++ " " ++ show t showpair (u, t) = u ++ " " ++ show t

16
UUID.hs
View file

@ -23,6 +23,7 @@ module UUID (
) where ) where
import Control.Monad.State import Control.Monad.State
import Control.Applicative
import System.Cmd.Utils import System.Cmd.Utils
import System.IO import System.IO
import qualified Data.Map as M import qualified Data.Map as M
@ -87,18 +88,17 @@ prepUUID = do
{- Records a description for a uuid in the uuidLog. -} {- Records a description for a uuid in the uuidLog. -}
describeUUID :: UUID -> String -> Annex () describeUUID :: UUID -> String -> Annex ()
describeUUID uuid desc = do describeUUID uuid desc = Branch.change uuidLog $
m <- uuidMap serialize . M.insert uuid desc . parse
let m' = M.insert uuid desc m
Branch.change uuidLog (serialize m')
where where
serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
{- Read and parse the uuidLog into a Map -} {- Read the uuidLog into a Map -}
uuidMap :: Annex (M.Map UUID String) uuidMap :: Annex (M.Map UUID String)
uuidMap = do uuidMap = parse <$> Branch.get uuidLog
s <- Branch.get uuidLog
return $ M.fromList $ map pair $ lines s parse :: String -> M.Map UUID String
parse = M.fromList . map pair . lines
where where
pair l pair l
| null ws = ("", "") | null ws = ("", "")

View file

@ -87,8 +87,8 @@ inject :: FilePath -> FilePath -> Annex ()
inject source dest = do inject source dest = do
g <- Annex.gitRepo g <- Annex.gitRepo
new <- liftIO (readFile $ olddir g </> source) new <- liftIO (readFile $ olddir g </> source)
prev <- Branch.get dest Branch.change dest $ \prev ->
Branch.change dest $ unlines $ nub $ lines prev ++ lines new unlines $ nub $ lines prev ++ lines new
showProgress showProgress
logFiles :: FilePath -> Annex [FilePath] logFiles :: FilePath -> Annex [FilePath]