From 8f37f3f79e58b79513b84aad7a9d9032361a8c00 Mon Sep 17 00:00:00 2001
From: Andrzej Rybczak <andrzej@rybczak.net>
Date: Sat, 31 Jul 2021 17:03:56 +0200
Subject: [PATCH] Less unsafe functions, document unsafeness

---
 effectful-core/src/Effectful/Handler.hs       | 28 ++++++-------
 effectful-core/src/Effectful/Internal/Env.hs  | 10 ++---
 .../src/Effectful/Internal/Monad.hs           | 41 +++++++++++--------
 .../src/Effectful/Internal/Unlift.hs          | 12 +++---
 4 files changed, 50 insertions(+), 41 deletions(-)

diff --git a/effectful-core/src/Effectful/Handler.hs b/effectful-core/src/Effectful/Handler.hs
index 9924ef5..a355b91 100644
--- a/effectful-core/src/Effectful/Handler.hs
+++ b/effectful-core/src/Effectful/Handler.hs
@@ -120,7 +120,7 @@ localSeqUnlift
   -- ^ Continuation with the unlifting function in scope.
   -> Eff es a
 localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
-  unsafeSeqUnliftEff les $ \unlift -> do
+  seqUnliftEff les $ \unlift -> do
     (`unEff` es) $ k $ unsafeEff_ . unlift
 
 -- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
@@ -132,7 +132,7 @@ localSeqUnliftIO
   -> ((forall r. Eff localEs r -> IO r) -> IO a)
   -- ^ Continuation with the unlifting function in scope.
   -> Eff es a
-localSeqUnliftIO (LocalEnv les) k = liftIO $ unsafeSeqUnliftEff les k
+localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
 
 -- | Create a local unlifting function with the given strategy.
 localUnlift
@@ -145,10 +145,10 @@ localUnlift
   -> Eff es a
 localUnlift (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
-    unsafeSeqUnliftEff les $ \unlift -> do
+    seqUnliftEff les $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
   ConcUnlift p l -> unsafeEff $ \es -> do
-    unsafeConcUnliftEff les p l $ \unlift -> do
+    concUnliftEff les p l $ \unlift -> do
       (`unEff` es) $ k $ unsafeEff_ . unlift
 
 -- | Create a local unlifting function with the given strategy.
@@ -161,8 +161,8 @@ localUnliftIO
   -- ^ Continuation with the unlifting function in scope.
   -> Eff es a
 localUnliftIO (LocalEnv les) strategy k = case strategy of
-  SeqUnlift      -> liftIO $ unsafeSeqUnliftEff les k
-  ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l k
+  SeqUnlift      -> liftIO $ seqUnliftEff les k
+  ConcUnlift p l -> liftIO $ concUnliftEff les p l k
 
 -- | Utility for lifting 'Eff' operations of type
 --
@@ -181,7 +181,7 @@ withLiftMap
   -> Eff es r
 withLiftMap k = unsafeEff $ \es -> do
   (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
-    unsafeSeqUnliftEff localEs $ \unlift -> do
+    seqUnliftEff localEs $ \unlift -> do
       (`unEff` es) . mapEff . liftIO $ unlift m
 
 -- | Utility for lifting 'IO' operations of type
@@ -215,7 +215,7 @@ withLiftMapIO
   -- ^ Continuation with the lifting function in scope.
   -> Eff es r
 withLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
-  unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
+  seqUnliftEff es $ \unlift -> mapIO $ unlift m
 
 ----------------------------------------
 -- Bidirectional lifts
@@ -237,12 +237,12 @@ localLiftUnlift
   -> Eff es a
 localLiftUnlift (LocalEnv les) strategy k = case strategy of
   SeqUnlift -> unsafeEff $ \es -> do
-    unsafeSeqUnliftEff es $ \unliftEs -> do
-      unsafeSeqUnliftEff les $ \unliftLocalEs -> do
+    seqUnliftEff es $ \unliftEs -> do
+      seqUnliftEff les $ \unliftLocalEs -> do
         (`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
   ConcUnlift p l -> unsafeEff $ \es -> do
-    unsafeConcUnliftEff es p l $ \unliftEs -> do
-      unsafeConcUnliftEff les p l $ \unliftLocalEs -> do
+    concUnliftEff es p l $ \unliftEs -> do
+      concUnliftEff les p l $ \unliftLocalEs -> do
         (`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
 
 -- | Create a local unlifting function with the given strategy along with an
@@ -262,8 +262,8 @@ localLiftUnliftIO
   -- ^ Continuation with the lifting and unlifting function in scope.
   -> Eff es a
 localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
-  SeqUnlift      -> liftIO $ unsafeSeqUnliftEff les $ k unsafeEff_
-  ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l $ k unsafeEff_
+  SeqUnlift      -> liftIO $ seqUnliftEff les $ k unsafeEff_
+  ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
 
 -- $setup
 -- >>> import Control.Concurrent
diff --git a/effectful-core/src/Effectful/Internal/Env.hs b/effectful-core/src/Effectful/Internal/Env.hs
index 974f5d9..6dc5199 100644
--- a/effectful-core/src/Effectful/Internal/Env.hs
+++ b/effectful-core/src/Effectful/Internal/Env.hs
@@ -342,9 +342,9 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
 
 -- | Extend the environment with a new data type (in place).
 --
--- /Note:/ this function is __unsafe__ because it renders the input 'Env'
--- unusable until the corresponding 'unsafeTailEnv' call, but it's not checked
--- anywhere.
+-- This function is __highly unsafe__ because it renders the input 'Env'
+-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not
+-- checked anywhere.
 unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))
 unsafeConsEnv e f (Env fork gref gen) = case fork of
   NoFork -> do
@@ -381,11 +381,11 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
 -- | Shrink the environment by one data type (in place). Makes sure the size of
 -- the environment is as expected.
 --
--- /Note:/ this function is __unsafe__ because it renders the input 'Env'
+-- This function is __highly unsafe__ because it renders the input 'Env'
 -- unusable, but it's not checked anywhere.
 unsafeTailEnv :: Int -> Env (e : es) -> IO ()
 unsafeTailEnv len (Env fork gref _) = case fork of
-  NoFork -> shrinkEnvRef len gref
+  NoFork                -> shrinkEnvRef len gref
   Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
   where
     shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
diff --git a/effectful-core/src/Effectful/Internal/Monad.hs b/effectful-core/src/Effectful/Internal/Monad.hs
index 7b8e81c..55627fa 100644
--- a/effectful-core/src/Effectful/Internal/Monad.hs
+++ b/effectful-core/src/Effectful/Internal/Monad.hs
@@ -37,8 +37,8 @@ module Effectful.Internal.Monad
 
   --- *** Low-level helpers
   , unsafeWithLiftMapIO
-  , unsafeSeqUnliftEff
-  , unsafeConcUnliftEff
+  , seqUnliftEff
+  , concUnliftEff
 
   -- * Primitive effects
 
@@ -126,10 +126,16 @@ unEff :: Eff es a -> Env es -> IO a
 unEff (Eff m) = m
 
 -- | Access the underlying 'IO' monad along with the environment.
+--
+-- This function is __unsafe__ because it can be used to introduce arbitrary
+-- 'IO' actions into pure 'Eff' operations.
 unsafeEff :: (Env es -> IO a) -> Eff es a
 unsafeEff m = Eff (oneShot m)
 
 -- | Access the underlying 'IO' monad.
+--
+-- This function is __unsafe__ because it can be used to introduce arbitrary
+-- 'IO' actions into pure 'Eff' operations.
 unsafeEff_ :: IO a -> Eff es a
 unsafeEff_ m = unsafeEff $ \_ -> m
 
@@ -141,6 +147,9 @@ unsafeEff_ m = unsafeEff $ \_ -> m
 --
 -- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
 --
+-- This function is __unsafe__ because it can be used to introduce arbitrary
+-- 'IO' actions into pure 'Eff' operations.
+--
 -- /Note:/ the 'IO' operation must not run its argument in a separate thread,
 -- attempting to do so will result in a runtime error.
 unsafeWithLiftMapIO
@@ -148,15 +157,15 @@ unsafeWithLiftMapIO
   => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
   -> Eff es r
 unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
-  unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
+  seqUnliftEff es $ \unlift -> mapIO $ unlift m
 
 -- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
-unsafeSeqUnliftEff
+seqUnliftEff
   :: HasCallStack
   => Env es
   -> ((forall r. Eff es r -> IO r) -> IO a)
   -> IO a
-unsafeSeqUnliftEff es k = do
+seqUnliftEff es k = do
   tid0 <- myThreadId
   k $ \m -> do
     tid <- myThreadId
@@ -167,21 +176,21 @@ unsafeSeqUnliftEff es k = do
         ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
 
 -- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
-unsafeConcUnliftEff
+concUnliftEff
   :: HasCallStack
   => Env es
   -> Persistence
   -> Limit
   -> ((forall r. Eff es r -> IO r) -> IO a)
   -> IO a
-unsafeConcUnliftEff es Ephemeral (Limited uses) k =
-  unsafeEphemeralConcUnliftIO uses k es unEff
-unsafeConcUnliftEff es Ephemeral Unlimited k =
-  unsafeEphemeralConcUnliftIO maxBound k es unEff
-unsafeConcUnliftEff es Persistent (Limited threads) k =
-  unsafePersistentConcUnliftIO False threads k es unEff
-unsafeConcUnliftEff es Persistent Unlimited k =
-  unsafePersistentConcUnliftIO True maxBound k es unEff
+concUnliftEff es Ephemeral (Limited uses) k =
+  ephemeralConcUnliftIO uses k es unEff
+concUnliftEff es Ephemeral Unlimited k =
+  ephemeralConcUnliftIO maxBound k es unEff
+concUnliftEff es Persistent (Limited threads) k =
+  persistentConcUnliftIO False threads k es unEff
+concUnliftEff es Persistent Unlimited k =
+  persistentConcUnliftIO True maxBound k es unEff
 
 ----------------------------------------
 -- Base
@@ -400,9 +409,9 @@ withEffToIO
   -- ^ Continuation with the unlifting function in scope.
   -> Eff es a
 withEffToIO f = unliftStrategy >>= \case
-  SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
+  SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
   ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
-    unsafeEff $ \es -> unsafeConcUnliftEff es p b f
+    unsafeEff $ \es -> concUnliftEff es p b f
 
 ----------------------------------------
 -- Helpers
diff --git a/effectful-core/src/Effectful/Internal/Unlift.hs b/effectful-core/src/Effectful/Internal/Unlift.hs
index 129893a..4d05b97 100644
--- a/effectful-core/src/Effectful/Internal/Unlift.hs
+++ b/effectful-core/src/Effectful/Internal/Unlift.hs
@@ -6,8 +6,8 @@
 -- This module is intended for internal use only, and may change without warning
 -- in subsequent releases.
 module Effectful.Internal.Unlift
-  ( unsafeEphemeralConcUnliftIO
-  , unsafePersistentConcUnliftIO
+  ( ephemeralConcUnliftIO
+  , persistentConcUnliftIO
   ) where
 
 import Control.Concurrent
@@ -25,14 +25,14 @@ import Effectful.Internal.Utils
 
 -- | Concurrent unlift that doesn't preserve the environment between calls to
 -- the unlifting function in threads other than its creator.
-unsafeEphemeralConcUnliftIO
+ephemeralConcUnliftIO
   :: HasCallStack
   => Int
   -> ((forall r. m r -> IO r) -> IO a)
   -> Env es
   -> (forall r. m r -> Env es -> IO r)
   -> IO a
-unsafeEphemeralConcUnliftIO uses k es0 unEff = do
+ephemeralConcUnliftIO uses k es0 unEff = do
   unless (uses > 0) $ do
     error $ "Invalid number of uses: " ++ show uses
   tid0 <- myThreadId
@@ -58,7 +58,7 @@ unsafeEphemeralConcUnliftIO uses k es0 unEff = do
 
 -- | Concurrent unlift that preserves the environment between calls to the
 -- unlifting function within a particular thread.
-unsafePersistentConcUnliftIO
+persistentConcUnliftIO
   :: HasCallStack
   => Bool
   -> Int
@@ -66,7 +66,7 @@ unsafePersistentConcUnliftIO
   -> Env es
   -> (forall r. m r -> Env es -> IO r)
   -> IO a
-unsafePersistentConcUnliftIO cleanUp threads k es0 unEff = do
+persistentConcUnliftIO cleanUp threads k es0 unEff = do
   unless (threads > 0) $ do
     error $ "Invalid number of threads: " ++ show threads
   tid0 <- myThreadId