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

@ -79,17 +79,15 @@ initSpecialRemote name remotetype mcreds config = go 0
go :: Int -> Annex RemoteName
go n = do
let fullname = if n == 0 then name else name ++ show n
r <- Annex.SpecialRemote.findExisting fullname
case r of
Annex.SpecialRemote.findExisting fullname >>= \case
Nothing -> setupSpecialRemote fullname remotetype config mcreds
(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname)
Just _ -> go (n + 1)
{- Enables an existing special remote. -}
enableSpecialRemote :: SpecialRemoteMaker
enableSpecialRemote name remotetype mcreds config = do
r <- Annex.SpecialRemote.findExisting name
case r of
enableSpecialRemote name remotetype mcreds config =
Annex.SpecialRemote.findExisting name >>= \case
Nothing -> error $ "Cannot find a special remote named " ++ name
Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c)

View file

@ -35,9 +35,8 @@ import qualified Data.Text as T
- Named threads are run by a management thread, so if they crash
- an alert is displayed, allowing the thread to be restarted. -}
startNamedThread :: UrlRenderer -> NamedThread -> Assistant ()
startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do
m <- startedThreads <$> getDaemonStatus
case M.lookup name m of
startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) =
M.lookup name . startedThreads <$> getDaemonStatus >>= \case
Nothing -> start
Just (aid, _) -> do
r <- liftIO (E.try (poll aid) :: IO (Either E.SomeException (Maybe (Either E.SomeException ()))))
@ -65,24 +64,22 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do
a
void $ forkIO $ manager d aid
return aid
manager d aid = do
r <- E.try (wait aid) :: IO (Either E.SomeException ())
case r of
Right _ -> noop
Left e -> do
let msg = unwords
[ fromThreadName $ threadName d
, "crashed:", show e
]
hPutStrLn stderr msg
manager d aid = (E.try (wait aid) :: IO (Either E.SomeException ())) >>= \case
Right _ -> noop
Left e -> do
let msg = unwords
[ fromThreadName $ threadName d
, "crashed:", show e
]
hPutStrLn stderr msg
#ifdef WITH_WEBAPP
button <- runAssistant d $ mkAlertButton True
(T.pack "Restart Thread")
urlrenderer
(RestartThreadR name)
runAssistant d $ void $ addAlert $
(warningAlert (fromThreadName name) msg)
{ alertButtons = [button] }
button <- runAssistant d $ mkAlertButton True
(T.pack "Restart Thread")
urlrenderer
(RestartThreadR name)
runAssistant d $ void $ addAlert $
(warningAlert (fromThreadName name) msg)
{ alertButtons = [button] }
#endif
namedThreadId :: NamedThread -> Assistant (Maybe ThreadId)