From 2caf711827470976f935bb06bb3b6b87e1776299 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 19 Oct 2010 01:46:20 -0400
Subject: stop trapping all exceptions

Need to allow exceptions to be thrown for SIGPIPE propigation.

Converted places that used error unncessarily to not.
---
 Commands.hs  | 26 ++++++++++++--------------
 git-annex.hs | 10 +++++-----
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/Commands.hs b/Commands.hs
index fab72160a..115c3b3ed 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -101,21 +101,19 @@ parseCmd argv state = do
  - the annex directory and setting up the symlink pointing to its content. -}
 addCmd :: FilePath -> Annex ()
 addCmd file = inBackend file $ do
-	liftIO $ checkLegal file
-	showStart "add" file
-	g <- Annex.gitRepo
-	stored <- Backend.storeFileKey file
-	case (stored) of
-		Nothing -> showEndFail "no backend could store" file
-		Just (key, backend) -> do
-			logStatus key ValuePresent
-			setup g key
+	s <- liftIO $ getSymbolicLinkStatus file
+	if ((isSymbolicLink s) || (not $ isRegularFile s))
+		then return ()
+		else do
+			showStart "add" file
+			g <- Annex.gitRepo
+			stored <- Backend.storeFileKey file
+			case (stored) of
+				Nothing -> showEndFail "no backend could store" file
+				Just (key, backend) -> do
+					logStatus key ValuePresent
+					setup g key
 	where
-		checkLegal file = do
-			s <- getSymbolicLinkStatus file
-			if ((isSymbolicLink s) || (not $ isRegularFile s))
-				then error $ "not a regular file: " ++ file
-				else return ()
 		setup g key = do
 			let dest = annexLocation g key
 			liftIO $ createDirectoryIfMissing True (parentDir dest)
diff --git a/git-annex.hs b/git-annex.hs
index 947868f23..71a21379d 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,6 +1,6 @@
 {- git-annex main program -}
 
-import Control.Exception
+import IO (try)
 import System.IO
 import System.Environment
 
@@ -18,8 +18,9 @@ main = do
 	(flags, actions) <- parseCmd args state
 	tryRun state $ [startup flags] ++ 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.
+{- Runs a list of Annex actions. Catches IO errors and continues
+ - (but explicitly thrown errors terminate the whole command).
+ - 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;
@@ -29,8 +30,7 @@ main = do
 tryRun :: AnnexState -> [Annex ()] -> IO ()
 tryRun state actions = tryRun' state 0 actions
 tryRun' state errnum (a:as) = do
-	result <- try
-		(Annex.run state a)::IO (Either SomeException ((), AnnexState))
+	result <- try $ Annex.run state a
 	case (result) of
 		Left err -> do
 			showErr err
-- 
cgit v1.2.3