more lambda-case conversion
This commit is contained in:
parent
936d50310d
commit
fc845e6530
29 changed files with 137 additions and 199 deletions
|
@ -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
|
||||
)
|
||||
)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue