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
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

57
Core.hs
View file

@ -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

View file

@ -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. -}