flip catchDefaultIO
This commit is contained in:
parent
ba744c84a4
commit
e8188ea611
18 changed files with 29 additions and 26 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -47,8 +47,8 @@ getJournalledFiles = map fileJournal <$> getJournalFiles
|
|||
getJournalFiles :: Annex [FilePath]
|
||||
getJournalFiles = do
|
||||
g <- gitRepo
|
||||
fs <- liftIO $
|
||||
catchDefaultIO (getDirectoryContents $ gitAnnexJournalDir g) []
|
||||
fs <- liftIO $ catchDefaultIO [] $
|
||||
getDirectoryContents $ gitAnnexJournalDir g
|
||||
return $ filter (`notElem` [".", ".."]) fs
|
||||
|
||||
{- Checks if there are changes in the journal. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -28,4 +28,4 @@ programFile = userConfigFile "program"
|
|||
readProgramFile :: IO FilePath
|
||||
readProgramFile = do
|
||||
programfile <- programFile
|
||||
catchDefaultIO (readFile programfile) "git-annex"
|
||||
catchDefaultIO "git-annex" $ readFile programfile
|
||||
|
|
|
@ -134,9 +134,8 @@ checkTransfer t = do
|
|||
liftIO $ closeFd fd
|
||||
case locked of
|
||||
Nothing -> return Nothing
|
||||
Just (pid, _) -> liftIO $
|
||||
flip catchDefaultIO Nothing $
|
||||
readTransferInfoFile (Just pid) tfile
|
||||
Just (pid, _) -> liftIO $ catchDefaultIO Nothing $
|
||||
readTransferInfoFile (Just pid) tfile
|
||||
|
||||
{- Gets all currently running transfers. -}
|
||||
getTransfers :: Annex [(Transfer, TransferInfo)]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 def = catchIO a (const $ return def)
|
||||
catchDefaultIO :: a -> IO a -> IO a
|
||||
catchDefaultIO def a = catchIO a (const $ return def)
|
||||
|
||||
{- Catches IO errors and returns the error message. -}
|
||||
catchMsgIO :: IO a -> IO (Either String a)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue