Merge pull request #1970 from github/bump-effects

Bump `effects` version.

src/Parsing/TreeSitter.hs

@@ -4,25 +4,26 @@ module Parsing.TreeSitter
 , parseToAST
 ) where
 
-import Prologue
+import Prologue hiding (bracket)
+
+import           Control.Concurrent.Async
+import qualified Control.Exception as Exc (bracket)
+import           Control.Monad.Effect
+import           Control.Monad.Effect.Exception
+import           Control.Monad.Effect.Trace
+import           Control.Monad.IO.Class
+import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
+import           Foreign
+import           Foreign.C.Types (CBool (..))
+import           Foreign.Marshal.Array (allocaArray)
+import           System.Timeout
 
-import Control.Concurrent.Async
-import Control.Exception (throwIO)
-import Control.Monad.Effect
-import Control.Monad.Effect.Trace
-import Control.Monad.IO.Class
 import Data.AST (AST, Node (Node))
 import Data.Blob
-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
 import Data.Range
 import Data.Source
 import Data.Span
 import Data.Term
-import Foreign
-import Foreign.C.Types (CBool (..))
-import Foreign.Marshal.Array (allocaArray)
-import Semantic.IO hiding (Source)
-import System.Timeout
 
 import qualified TreeSitter.Language as TS
 import qualified TreeSitter.Node as TS
@@ -53,24 +54,12 @@ runParser parser blobSource  = unsafeUseAsCStringLen (sourceBytes blobSource) $
                 TS.ts_tree_root_node_p treePtr rootPtr
                 ptr <- peek rootPtr
                 Succeeded <$> anaM toAST ptr
-      bracket acquire release go)
-
--- | The semantics of @bracket before after handler@ are as follows:
--- * Exceptions in @before@ and @after@ are thrown in IO.
--- * @after@ is called on IO exceptions in @handler@, and then rethrown in IO.
--- * If @handler@ completes successfully, @after@ is called
--- Call 'catchException' at the call site if you want to recover.
-bracket' :: (Member IO r) => IO a -> (a -> IO b) -> (a -> Eff r c) -> Eff r c
-bracket' before after action = do
-  a <- liftIO before
-  let cleanup = liftIO (after a)
-  res <- action a `catchException` (\(e :: SomeException) -> cleanup >> liftIO (throwIO e))
-  res <$ cleanup
+      Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
 -- Returns Nothing if the operation timed out.
 parseToAST :: (Bounded grammar, Enum grammar, Member IO effects, Member Trace effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar))
-parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do
+parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do
   let parserTimeout = s * 1000
 
   liftIO $ do

src/Semantic/IO.hs

@@ -6,7 +6,6 @@ module Semantic.IO
 , IO.IOMode(..)
 , NoLanguageForBlob(..)
 , Source(..)
-, catchException
 , findFiles
 , findFilesInDir
 , getHandle
@@ -34,7 +33,6 @@ module Semantic.IO
 , write
 ) where
 
-import qualified Control.Exception as Exc
 import           Control.Monad.Effect
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
@@ -231,23 +229,3 @@ runFiles = interpret $ \ files -> case files of
   FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
   Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
   Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
-
-
--- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
---
---   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
-catchException :: ( Exc.Exception e
-                  , Member IO r
-                  )
-               => Eff r a
-               -> (e -> Eff r a)
-               -> Eff r a
-catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m
-
--- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect.
-rethrowing :: ( Member (Exc SomeException) r
-              , Member IO r
-              )
-           => IO a
-           -> Eff r a
-rethrowing m = catchException (liftIO m) (throwError . toException @SomeException)

vendor/effects

@@ -1 +1 @@
-Subproject commit 5db3a4f18ee8a2bf97762a9846b76ca21383126e
+Subproject commit 8181375d6386de302a8c9807dad2f096e8d490aa