summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Branch.hs30
-rw-r--r--Backend.hs42
-rw-r--r--Types/Backend.hs2
3 files changed, 34 insertions, 40 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 0002befec..aea0d2bff 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -215,20 +215,16 @@ set file content = do
-
- Returns an empty string if the file doesn't exist yet. -}
get :: FilePath -> Annex String
-get file = do
- cached <- getCache file
- case cached of
- Just content -> return content
- Nothing -> do
- j <- getJournalFile file
- case j of
- Just content -> do
- setCache file content
- return content
- Nothing -> withIndexUpdate $ do
- content <- catFile fullname file
- setCache file content
- return content
+get file = fromcache =<< getCache file
+ where
+ fromcache (Just content) = return content
+ fromcache Nothing = fromjournal =<< getJournalFile file
+ fromjournal (Just content) = cache content
+ fromjournal Nothing = withIndexUpdate $
+ cache =<< catFile fullname file
+ cache content = do
+ setCache file content
+ return content
{- Lists all files on the branch. There may be duplicates in the list. -}
files :: Annex [FilePath]
@@ -287,8 +283,7 @@ stageJournalFiles = do
let paths = map (dir </>) fs
-- inject all the journal files directly into git
-- in one quick command
- (pid, fromh, toh) <- hPipeBoth "git" $ toCommand $
- Git.gitCommandLine g [Param "hash-object", Param "-w", Param "--stdin-paths"]
+ (pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object g
_ <- forkProcess $ do
hPutStr toh $ unlines paths
hClose toh
@@ -304,6 +299,9 @@ stageJournalFiles = do
where
index_lines shas = map genline . zip shas
genline (sha, file) = Git.UnionMerge.update_index_line sha file
+ git_hash_object g = Git.gitCommandLine g
+ [Param "hash-object", Param "-w", Param "--stdin-paths"]
+
{- Checks if there are changes in the journal. -}
journalDirty :: Annex Bool
diff --git a/Backend.hs b/Backend.hs
index d1ff11405..a09fc0e99 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -39,23 +39,20 @@ orderedList = do
l <- Annex.getState Annex.backends -- list is cached here
if not $ null l
then return l
- else do
- s <- getstandard
- d <- Annex.getState Annex.forcebackend
- handle d s
+ else handle =<< Annex.getState Annex.forcebackend
where
- parseBackendList [] = list
- parseBackendList s = map lookupBackendName $ words s
- handle Nothing s = return s
- handle (Just "") s = return s
- handle (Just name) s = do
- let l' = lookupBackendName name : s
- Annex.changeState $ \state -> state { Annex.backends = l' }
+ handle Nothing = standard
+ handle (Just "") = standard
+ handle (Just name) = do
+ l' <- (lookupBackendName name :) <$> standard
+ Annex.changeState $ \s -> s { Annex.backends = l' }
return l'
- getstandard = do
+ standard = do
g <- gitRepo
return $ parseBackendList $
Git.configGet g "annex.backends" ""
+ parseBackendList [] = list
+ parseBackendList s = map lookupBackendName $ words s
{- Generates a key for a file, trying each backend in turn until one
- accepts it. -}
@@ -83,17 +80,15 @@ lookupFile file = do
where
getsymlink = takeFileName <$> readSymbolicLink file
makekey l = maybe (return Nothing) (makeret l) (fileKey l)
- makeret l k =
+ makeret l k = let bname = keyBackendName k in
case maybeLookupBackendName bname of
- Just backend -> return $ Just (k, backend)
- Nothing -> do
- when (isLinkToAnnex l) $
- warning skip
- return Nothing
- where
- bname = keyBackendName k
- skip = "skipping " ++ file ++
- " (unknown backend " ++ bname ++ ")"
+ Just backend -> return $ Just (k, backend)
+ Nothing -> do
+ when (isLinkToAnnex l) $ warning $
+ "skipping " ++ file ++
+ " (unknown backend " ++
+ bname ++ ")"
+ return Nothing
type BackendFile = (Maybe (Backend Annex), FilePath)
@@ -121,4 +116,5 @@ maybeLookupBackendName :: String -> Maybe (Backend Annex)
maybeLookupBackendName s
| length matches == 1 = Just $ head matches
| otherwise = Nothing
- where matches = filter (\b -> s == B.name b) list
+ where
+ matches = filter (\b -> s == B.name b) list
diff --git a/Types/Backend.hs b/Types/Backend.hs
index f86d0845c..4f8226704 100644
--- a/Types/Backend.hs
+++ b/Types/Backend.hs
@@ -1,6 +1,6 @@
{- git-annex key/value backend data type
-
- - Most things should not need this, using Types instead
+ - Most things should not need this, using Remotes instead
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-