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:
parent
6dfb94b2d7
commit
f77979b8b5
7 changed files with 34 additions and 30 deletions
16
Branch.hs
16
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
|
||||
|
||||
|
|
|
@ -15,7 +15,6 @@ module LocationLog (
|
|||
LogStatus(..),
|
||||
logChange,
|
||||
readLog,
|
||||
writeLog,
|
||||
keyLocations,
|
||||
loggedKeys,
|
||||
logFile,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
8
Trust.hs
8
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
|
||||
|
|
16
UUID.hs
16
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 = ("", "")
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in a new issue