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

@ -186,13 +186,11 @@ allowConcurrentOutput = id
onlyActionOn :: Key -> CommandStart -> CommandStart
onlyActionOn k a = onlyActionOn' k run
where
run = do
-- Run whole action, not just start stage, so other threads
-- block until it's done.
r <- callCommandAction' a
case r of
Nothing -> return Nothing
Just r' -> return $ Just $ return $ Just $ return r'
-- Run whole action, not just start stage, so other threads
-- block until it's done.
run = callCommandAction' a >>= \case
Nothing -> return Nothing
Just r' -> return $ Just $ return $ Just $ return r'
onlyActionOn' :: Key -> Annex a -> Annex a
onlyActionOn' k a = go =<< Annex.getState Annex.concurrency

View file

@ -21,12 +21,10 @@ checkNotReadOnly :: IO ()
checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY"
checkEnv :: String -> IO ()
checkEnv var = do
v <- getEnv var
case v of
Nothing -> noop
Just "" -> noop
Just _ -> giveup $ "Action blocked by " ++ var
checkEnv var = getEnv var >>= \case
Nothing -> noop
Just "" -> noop
Just _ -> giveup $ "Action blocked by " ++ var
checkDirectory :: Maybe FilePath -> IO ()
checkDirectory mdir = do

View file

@ -19,14 +19,12 @@ import P2P.Address
import P2P.Auth
run :: [String] -> IO ()
run (_remotename:address:[]) = forever $ do
-- gitremote-helpers protocol
l <- getLine
case l of
run (_remotename:address:[]) = forever $
getLine >>= \case
"capabilities" -> putStrLn "connect" >> ready
"connect git-upload-pack" -> go UploadPack
"connect git-receive-pack" -> go ReceivePack
_ -> error $ "git-remote-helpers protocol error at " ++ show l
l -> error $ "git-remote-helpers protocol error at " ++ show l
where
(onionaddress, onionport)
| '/' `elem` address = parseAddressPort $
@ -59,8 +57,6 @@ connectService address port service = do
myuuid <- getUUID
g <- Annex.gitRepo
conn <- liftIO $ connectPeer g (TorAnnex address port)
liftIO $ runNetProto conn $ do
v <- auth myuuid authtoken
case v of
Just _theiruuid -> connect service stdin stdout
Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv
liftIO $ runNetProto conn $ auth myuuid authtoken >>= \case
Just _theiruuid -> connect service stdin stdout
Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv

View file

@ -84,8 +84,7 @@ withFilesInRefs a = mapM_ go
(l, cleanup) <- inRepo $ LsTree.lsTree r
forM_ l $ \i -> do
let f = getTopFilePath $ LsTree.file i
v <- catKey (LsTree.sha i)
case v of
catKey (LsTree.sha i) >>= \case
Nothing -> noop
Just k -> whenM (matcher $ MatchingKey k) $
commandAction $ a f k