diff options
| -rw-r--r-- | Commands.hs | 9 | ||||
| -rw-r--r-- | Core.hs | 57 | ||||
| -rw-r--r-- | git-annex.hs | 14 |
3 files changed, 43 insertions, 37 deletions
diff --git a/Commands.hs b/Commands.hs index 6128b76aa..58d88aa3b 100644 --- a/Commands.hs +++ b/Commands.hs @@ -171,11 +171,7 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - liftIO $ commit g f - where - commit g f = do - Git.run g ["add", f] - Git.run g ["commit", "-m", "git-annex log update", f] + liftIO $ Git.run g ["add", f] -- committed at shutdown inBackend file yes no = do r <- liftIO $ Backend.lookupFile file @@ -204,7 +200,8 @@ requireEnoughCopies key = do findcopies n (r:rs) bad = do result <- liftIO $ try $ haskey r case (result) of - Right True -> findcopies (n-1) rs bad + Right True -> do + findcopies (n-1) rs bad Left _ -> findcopies n rs (r:bad) haskey r = do -- To check if a remote has a key, construct a new @@ -11,34 +11,43 @@ import UUID import qualified GitRepo as Git import qualified Annex -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Annex () -gitSetup = do +{- Sets up a git repo for git-annex. -} +setup :: Annex () +setup = do g <- Annex.gitRepo - liftIO $ setupattributes g + liftIO $ gitAttributes g prepUUID - where - -- configure git to use union merge driver on state files - setupattributes repo = do - exists <- doesFileExist attributes - if (not exists) + +{- When git-annex is done, it runs this. -} +shutdown :: Annex () +shutdown = do + g <- Annex.gitRepo + liftIO $ Git.run g ["commit", "-m", + "git-annex log update", ".git-annex"] + +{- configure git to use union merge driver on state files, if it is not + - already -} +gitAttributes :: Git.Repo -> IO () +gitAttributes 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 - writeFile attributes $ attrLine ++ "\n" + appendFile 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] + 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 f9d9311eb..e14739195 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -15,7 +15,7 @@ main = do actions <- argvToActions args gitrepo <- Git.repoFromCwd state <- new gitrepo - tryRun state (gitSetup:actions) + tryRun state $ [setup] ++ actions ++ [shutdown] {- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end. @@ -26,18 +26,18 @@ main = do - thread AnnexState through this function. -} tryRun :: AnnexState -> [Annex ()] -> IO () -tryRun state actions = tryRun' state 0 0 actions -tryRun' state errnum oknum (a:as) = do +tryRun state actions = tryRun' state 0 actions +tryRun' state errnum (a:as) = do result <- try (Annex.run state a)::IO (Either SomeException ((), AnnexState)) case (result) of Left err -> do showErr err - tryRun' state (errnum + 1) oknum as - Right (_,state') -> tryRun' state' errnum (oknum + 1) as -tryRun' state errnum oknum [] = do + tryRun' state (errnum + 1) as + Right (_,state') -> tryRun' state' errnum as +tryRun' state errnum [] = do if (errnum > 0) - then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" + then error $ (show errnum) ++ " failed" else return () {- Exception pretty-printing. -} |