diff options
author | Joey Hess <joey@kitenet.net> | 2011-06-23 02:30:20 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-06-23 02:30:20 -0400 |
commit | af10b2854a199ed9985cde938d46b252f4d5e503 (patch) | |
tree | 309ecddc720cd4294f911c67028b53b65ae1a7c2 /Upgrade | |
parent | 66ceb9270266be677bdb0731a9c95569bad37d28 (diff) |
v3 upgrade code works
but write the index file a lot, so slow
Diffstat (limited to 'Upgrade')
-rw-r--r-- | Upgrade/V1.hs | 5 | ||||
-rw-r--r-- | Upgrade/V2.hs | 54 |
2 files changed, 44 insertions, 15 deletions
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 1f327f77b..61a801859 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -30,6 +30,7 @@ import Backend import Messages import Version import Utility +import qualified Upgrade.V2 -- v2 adds hashing of filenames of content and location log files. -- Key information is encoded in filenames differently, so @@ -70,8 +71,8 @@ upgrade = do AnnexQueue.flush True setVersion - - return True + + Upgrade.V2.upgrade moveContent :: Annex () moveContent = do diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index c249e340b..36ba1a0f2 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -1,4 +1,4 @@ -{- git-annex v2 -> v2 upgrade support +{- git-annex v2 -> v3 upgrade support - - Copyright 2011 Joey Hess <joey@kitenet.net> - @@ -9,14 +9,22 @@ module Upgrade.V2 where import System.Directory import System.FilePath +import Control.Monad.State (liftIO) +import List +import Data.Maybe import Types.Key import Types +import qualified Annex import qualified GitRepo as Git +import qualified Branch import Messages import Utility import Locations +olddir :: FilePath +olddir = ".git-annex" + {- .git-annex/ moved to a git-annex branch. - - Strategy: @@ -35,7 +43,36 @@ import Locations upgrade :: Annex Bool upgrade = do showNote "v2 to v3" - error "TODO" + g <- Annex.gitRepo + Branch.create + mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs g + mapM_ (\f -> inject f f) =<< logFiles olddir + liftIO $ do + Git.run g "rm" [Param "-r", Param "-f", Param "-q", File olddir] + gitAttributesUnWrite g + return True + +locationLogs :: Git.Repo -> Annex [(Key, FilePath)] +locationLogs repo = liftIO $ do + levela <- dirContents dir + levelb <- mapM tryDirContents levela + files <- mapM tryDirContents (concat levelb) + return $ catMaybes $ map islogfile (concat files) + where + tryDirContents d = catch (dirContents d) (return . const []) + dir = gitStateDir repo + islogfile f = maybe Nothing (\k -> Just $ (k, f)) $ + logFileKey $ takeFileName f + +inject :: FilePath -> FilePath -> Annex () +inject source dest = do + new <- liftIO (readFile $ olddir </> source) + prev <- Branch.get dest + Branch.change dest $ unlines $ nub $ lines prev ++ lines new + +logFiles :: FilePath -> Annex [FilePath] +logFiles dir = return . filter (".log" `isSuffixOf`) + =<< liftIO (getDirectoryContents dir) {- Old .gitattributes contents, not needed anymore. -} attrLines :: [String] @@ -49,15 +86,6 @@ gitAttributesUnWrite repo = do let attributes = Git.attributes repo whenM (doesFileExist attributes) $ do c <- readFileStrict attributes - safeWriteFile attributes $ unlines $ + liftIO $ safeWriteFile attributes $ unlines $ filter (\l -> not $ l `elem` attrLines) $ lines c - -oldlogFile :: Git.Repo -> Key -> String -oldlogFile = logFile' hashDirLower - -oldlogFileOld :: Git.Repo -> Key -> String -oldlogFileOld = logFile' hashDirMixed - -logFile' :: (Key -> FilePath) -> Git.Repo -> Key -> String -logFile' hasher repo key = - gitStateDir repo ++ hasher key ++ keyFile key ++ ".log" + Git.run repo "add" [File attributes] |