diff options
| -rw-r--r-- | Annex/Branch.hs | 30 | ||||
| -rw-r--r-- | Backend.hs | 42 | ||||
| -rw-r--r-- | Types/Backend.hs | 2 |
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> - |