diff --git a/Annex.hs b/Annex.hs index fcd19ba033..9be86c9481 100644 --- a/Annex.hs +++ b/Annex.hs @@ -14,9 +14,18 @@ import qualified GitRepo as Git import Types import qualified BackendTypes as Backend --- constructor -new :: Git.Repo -> AnnexState -new g = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } +{- Create and returns an Annex state object for the specified git repo. + -} +new :: Git.Repo -> IO AnnexState +new g = do + let s = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } + (_,s') <- Annex.run s (prep g) + return s' + where + prep g = do + -- read git config and update state + g' <- liftIO $ Git.configRead g + Annex.gitRepoChange g' -- performs an action in the Annex monad run state action = runStateT (action) state diff --git a/Backend.hs b/Backend.hs index 01c7c6823f..7a8178a8eb 100644 --- a/Backend.hs +++ b/Backend.hs @@ -52,7 +52,7 @@ storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) storeFileKey file = do g <- Annex.gitRepo let relfile = Git.relative g file - b <- Annex.backends + b <- backendList storeFileKey' b file relfile storeFileKey' [] _ _ = return Nothing storeFileKey' (b:bs) file relfile = do diff --git a/Backend/File.hs b/Backend/File.hs index 92f5932ce5..893850a695 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -14,6 +14,7 @@ import Locations import qualified Remotes import qualified GitRepo as Git import Utility +import Core backend = Backend { name = "file", diff --git a/Core.hs b/Core.hs index 431c9c9e63..644bedd00f 100644 --- a/Core.hs +++ b/Core.hs @@ -6,52 +6,39 @@ import System.IO import System.Directory import Control.Monad.State (liftIO) import Types -import BackendList import Locations import UUID import qualified GitRepo as Git import qualified Annex - -{- Create and returns an Annex state object. - - Examines and prepares the git repo. - -} -start :: IO AnnexState -start = do - g <- Git.repoFromCwd - let s = Annex.new g - (_,s') <- Annex.run s (prep g) - return s' - where - prep g = do - -- setup git and read its config; update state - g' <- liftIO $ Git.configRead g - Annex.gitRepoChange g' - liftIO $ gitSetup g' - prepUUID - + {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Git.Repo -> IO () -gitSetup repo = do - -- configure git to use union merge driver on state files - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - commit - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - commit - else return () +gitSetup :: Annex () +gitSetup = do + g <- Annex.gitRepo + liftIO $ setupattributes g + prepUUID where - attrLine = stateLoc ++ "/*.log merge=union" - attributes = Git.attributes repo - commit = do - Git.run repo ["add", attributes] - Git.run repo ["commit", "-m", "git-annex setup", - attributes] + -- configure git to use union merge driver on state files + setupattributes repo = do + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + commit + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + commit + else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = Git.attributes repo + commit = do + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", + attributes] {- Checks if a given key is currently present in the annexLocation -} inAnnex :: Backend -> Key -> Annex Bool diff --git a/git-annex.hs b/git-annex.hs index 78e8750147..f9d9311eb2 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -7,12 +7,15 @@ import qualified Annex import Types import Core import Commands +import Annex +import qualified GitRepo as Git main = do args <- getArgs actions <- argvToActions args - state <- start - tryRun state actions + gitrepo <- Git.repoFromCwd + state <- new gitrepo + tryRun state (gitSetup:actions) {- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end.