aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-03 15:41:25 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-03 15:41:25 -0400
commitf77979b8b5ef1dc59b45c03ba6febfacdf904491 (patch)
tree952982098f70079e67347fce3e2fd99e515a708e
parent6dfb94b2d783ef848c651ab20818b05c8a0504a6 (diff)
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.
-rw-r--r--Branch.hs16
-rw-r--r--LocationLog.hs1
-rw-r--r--PresenceLog.hs12
-rw-r--r--RemoteLog.hs7
-rw-r--r--Trust.hs8
-rw-r--r--UUID.hs16
-rw-r--r--Upgrade/V2.hs4
7 files changed, 34 insertions, 30 deletions
diff --git a/Branch.hs b/Branch.hs
index e4caeece7..9340259c7 100644
--- a/Branch.hs
+++ b/Branch.hs
@@ -213,9 +213,19 @@ updateRef ref
liftIO $ Git.UnionMerge.merge g [ref]
return $ Just ref
-{- Records changed content of a file into the journal. -}
-change :: FilePath -> String -> Annex ()
-change file content = do
+{- Applies a function to modifiy the content of a file. -}
+change :: FilePath -> (String -> String) -> Annex ()
+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
setCache file content
diff --git a/LocationLog.hs b/LocationLog.hs
index 7e5e81d7a..0cdf88bc6 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -15,7 +15,6 @@ module LocationLog (
LogStatus(..),
logChange,
readLog,
- writeLog,
keyLocations,
loggedKeys,
logFile,
diff --git a/PresenceLog.hs b/PresenceLog.hs
index 7742651b8..2db1ee59b 100644
--- a/PresenceLog.hs
+++ b/PresenceLog.hs
@@ -16,7 +16,6 @@ module PresenceLog (
addLog,
readLog,
parseLog,
- writeLog,
logNow,
compactLog,
currentLog,
@@ -75,9 +74,8 @@ instance Read LogLine where
ret v = [(v, "")]
addLog :: FilePath -> LogLine -> Annex ()
-addLog file line = do
- ls <- readLog file
- writeLog file (compactLog $ line:ls)
+addLog file line = Branch.change file $ \s ->
+ showLog $ compactLog (line : parseLog s)
{- Reads a log file.
- 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
parsable l = status l /= Undefined
-{- Stores a set of lines in a log file -}
-writeLog :: FilePath -> [LogLine] -> Annex ()
-writeLog file ls = Branch.change file (unlines $ map show ls)
+{- Generates a log file. -}
+showLog :: [LogLine] -> String
+showLog = unlines . map show
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> Annex LogLine
diff --git a/RemoteLog.hs b/RemoteLog.hs
index 620c0d875..f9c7997e4 100644
--- a/RemoteLog.hs
+++ b/RemoteLog.hs
@@ -32,11 +32,10 @@ remoteLog = "remote.log"
{- Adds or updates a remote's config in the log. -}
configSet :: UUID -> RemoteConfig -> Annex ()
-configSet u c = do
- m <- readRemoteLog
- Branch.change remoteLog $ unlines $ sort $
- map toline $ M.toList $ M.insert u c m
+configSet u c = Branch.change remoteLog $
+ serialize . M.insert u c . remoteLogParse
where
+ serialize = unlines . sort . map toline . M.toList
toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')
{- Map of remotes by uuid containing key/value config maps. -}
diff --git a/Trust.hs b/Trust.hs
index 232eea6a5..0c8836c85 100644
--- a/Trust.hs
+++ b/Trust.hs
@@ -64,11 +64,9 @@ trustSet :: UUID -> TrustLevel -> Annex ()
trustSet uuid level = do
when (null uuid) $
error "unknown UUID; cannot modify trust level"
- m <- trustMap
- when (M.lookup uuid m /= Just level) $ do
- let m' = M.insert uuid level m
- Branch.change trustLog (serialize m')
- Annex.changeState $ \s -> s { Annex.trustmap = Just m' }
+ Branch.change trustLog $
+ serialize . M.insert uuid level . M.fromList . trustMapParse
+ Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
where
serialize m = unlines $ map showpair $ M.toList m
showpair (u, t) = u ++ " " ++ show t
diff --git a/UUID.hs b/UUID.hs
index b1ccbb250..eab6bd4df 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -23,6 +23,7 @@ module UUID (
) where
import Control.Monad.State
+import Control.Applicative
import System.Cmd.Utils
import System.IO
import qualified Data.Map as M
@@ -87,18 +88,17 @@ prepUUID = do
{- Records a description for a uuid in the uuidLog. -}
describeUUID :: UUID -> String -> Annex ()
-describeUUID uuid desc = do
- m <- uuidMap
- let m' = M.insert uuid desc m
- Branch.change uuidLog (serialize m')
+describeUUID uuid desc = Branch.change uuidLog $
+ serialize . M.insert uuid desc . parse
where
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 = do
- s <- Branch.get uuidLog
- return $ M.fromList $ map pair $ lines s
+uuidMap = parse <$> Branch.get uuidLog
+
+parse :: String -> M.Map UUID String
+parse = M.fromList . map pair . lines
where
pair l
| null ws = ("", "")
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index e99a7cf81..4e686288f 100644
--- a/Upgrade/V2.hs
+++ b/Upgrade/V2.hs
@@ -87,8 +87,8 @@ inject :: FilePath -> FilePath -> Annex ()
inject source dest = do
g <- Annex.gitRepo
new <- liftIO (readFile $ olddir g </> source)
- prev <- Branch.get dest
- Branch.change dest $ unlines $ nub $ lines prev ++ lines new
+ Branch.change dest $ \prev ->
+ unlines $ nub $ lines prev ++ lines new
showProgress
logFiles :: FilePath -> Annex [FilePath]