1
1
mirror of https://github.com/github/semantic.git synced 2025-01-01 11:46:14 +03:00
This commit is contained in:
Patrick Thomson 2019-05-15 18:29:47 -04:00
parent 0197e40f38
commit ad070aa1ab
2 changed files with 3 additions and 3 deletions

View File

@ -60,7 +60,7 @@ instance Carrier (Distribute :+: Lift IO) (DistributeC (LiftC IO)) where
eff (R other) = DistributeC (eff (handleCoercible other))
instance MonadUnliftIO m => MonadUnliftIO (DistributeC m) where
askUnliftIO = DistributeC $ withUnliftIO $ \u -> return (UnliftIO (unliftIO u . runDistributeC))
askUnliftIO = DistributeC $ withUnliftIO $ \u -> pure (UnliftIO (unliftIO u . runDistributeC))
{-# INLINE askUnliftIO #-}
withRunInIO inner = DistributeC $ withRunInIO $ \run -> inner (run . runDistributeC)
{-# INLINE withRunInIO #-}

View File

@ -116,6 +116,6 @@ findFiles dir exts paths = send (FindFiles dir exts paths pure)
write :: (Member Files sig, Carrier sig m) => Destination -> B.Builder -> m ()
write dest builder = send (Write dest builder (pure ()))
-- | Catch exceptions thrown in 'IO' and rethrow them in an 'Error' effect.
-- | Catch synchronous exceptions thrown in 'IO' and rethrow them in an 'Error' effect.
rethrowing :: (Member Catch sig, Member (Error SomeException) sig, Carrier sig m) => m a -> m a
rethrowing act = act `catchSync` (throwError @SomeException)
rethrowing act = act `catchSync` throwError @SomeException