diff options
| -rw-r--r-- | Annex.hs | 15 | ||||
| -rw-r--r-- | Backend.hs | 2 | ||||
| -rw-r--r-- | Backend/File.hs | 1 | ||||
| -rw-r--r-- | Core.hs | 65 | ||||
| -rw-r--r-- | git-annex.hs | 7 |
5 files changed, 45 insertions, 45 deletions
@@ -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 01c7c6823..7a8178a8e 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 92f5932ce..893850a69 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", @@ -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)) +gitSetup :: Annex () +gitSetup = do + g <- Annex.gitRepo + liftIO $ setupattributes g + prepUUID + where + -- configure git to use union merge driver on state files + setupattributes repo = do + exists <- doesFileExist attributes + if (not exists) then do - appendFile attributes $ attrLine ++ "\n" + writeFile 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] + 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 78e875014..f9d9311eb 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. |