more lambda-case conversion

This commit is contained in:
Joey Hess 2017-12-05 15:00:50 -04:00
parent 936d50310d
commit fc845e6530
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
29 changed files with 137 additions and 199 deletions

View file

@ -98,31 +98,25 @@ start file = do
)
where
go = ifAnnexed file addpresent add
add = do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Nothing -> stop
Just s
| not (isRegularFile s) && not (isSymbolicLink s) -> stop
| otherwise -> do
showStart "add" file
next $ if isSymbolicLink s
then next $ addFile file
else perform file
add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Nothing -> stop
Just s
| not (isRegularFile s) && not (isSymbolicLink s) -> stop
| otherwise -> do
showStart "add" file
next $ if isSymbolicLink s
then next $ addFile file
else perform file
addpresent key = ifM versionSupportsUnlockedPointers
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
( stop, add )
( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
( stop, add )
, ifM isDirect
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (goodContent key file)
( stop , add )
( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (goodContent key file)
( stop , add )
, fixuplink key
)
)

View file

@ -274,9 +274,8 @@ downloadWeb o url urlinfo file =
finishDownloadWith tmp webUUID url file
tryyoutubedl tmp = withTmpWorkDir mediakey $ \workdir ->
Transfer.notifyTransfer Transfer.Download url $
Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p -> do
dl <- youtubeDl url workdir
case dl of
Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p ->
youtubeDl url workdir >>= \case
Right (Just mediafile) -> do
pruneTmpWorkDirBefore tmp (liftIO . nukeFile)
let dest = if isJust (fileOption o)
@ -338,8 +337,7 @@ finishDownloadWith tmp u url file = do
, contentLocation = tmp
, inodeCache = Nothing
}
k <- genKey source backend
case k of
genKey source backend >>= \case
Nothing -> return Nothing
Just (key, _) -> do
addWorkTree u url file key (Just tmp)

View file

@ -19,10 +19,8 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
(batchable run (pure ()))
run :: () -> String -> Annex Bool
run _ file = do
mkb <- genKey (KeySource file file Nothing) Nothing
case mkb of
Just (k, _) -> do
liftIO $ putStrLn $ key2file k
return True
Nothing -> return False
run _ file = genKey (KeySource file file Nothing) Nothing >>= \case
Just (k, _) -> do
liftIO $ putStrLn $ key2file k
return True
Nothing -> return False

View file

@ -52,12 +52,10 @@ check ks mr = case mr of
k = toKey ks
go Nothing [] = return NotPresent
go (Just e) [] = return $ CheckFailure e
go olderr (r:rs) = do
v <- Remote.hasKey r k
case v of
Right True -> return Present
Right False -> go olderr rs
Left e -> go (Just e) rs
go olderr (r:rs) = Remote.hasKey r k >>= \case
Right True -> return Present
Right False -> go olderr rs
Left e -> go (Just e) rs
exitResult :: Result -> Annex a
exitResult Present = liftIO exitSuccess

View file

@ -62,9 +62,8 @@ seek (UnsetConfig name) = commandAction $ do
unsetGlobalConfig name
unsetConfig (ConfigKey name)
return True
seek (GetConfig name) = commandAction $ do
mv <- getGlobalConfig name
case mv of
seek (GetConfig name) = commandAction $
getGlobalConfig name >>= \case
Nothing -> stop
Just v -> do
liftIO $ putStrLn v

View file

@ -34,8 +34,7 @@ seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
startKey :: Key -> CommandStart
startKey key = do
showStart' "dead" (Just $ key2file key)
ls <- keyLocations key
case ls of
keyLocations key >>= \case
[] -> next $ performKey key
_ -> giveup "This key is still known to be present in some locations; not marking as dead."

View file

@ -47,13 +47,11 @@ perform = do
next cleanup
where
go = whenAnnexed $ \f k -> do
r <- toDirectGen k f
case r of
toDirectGen k f >>= \case
Nothing -> noop
Just a -> do
showStart "direct" f
r' <- tryNonAsync a
case r' of
tryNonAsync a >>= \case
Left e -> warnlocked e
Right _ -> showEndOk
return Nothing

View file

@ -68,8 +68,7 @@ startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remo
startSpecialRemote name config Nothing = do
m <- Annex.SpecialRemote.specialRemoteMap
confm <- Logs.Remote.readRemoteLog
v <- Remote.nameToUUID' name
case v of
Remote.nameToUUID' name >>= \case
Right u | u `M.member` m ->
startSpecialRemote name config $
Just (u, fromMaybe M.empty (M.lookup u confm))
@ -91,8 +90,7 @@ performSpecialRemote t u oldc c gc = do
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
cleanupSpecialRemote u c = do
Logs.Remote.configSet u c
mr <- Remote.byUUID u
case mr of
Remote.byUUID u >>= \case
Nothing -> noop
Just r -> setRemoteIgnore (R.repo r) False
return True

View file

@ -91,8 +91,7 @@ checkHiddenService = bracket setup cleanup go
g <- Annex.gitRepo
-- Connect but don't bother trying to auth,
-- we just want to know if the tor circuit works.
cv <- liftIO $ tryNonAsync $ connectPeer g addr
case cv of
liftIO (tryNonAsync $ connectPeer g addr) >>= \case
Left e -> do
warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
liftIO $ threadDelaySeconds (Seconds 2)

View file

@ -82,8 +82,7 @@ makeHardLink :: FilePath -> Key -> CommandPerform
makeHardLink file key = do
replaceFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
r <- linkFromAnnex key tmp mode
case r of
linkFromAnnex key tmp mode >>= \case
LinkAnnexFailed -> error "unable to make hard link"
_ -> noop
next $ return True

View file

@ -103,15 +103,13 @@ checkDeadRepo u =
earlyWarning "Warning: Fscking a repository that is currently marked as dead."
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
start from inc file key = do
v <- Backend.getBackend file key
case v of
Nothing -> stop
Just backend -> do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key afile backend numcopies r
start from inc file key = Backend.getBackend file key >>= \case
Nothing -> stop
Just backend -> do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key afile backend numcopies r
where
go = runFsck inc (mkActionItem afile) key
afile = AssociatedFile (Just file)
@ -142,9 +140,8 @@ performRemote key afile backend numcopies remote =
dispatch (Left err) = do
showNote err
return False
dispatch (Right True) = withtmp $ \tmpfile -> do
r <- getfile tmpfile
case r of
dispatch (Right True) = withtmp $ \tmpfile ->
getfile tmpfile >>= \case
Nothing -> go True Nothing
Just True -> go True (Just tmpfile)
Just False -> do