summaryrefslogtreecommitdiff
path: root/git-annex.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-13 21:28:47 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-13 21:28:47 -0400
commitb1607485168e851f69fe3a5b74d73f3c36edf886 (patch)
tree496133383a3aa77ecc373c383c6655e50d71f9c9 /git-annex.hs
parente5c1db355f5fa31af14ed8474aee89872b934f1a (diff)
use a state monad
enormous reworking
Diffstat (limited to 'git-annex.hs')
-rw-r--r--git-annex.hs31
1 files changed, 19 insertions, 12 deletions
diff --git a/git-annex.hs b/git-annex.hs
index 7785e4f2d..935be2f1e 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,36 +1,43 @@
{- git-annex main program
- -}
+import Control.Monad.State
import System.IO
import System.Environment
import Control.Exception
import CmdLine
+import Types
import Annex
main = do
args <- getArgs
- (mode, files) <- argvToMode args
-
+ (mode, params) <- argvToMode args
state <- startAnnex
+ tryRun state mode 0 0 params
- tryRun 0 0 $ map (\f -> dispatch state mode f) files
-
-{- Tries to run a series of actions, not stopping if some error out,
- - and propigating an overall error status at the end. -}
-tryRun errnum oknum [] = do
+{- Processes each param in the list by dispatching the handler function
+ - for the user-selection operation mode. Catches exceptions, not stopping
+ - if some error out, and propigates an overall error status at the end.
+ -
+ - This runs in the IO monad, not in the Annex monad. It seems that
+ - exceptions can only be caught in the IO monad, not in a stacked monad;
+ - or more likely I missed an easy way to do it. So, I have to laboriously
+ - thread AnnexState through this function.
+ -}
+tryRun :: AnnexState -> Mode -> Int -> Int -> [String] -> IO ()
+tryRun state mode errnum oknum [] = do
if (errnum > 0)
then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok"
else return ()
-tryRun errnum oknum (a:as) = do
- result <- try (a)::IO (Either SomeException ())
+tryRun state mode errnum oknum (f:fs) = do
+ result <- try (runAnnexState state (dispatch mode f))::IO (Either SomeException ((), AnnexState))
case (result) of
Left err -> do
showErr err
- tryRun (errnum + 1) oknum as
- Right _ -> tryRun errnum (oknum + 1) as
+ tryRun state mode (errnum + 1) oknum fs
+ Right (_,state') -> tryRun state' mode errnum (oknum + 1) fs
{- Exception pretty-printing. -}
-showErr :: SomeException -> IO ()
showErr e = do
hPutStrLn stderr $ "git-annex: " ++ (show e)
return ()