diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-16 16:05:05 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-16 16:05:05 -0400 |
commit | e7b557ef5d347831142fd98eac901d79c7e1305d (patch) | |
tree | dbd5d0bcb578e457a6bb23a856b27f4aa27abd36 /CmdLine.hs | |
parent | 84836ed804633fa3d8ff50064331b8b90bb160dd (diff) |
got rid of Core module
Most of it was to do with managing annexed Content, so put there
Diffstat (limited to 'CmdLine.hs')
-rw-r--r-- | CmdLine.hs | 56 |
1 files changed, 52 insertions, 4 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index fbcfb6405..6772282c5 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,4 +1,4 @@ -{- git-annex command line parsing +{- git-annex command line parsing and dispatch - - Copyright 2010 Joey Hess <joey@kitenet.net> - @@ -7,22 +7,27 @@ module CmdLine ( dispatch, - parseCmd, usage, + shutdown ) where +import System.IO.Error (try) import System.Console.GetOpt -import Control.Monad (when) import Control.Monad.State (liftIO) +import Control.Monad (when, unless) +import System.Directory import qualified Annex import qualified GitRepo as Git +import qualified GitQueue import Types import Command import BackendList -import Core import Upgrade import Options +import Messages +import UUID +import Locations {- Runs the passed command line. -} dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO () @@ -68,3 +73,46 @@ usage header cmds options = indent l = " " ++ l pad n s = replicate (n - length s) ' ' longest f = foldl max 0 $ map (length . f) cmds + +{- Runs a list of Annex actions. Catches IO errors and continues + - (but explicitly thrown errors terminate the whole command). + - Runs shutdown and propigates an overall error status at the end. + -} +tryRun :: AnnexState -> [Annex Bool] -> IO () +tryRun state actions = tryRun' state 0 actions +tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO () +tryRun' state errnum (a:as) = do + result <- try $ Annex.run state a + case result of + Left err -> do + Annex.eval state $ showErr err + tryRun' state (errnum + 1) as + Right (True,state') -> tryRun' state' errnum as + Right (False,state') -> tryRun' state' (errnum + 1) as +tryRun' state errnum [] = do + _ <- try $ Annex.run state $ shutdown errnum + when (errnum > 0) $ error $ show errnum ++ " failed" + +{- Actions to perform each time ran. -} +startup :: Annex Bool +startup = do + prepUUID + return True + +{- Cleanup actions. -} +shutdown :: Integer -> Annex () +shutdown errnum = do + q <- Annex.queueGet + unless (q == GitQueue.empty) $ do + showSideAction "Recording state in git..." + Annex.queueRun + + -- If nothing failed, clean up any files left in the temp directory, + -- but leave the directory itself. If something failed, temp files + -- are left behind to allow resuming on re-run. + when (errnum == 0) $ do + g <- Annex.gitRepo + let tmp = annexTmpLocation g + exists <- liftIO $ doesDirectoryExist tmp + when exists $ liftIO $ removeDirectoryRecursive tmp + liftIO $ createDirectoryIfMissing True tmp |