better shutdown

This commit is contained in:
Joey Hess 2010-10-14 17:57:04 -04:00
parent 508a3b65ed
commit 467c4b2751
3 changed files with 43 additions and 37 deletions

View file

@ -171,11 +171,7 @@ logStatus key status = do
g <- Annex.gitRepo g <- Annex.gitRepo
u <- getUUID g u <- getUUID g
f <- liftIO $ logChange g key u status f <- liftIO $ logChange g key u status
liftIO $ commit g f liftIO $ Git.run g ["add", f] -- committed at shutdown
where
commit g f = do
Git.run g ["add", f]
Git.run g ["commit", "-m", "git-annex log update", f]
inBackend file yes no = do inBackend file yes no = do
r <- liftIO $ Backend.lookupFile file r <- liftIO $ Backend.lookupFile file
@ -204,7 +200,8 @@ requireEnoughCopies key = do
findcopies n (r:rs) bad = do findcopies n (r:rs) bad = do
result <- liftIO $ try $ haskey r result <- liftIO $ try $ haskey r
case (result) of case (result) of
Right True -> findcopies (n-1) rs bad Right True -> do
findcopies (n-1) rs bad
Left _ -> findcopies n rs (r:bad) Left _ -> findcopies n rs (r:bad)
haskey r = do haskey r = do
-- To check if a remote has a key, construct a new -- To check if a remote has a key, construct a new

23
Core.hs
View file

@ -11,15 +11,24 @@ import UUID
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Annex import qualified Annex
{- Sets up a git repo for git-annex. May be called repeatedly. -} {- Sets up a git repo for git-annex. -}
gitSetup :: Annex () setup :: Annex ()
gitSetup = do setup = do
g <- Annex.gitRepo g <- Annex.gitRepo
liftIO $ setupattributes g liftIO $ gitAttributes g
prepUUID prepUUID
where
-- configure git to use union merge driver on state files {- When git-annex is done, it runs this. -}
setupattributes repo = do 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 exists <- doesFileExist attributes
if (not exists) if (not exists)
then do then do

View file

@ -15,7 +15,7 @@ main = do
actions <- argvToActions args actions <- argvToActions args
gitrepo <- Git.repoFromCwd gitrepo <- Git.repoFromCwd
state <- new gitrepo state <- new gitrepo
tryRun state (gitSetup:actions) tryRun state $ [setup] ++ actions ++ [shutdown]
{- Runs a list of Annex actions. Catches exceptions, not stopping {- Runs a list of Annex actions. Catches exceptions, not stopping
- if some error out, and propigates an overall error status at the end. - if some error out, and propigates an overall error status at the end.
@ -26,18 +26,18 @@ main = do
- thread AnnexState through this function. - thread AnnexState through this function.
-} -}
tryRun :: AnnexState -> [Annex ()] -> IO () tryRun :: AnnexState -> [Annex ()] -> IO ()
tryRun state actions = tryRun' state 0 0 actions tryRun state actions = tryRun' state 0 actions
tryRun' state errnum oknum (a:as) = do tryRun' state errnum (a:as) = do
result <- try result <- try
(Annex.run state a)::IO (Either SomeException ((), AnnexState)) (Annex.run state a)::IO (Either SomeException ((), AnnexState))
case (result) of case (result) of
Left err -> do Left err -> do
showErr err showErr err
tryRun' state (errnum + 1) oknum as tryRun' state (errnum + 1) as
Right (_,state') -> tryRun' state' errnum (oknum + 1) as Right (_,state') -> tryRun' state' errnum as
tryRun' state errnum oknum [] = do tryRun' state errnum [] = do
if (errnum > 0) if (errnum > 0)
then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" then error $ (show errnum) ++ " failed"
else return () else return ()
{- Exception pretty-printing. -} {- Exception pretty-printing. -}