Remove SyncUnlift as it can't possibly work

Fixes https://github.com/haskell-effectful/effectful/issues/171.

effectful-core/src/Effectful.hs

@@ -40,7 +40,6 @@ module Effectful
 
     -- ** Unlifting
   , UnliftStrategy(..)
-  , SyncPolicy(..)
   , Persistence(..)
   , Limit(..)
   , unliftStrategy

effectful-core/src/Effectful/Dispatch/Dynamic.hs

@@ -499,7 +499,6 @@ localUnlift (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     seqUnliftIO les $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
-  SyncUnlift _ -> error "SyncUnlift is for unlifting IO computations only"
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO les p l $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
@@ -515,7 +514,6 @@ localUnliftIO
   -> Eff es a
 localUnliftIO (LocalEnv les) strategy k = case strategy of
   SeqUnlift      -> liftIO $ seqUnliftIO les k
-  SyncUnlift p   -> liftIO $ syncUnliftIO les p k
   ConcUnlift p l -> liftIO $ concUnliftIO les p l k
 
 ----------------------------------------
@@ -555,7 +553,6 @@ localLift !_ strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     seqUnliftIO es $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
-  SyncUnlift _ -> error "SyncUnlift is for unlifting IO computations only"
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO es p l $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
@@ -645,7 +642,6 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of
     seqUnliftIO es $ \unliftEs -> do
       seqUnliftIO les $ \unliftLocalEs -> do
         (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
-  SyncUnlift _ -> error "SyncUnlift is for unlifting IO computations only"
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO es p l $ \unliftEs -> do
       concUnliftIO les p l $ \unliftLocalEs -> do
@@ -669,7 +665,6 @@ localLiftUnliftIO
   -> Eff es a
 localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
   SeqUnlift      -> liftIO $ seqUnliftIO les $ k unsafeEff_
-  SyncUnlift p   -> liftIO $ syncUnliftIO les p $ k unsafeEff_
   ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
 
 ----------------------------------------

effectful-core/src/Effectful/Internal/Monad.hs

@@ -40,7 +40,6 @@ module Effectful.Internal.Monad
 
   -- * Unlifting
   , UnliftStrategy(..)
-  , SyncPolicy(..)
   , Persistence(..)
   , Limit(..)
   , unliftStrategy
@@ -51,7 +50,6 @@ module Effectful.Internal.Monad
 
   -- ** Low-level unlifts
   , seqUnliftIO
-  , syncUnliftIO
   , concUnliftIO
 
   -- * Dispatch
@@ -204,7 +202,6 @@ withEffToIO
   -> Eff es a
 withEffToIO strategy f = case strategy of
   SeqUnlift      -> unsafeEff $ \es -> seqUnliftIO es f
-  SyncUnlift p   -> unsafeEff $ \es -> syncUnliftIO es p f
   ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b f
 
 -- | Create an unlifting function with the 'ConcUnlift' strategy.
@@ -231,19 +228,6 @@ seqUnliftIO
   -> IO a
 seqUnliftIO es k = seqUnlift k es unEff
 
--- | Create an unlifting function with the 'SyncUnlift' strategy.
---
--- @since 2.3.0.0
-syncUnliftIO
-  :: HasCallStack
-  => Env es
-  -- ^ The environment.
-  -> SyncPolicy
-  -> ((forall r. Eff es r -> IO r) -> IO a)
-  -- ^ Continuation with the unlifting function in scope.
-  -> IO a
-syncUnliftIO es policy k = syncUnlift policy k es unEff
-
 -- | Create an unlifting function with the 'ConcUnlift' strategy.
 concUnliftIO
   :: HasCallStack
@@ -431,7 +415,6 @@ raiseWith strategy k = case strategy of
     es <- tailEnv ees
     seqUnliftIO ees $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
-  SyncUnlift _ -> error "SyncUnlift is for unlifting IO computations only"
   ConcUnlift p l -> unsafeEff $ \ees -> do
     es <- tailEnv ees
     concUnliftIO ees p l $ \unlift -> do

effectful-core/src/Effectful/Internal/Unlift.hs

@@ -8,19 +8,15 @@
 module Effectful.Internal.Unlift
   ( -- * Unlifting strategies
     UnliftStrategy(..)
-  , SyncPolicy(..)
   , Persistence(..)
   , Limit(..)
 
     -- * Unlifting functions
   , seqUnlift
-  , syncUnlift
   , concUnlift
   ) where
 
 import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception
 import Control.Monad
 import GHC.Conc.Sync (ThreadId(..))
 import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -45,39 +41,12 @@ data UnliftStrategy
   -- ^ The sequential strategy is the fastest and a default setting for
   -- t'Effectful.IOE'. Any attempt of calling the unlifting function in threads
   -- distinct from its creator will result in a runtime error.
-  | SyncUnlift !SyncPolicy
-  -- ^ The synchronized strategy is a middle ground between 'SeqUnlift' and
-  -- 'ConcUnlift'. It allows you to run the unlifting function in any thread as
-  -- long as only one unlifted computation runs at any given time.
-  --
-  -- Especially useful for cases where running unlifted computations in
-  -- different threads is an implementation detail and concurrency is not
-  -- observable from outside.
-  --
-  -- /Note:/ this strategy preserves changes made by unlifted computations to
-  -- thread local state.
-  --
-  -- 'SyncPolicy' determines what happens when you attempt to run an unlifted
-  -- computation while another one is already running.
-  --
-  -- @since 2.3.0.0
   | ConcUnlift !Persistence !Limit
   -- ^ The concurrent strategy makes it possible for the unlifting function to
   -- be called in threads distinct from its creator. See 'Persistence' and
   -- 'Limit' settings for more information.
   deriving (Eq, Generic, Ord, Show)
 
--- | Policy for the 'SyncUnlift' strategy when the unlifting function detects
--- that an unlifted computation is already running.
---
--- @since 2.3.0.0
-data SyncPolicy
-  = SyncError
-  -- ^ Treat such case as an invariant violation and throw an error.
-  | SyncWait
-  -- ^ Wait until the computation finishes.
-  deriving (Eq, Generic, Ord, Show)
-
 -- | Persistence setting for the 'ConcUnlift' strategy.
 --
 -- Different functions require different persistence strategies. Examples:
@@ -138,40 +107,6 @@ seqUnlift k es unEff = do
         ++ "in multiple threads, have a look at the UnliftStrategy (SyncUnlift "
         ++ "or ConcUnlift)."
 
--- | Synchronized unlift.
---
--- @since 2.3.0.0
-syncUnlift
-  :: HasCallStack
-  => SyncPolicy
-  -> ((forall r. m r -> IO r) -> IO a)
-  -> Env es
-  -> (forall r. m r -> Env es -> IO r)
-  -> IO a
-syncUnlift policy k es unEff = do
-  -- Synchronization is tied to the storage of effects so that users don't
-  -- bypass it by creating multiple unlifting functions.
-  syncVar <- syncVarEnv es
-  activeVar <- newTVarIO True
-  let cleanUp = atomically $ do
-        inProgress <- readTVar syncVar
-        -- Wait for any unlifted computation to finish before exiting.
-        when inProgress retry
-        -- Prevent the unlifting function to be used out the scope.
-        writeTVar activeVar False
-  (`finally` cleanUp) $ k $ \m -> do
-    inlineBracket
-      (atomically $ do
-          active <- readTVar activeVar
-          unless active $ error "The unlifted function is no longer active"
-          inProgress <- swapTVar syncVar True
-          when inProgress $ case policy of
-            SyncError -> error "An unlifted computation is already running"
-            SyncWait  -> retry
-      )
-      (\_ -> atomically $ writeTVar syncVar False)
-      (\_ -> unEff m es)
-
 -- | Concurrent unlift.
 concUnlift
   :: HasCallStack

effectful/tests/UnliftTests.hs

@@ -1,25 +1,17 @@
 module UnliftTests (unliftTests) where
 
-import Control.Concurrent
 import Control.Exception
-import Data.Functor
 import Test.Tasty
 import Test.Tasty.HUnit
 import qualified UnliftIO.Async as A
 
 import Effectful
-import Effectful.State.Dynamic
 import qualified Utils as U
 
 unliftTests :: TestTree
 unliftTests = testGroup "Unlift"
   [ testCase "Strategy stays the same in a new thread" test_threadStrategy
   , testCase "SeqUnlift in new thread" test_seqUnliftInNewThread
-  , testGroup "SyncUnlift"
-    [ testCase "SyncError works" test_syncErrorWorks
-    , testCase "SyncError throws when appropriate" test_syncErrorThrows
-    , testCase "SyncWait works" test_syncWaitWorks
-    ]
   , testGroup "Ephemeral strategy"
     [ testCase "Invalid limit" test_ephemeralInvalid
     , testCase "Uses in same thread" test_ephemeralSameThread
@@ -46,33 +38,6 @@ test_seqUnliftInNewThread = runEff $ do
     withEffToIO SeqUnlift $ \runInIO -> do
       inThread $ runInIO $ return ()
 
-test_syncErrorWorks :: Assertion
-test_syncErrorWorks = runEff . evalStateLocal @Int 1 $ do
-  modifyFromAsync (*2)
-  modifyFromAsync (*3)
-  U.assertEqual "correct state" 6 =<< get @Int
-  where
-    modifyFromAsync f = withEffToIO (SyncUnlift SyncError) $ \runInIO -> do
-      void . A.async . runInIO $ liftIO (threadDelay 10000) >> modify @Int f
-      -- Wait for the async action to start, but try exiting the scope of
-      -- withEffToIO before the unlifted computation had a chance to finish to
-      -- check that it waits until it does.
-      threadDelay 1000
-
-test_syncErrorThrows :: Assertion
-test_syncErrorThrows = runEff $ do
-  assertThrowsUnliftError "Sync error" $ do
-    withEffToIO (SyncUnlift SyncError) $ \runInIO -> do
-      A.race_ (runInIO . liftIO $ threadDelay 10000)
-              (runInIO . liftIO $ threadDelay 10000)
-
-test_syncWaitWorks :: Assertion
-test_syncWaitWorks = runEff . evalStateLocal @Int 0 $ do
-  withEffToIO (SyncUnlift SyncWait) $ \runInIO -> do
-    -- SyncUnlift SyncWait turns concurrent code into sequential code.
-    A.replicateConcurrently_ 100 $ runInIO $ modify @Int (+1)
-  U.assertEqual "correct state" 100 =<< get @Int
-
 test_ephemeralInvalid :: Assertion
 test_ephemeralInvalid = runEff $ do
   assertThrowsUnliftError "InvalidNumberOfUses error" $ do