Add SeqForkUnlift strategy (#224)

effectful-core/CHANGELOG.md

@@ -15,6 +15,8 @@
   experience.
 * Properly roll back changes made to the environment when `OnEmptyRollback`
   policy for the `NonDet` effect is selected.
+* Add a `SeqForkUnlift` strategy to support running unlifting functions outside
+  of the scope of effects they capture.
 * **Breaking changes**:
   - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a
     list of effects instead of a single one.

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

@@ -739,6 +739,9 @@ localUnlift (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     seqUnliftIO les $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
+  SeqForkUnlift -> unsafeEff $ \es -> do
+    seqForkUnliftIO les $ \unlift -> do
+      (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO les p l $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
@@ -755,6 +758,7 @@ localUnliftIO
   -> Eff es a
 localUnliftIO (LocalEnv les) strategy k = case strategy of
   SeqUnlift      -> liftIO $ seqUnliftIO les k
+  SeqForkUnlift  -> liftIO $ seqForkUnliftIO les k
   ConcUnlift p l -> liftIO $ concUnliftIO les p l k
 {-# INLINE localUnliftIO #-}
 
@@ -795,6 +799,9 @@ localLift !_ strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     seqUnliftIO es $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
+  SeqForkUnlift -> unsafeEff $ \es -> do
+    seqForkUnliftIO es $ \unlift -> do
+      (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO es p l $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
@@ -885,6 +892,10 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of
     seqUnliftIO es $ \unliftEs -> do
       seqUnliftIO les $ \unliftLocalEs -> do
         (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
+  SeqForkUnlift -> unsafeEff $ \es -> do
+    seqForkUnliftIO es $ \unliftEs -> do
+      seqForkUnliftIO les $ \unliftLocalEs -> do
+        (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
   ConcUnlift p l -> unsafeEff $ \es -> do
     concUnliftIO es p l $ \unliftEs -> do
       concUnliftIO les p l $ \unliftLocalEs -> do
@@ -909,6 +920,7 @@ localLiftUnliftIO
   -> Eff es a
 localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
   SeqUnlift      -> liftIO $ seqUnliftIO les $ k unsafeEff_
+  SeqForkUnlift  -> liftIO $ seqForkUnliftIO les $ k unsafeEff_
   ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
 {-# INLINE localLiftUnliftIO #-}
 
@@ -987,6 +999,9 @@ localLend (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     eles <- copyRefs @lentEs es les
     seqUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift
+  SeqForkUnlift -> unsafeEff $ \es -> do
+    eles <- copyRefs @lentEs es les
+    seqForkUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \es -> do
     eles <- copyRefs @lentEs es les
     concUnliftIO eles p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift
@@ -1025,6 +1040,9 @@ localBorrow (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
     ees <- copyRefs @borrowedEs les es
     seqUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift
+  SeqForkUnlift -> unsafeEff $ \es -> do
+    ees <- copyRefs @borrowedEs les es
+    seqForkUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \es -> do
     ees <- copyRefs @borrowedEs les es
     concUnliftIO ees p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift

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

@@ -383,7 +383,10 @@ getLocation (Env offset refs storage) = do
   -- referenced.
   when (version /= storageVersion) $ do
     error $ "version (" ++ show version ++ ") /= storageVersion ("
-         ++ show storageVersion ++ ")"
+         ++ show storageVersion ++ ")\n"
+         ++ "If you're attempting to run an unlifting function outside "
+         ++ "of the scope of effects it captures, have a look at "
+         ++ "UnliftingStrategy (SeqForkUnlift)."
   pure (ref, es)
 
 ----------------------------------------

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

@@ -50,6 +50,7 @@ module Effectful.Internal.Monad
 
   -- ** Low-level unlifts
   , seqUnliftIO
+  , seqForkUnliftIO
   , concUnliftIO
 
   -- * Dispatch
@@ -203,6 +204,7 @@ withEffToIO
   -> Eff es a
 withEffToIO strategy k = case strategy of
   SeqUnlift      -> unsafeEff $ \es -> seqUnliftIO es k
+  SeqForkUnlift  -> unsafeEff $ \es -> seqForkUnliftIO es k
   ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b k
 {-# INLINE withEffToIO #-}
 
@@ -238,6 +240,16 @@ seqUnliftIO es k = do
          $ "If you want to use the unlifting function to run Eff computations "
         ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
 
+-- | Create an unlifting function with the 'SeqForkUnlift' strategy.
+seqForkUnliftIO
+  :: HasCallStack
+  => Env es
+  -- ^ The environment.
+  -> ((forall r. Eff es r -> IO r) -> IO a)
+  -- ^ Continuation with the unlifting function in scope.
+  -> IO a
+seqForkUnliftIO es0 k = cloneEnv es0 >>= \es -> seqUnliftIO es k
+
 -- | Create an unlifting function with the 'ConcUnlift' strategy.
 concUnliftIO
   :: HasCallStack
@@ -428,6 +440,10 @@ raiseWith strategy k = case strategy of
     es <- tailEnv ees
     seqUnliftIO ees $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
+  SeqForkUnlift -> unsafeEff $ \ees -> do
+    es <- tailEnv ees
+    seqForkUnliftIO ees $ \unlift -> do
+      (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \ees -> do
     es <- tailEnv ees
     concUnliftIO ees p l $ \unlift -> do

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

@@ -44,6 +44,54 @@ 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.
+  | SeqForkUnlift
+  -- ^ Like 'SeqUnlift', but all unlifted actions will be executed in a cloned
+  -- environment.
+  --
+  -- The main consequence is that thread local state is forked at the point of
+  -- creation of the unlifting function and its modifications in unlifted
+  -- actions will not affect the main thread of execution (and vice versa):
+  --
+  -- >>> import Effectful
+  -- >>> import Effectful.State.Dynamic
+  -- >>> :{
+  --  action :: (IOE :> es, State Int :> es) => Eff es ()
+  --  action = do
+  --    modify @Int (+1)
+  --    withEffToIO SeqForkUnlift $ \unlift -> unlift $ modify @Int (+2)
+  --    modify @Int (+4)
+  -- :}
+  --
+  -- >>> runEff . execStateLocal @Int 0 $ action
+  -- 5
+  --
+  -- >>> runEff . execStateShared @Int 0 $ action
+  -- 7
+  --
+  -- Because of this it's possible to safely use the unlifting function outside
+  -- of the scope of effects it captures, e.g. by creating an @IO@ action that
+  -- executes effectful operations and running it later:
+  --
+  -- >>> :{
+  --   delayed :: UnliftStrategy -> IO (IO String)
+  --   delayed strategy = runEff . evalStateLocal "Hey" $ do
+  --     r <- withEffToIO strategy $ \unlift -> pure $ unlift get
+  --     modify (++ "!!!")
+  --     pure r
+  -- :}
+  --
+  -- This doesn't work with the 'SeqUnlift' strategy because when the returned
+  -- action runs, @State@ is no longer in scope:
+  --
+  -- >>> join $ delayed SeqUnlift
+  -- *** Exception: version (...) /= storageVersion (0)
+  -- ...
+  --
+  -- However, it does with the 'SeqForkUnlift' strategy:
+  --
+  -- >>> join $ delayed SeqForkUnlift
+  -- "Hey"
+  --
   | 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

effectful/CHANGELOG.md

@@ -17,6 +17,8 @@
   experience.
 * Properly roll back changes made to the environment when `OnEmptyRollback`
   policy for the `NonDet` effect is selected.
+* Add a `SeqForkUnlift` strategy to support running unlifting functions outside
+  of the scope of effects they capture.
 * **Breaking changes**:
   - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a
     list of effects instead of a single one.