diff options
| -rw-r--r-- | Branch.hs | 16 | ||||
| -rw-r--r-- | LocationLog.hs | 1 | ||||
| -rw-r--r-- | PresenceLog.hs | 12 | ||||
| -rw-r--r-- | RemoteLog.hs | 7 | ||||
| -rw-r--r-- | Trust.hs | 8 | ||||
| -rw-r--r-- | UUID.hs | 16 | ||||
| -rw-r--r-- | Upgrade/V2.hs | 4 |
7 files changed, 34 insertions, 30 deletions
@@ -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. -} @@ -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 @@ -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] |