This commit is contained in:
Joey Hess 2011-10-10 17:37:44 -04:00
parent 10edaf6dc9
commit 025ded4a2d
3 changed files with 34 additions and 40 deletions

View file

@ -215,18 +215,14 @@ 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
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
@ -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

View file

@ -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
when (isLinkToAnnex l) $ warning $
"skipping " ++ file ++
" (unknown backend " ++
bname ++ ")"
return Nothing
where
bname = keyBackendName k
skip = "skipping " ++ file ++
" (unknown backend " ++ bname ++ ")"
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

View file

@ -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>
-