flip catchDefaultIO

Annex/Branch.hs

@@ -322,7 +322,7 @@ needUpdateIndex :: Git.Ref -> Annex Bool
 needUpdateIndex branchref = do
 	lock <- fromRepo gitAnnexIndexLock
 	lockref <- Git.Ref . firstLine <$>
-		liftIO (catchDefaultIO (readFileStrict lock) "")
+		liftIO (catchDefaultIO "" $ readFileStrict lock)
 	return (lockref /= branchref)
 
 {- Record that the branch's index has been updated to correspond to a

Annex/Content.hs

@@ -280,7 +280,7 @@ getKeysPresent :: Annex [Key]
 getKeysPresent = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir
 	where
 		traverse depth dir = do
-			contents <- catchDefaultIO (dirContents dir) []
+			contents <- catchDefaultIO [] (dirContents dir)
 			if depth == 0
 				then continue (mapMaybe (fileKey . takeFileName) contents) []
 				else do

Annex/Journal.hs

@@ -47,8 +47,8 @@ getJournalledFiles = map fileJournal <$> getJournalFiles
 getJournalFiles :: Annex [FilePath]
 getJournalFiles = do
 	g <- gitRepo
-	fs <- liftIO $
+	fs <- liftIO $ catchDefaultIO [] $
-		catchDefaultIO (getDirectoryContents $ gitAnnexJournalDir g) []
+		getDirectoryContents $ gitAnnexJournalDir g
 	return $ filter (`notElem` [".", ".."]) fs
 
 {- Checks if there are changes in the journal. -}

Annex/Ssh.hs

@@ -71,7 +71,7 @@ sshCleanup :: Annex ()
 sshCleanup = do
 	dir <- fromRepo gitAnnexSshDir
 	sockets <- filter (not . isLock) <$>
-		liftIO (catchDefaultIO (dirContents dir) [])
+		liftIO (catchDefaultIO [] $ dirContents dir)
 	forM_ sockets cleanup
 	where
 		cleanup socketfile = do

Assistant/DaemonStatus.hs

@@ -108,7 +108,7 @@ startDaemonStatus :: Annex DaemonStatusHandle
 startDaemonStatus = do
 	file <- fromRepo gitAnnexDaemonStatusFile
 	status <- liftIO $
-		catchDefaultIO (readDaemonStatusFile file) =<< newDaemonStatus
+		flip catchDefaultIO (readDaemonStatusFile file) =<< newDaemonStatus
 	transfers <- M.fromList <$> getTransfers
 	remotes <- calcKnownRemotes
 	liftIO $ atomically $ newTMVar status

Assistant/Pairing/MakeRemote.hs

@@ -78,7 +78,8 @@ bestHostName :: PairMsg -> IO HostName
 bestHostName msg = case remoteHostName $ pairMsgData msg of
 	Just h -> do
 		let localname = h ++ ".local"
-		addrs <- catchDefaultIO (getAddrInfo Nothing (Just localname) Nothing) []
+		addrs <- catchDefaultIO [] $
+			getAddrInfo Nothing (Just localname) Nothing
 		maybe fallback (const $ return localname) (headMaybe addrs)
 	Nothing -> fallback
 	where
@@ -88,4 +89,5 @@ bestHostName msg = case remoteHostName $ pairMsgData msg of
 				IPv4Addr addr -> SockAddrInet (PortNum 0) addr
 				IPv6Addr addr -> SockAddrInet6 (PortNum 0) 0 addr 0
 			fromMaybe (showAddr a)
-				<$> catchDefaultIO (fst <$> getNameInfo [] True False sockaddr) Nothing
+				<$> catchDefaultIO Nothing
+					(fst <$> getNameInfo [] True False sockaddr)

Build/InstallDesktopFile.hs

@@ -49,7 +49,7 @@ isRoot = do
 
 inDestDir :: FilePath -> IO FilePath
 inDestDir f = do
-	destdir <- catchDefaultIO (getEnv "DESTDIR") ""
+	destdir <- catchDefaultIO "" (getEnv "DESTDIR")
 	return $ destdir </> f
 
 writeFDODesktop :: FilePath -> IO ()

Git/Command.hs

@@ -79,7 +79,7 @@ pipeNullSplit params repo =
 reap :: IO ()
 reap = do
 	-- throws an exception when there are no child processes
-	catchDefaultIO (getAnyProcessStatus False True) Nothing
+	catchDefaultIO Nothing (getAnyProcessStatus False True)
 		>>= maybe noop (const reap)
 
 {- Runs a git command as a coprocess. -}

Git/Construct.hs

@@ -224,7 +224,7 @@ checkForRepo dir =
 			<&&> doesDirectoryExist (dir </> "objects")
 		gitDirFile = do
 			c <- firstLine <$>
-				catchDefaultIO (readFile $ dir </> ".git") ""
+				catchDefaultIO "" (readFile $ dir </> ".git")
 			return $ if gitdirprefix `isPrefixOf` c
 				then Just $ Local 
 					{ gitdir = drop (length gitdirprefix) c

GitAnnexShell.hs

@@ -132,5 +132,5 @@ checkNotReadOnly cmd
 
 checkEnv :: String -> IO ()
 checkEnv var =
-	whenM (not . null <$> catchDefaultIO (getEnv var) "") $
+	whenM (not . null <$> catchDefaultIO "" (getEnv var)) $
 		error $ "Action blocked by " ++ var

Locations/UserConfig.hs

@@ -28,4 +28,4 @@ programFile = userConfigFile "program"
 readProgramFile :: IO FilePath
 readProgramFile = do
 	programfile <- programFile
-	catchDefaultIO (readFile programfile) "git-annex"
+	catchDefaultIO "git-annex" $ readFile programfile

Logs/Transfer.hs

@@ -134,9 +134,8 @@ checkTransfer t = do
 			liftIO $ closeFd fd
 			case locked of
 				Nothing -> return Nothing
-				Just (pid, _) -> liftIO $
+				Just (pid, _) -> liftIO $ catchDefaultIO Nothing $
-					flip catchDefaultIO Nothing $
+					readTransferInfoFile (Just pid) tfile
-						readTransferInfoFile (Just pid) tfile
 
 {- Gets all currently running transfers. -}
 getTransfers :: Annex [(Transfer, TransferInfo)]

Upgrade/V1.hs

@@ -180,7 +180,8 @@ writeLog1 :: FilePath -> [LogLine] -> IO ()
 writeLog1 file ls = viaTmp writeFile file (showLog ls)
 
 readLog1 :: FilePath -> IO [LogLine]
-readLog1 file = catchDefaultIO (parseLog <$> readFileStrict file) []
+readLog1 file = catchDefaultIO [] $
+	parseLog <$> readFileStrict file
 
 lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile1 file = do

Upgrade/V2.hs

@@ -71,7 +71,7 @@ locationLogs = do
 		files <- mapM tryDirContents (concat levelb)
 		return $ mapMaybe islogfile (concat files)
 	where
-		tryDirContents d = catchDefaultIO (dirContents d) []
+		tryDirContents d = catchDefaultIO [] $ dirContents d
 		islogfile f = maybe Nothing (\k -> Just (k, f)) $
 				logFileKey $ takeFileName f
 

Utility/Directory.hs

@@ -43,7 +43,7 @@ dirContentsRecursive topdir = dirContentsRecursive' topdir [""]
 dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
 dirContentsRecursive' _ [] = return []
 dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
-	(files, dirs') <- collect [] [] =<< catchDefaultIO (dirContents (topdir </> dir)) []
+	(files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents (topdir </> dir))
 	files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
 	return (files ++ files')
 	where

Utility/Exception.hs

@@ -13,15 +13,15 @@ import Control.Applicative
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO a False
+catchBoolIO a = catchDefaultIO False a
 
 {- Catches IO errors and returns a Maybe -}
 catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
+catchMaybeIO a = catchDefaultIO Nothing $ Just <$> a
 
 {- Catches IO errors and returns a default value. -}
-catchDefaultIO :: IO a -> a -> IO a
+catchDefaultIO :: a -> IO a -> IO a
-catchDefaultIO a def = catchIO a (const $ return def)
+catchDefaultIO def a = catchIO a (const $ return def)
 
 {- Catches IO errors and returns the error message. -}
 catchMsgIO :: IO a -> IO (Either String a)

Utility/FreeDesktop.hs

@@ -123,4 +123,5 @@ userDesktopDir = maybe fallback return =<< (parse <$> xdg_user_dir)
 xdgEnvHome :: String -> String -> IO String
 xdgEnvHome envbase homedef = do
 	home <- myHomeDir
-	catchDefaultIO (getEnv $ "XDG_" ++ envbase) (home </> homedef)
+	catchDefaultIO (home </> homedef) $
+		getEnv $ "XDG_" ++ envbase

Utility/TempFile.hs

@@ -34,7 +34,7 @@ withTempFile :: Template -> (FilePath -> Handle -> IO a) -> IO a
 withTempFile template a = bracket create remove use
 	where
 		create = do
-			tmpdir <- catchDefaultIO getTemporaryDirectory "."
+			tmpdir <- catchDefaultIO "." getTemporaryDirectory
 			openTempFile tmpdir template
 		remove (name, handle) = do
 			hClose handle
@@ -48,7 +48,7 @@ withTempDir template = bracket create remove
 	where
 		remove = removeDirectoryRecursive
 		create = do
-			tmpdir <- catchDefaultIO getTemporaryDirectory "."
+			tmpdir <- catchDefaultIO "." getTemporaryDirectory
 			createDirectoryIfMissing True tmpdir
 			pid <- getProcessID
 			makedir tmpdir (template ++ show pid) (0 :: Int)