git.iko.soy/effectful
on master help sign in
Tighten type signatures of withLiftMap(IO)
5084f03Andrzej Rybczak
effectful-core/src/Effectful/Handler.hs+15−7
compare with master
unifiedsplit
@@ -124,16 +124,20 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
124--
124--
125-- to
125-- to
126--
126--
127−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
127+-- @'Eff' localEs a -> 'Eff' localEs b@
128--
128--
129-- /Note:/ the operation must not run its argument in a separate thread,
129-- /Note:/ the operation must not run its argument in a separate thread,
130-- attempting to do so will result in a runtime error.
130-- attempting to do so will result in a runtime error.
131withLiftMap
131withLiftMap
132 :: HasCallStack
132 :: HasCallStack
133+ => LocalEnv localEs
134+ -- ^ Local environment.
133− => ((forall a b localEs. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
135+ -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
134 -- ^ Continuation with the lifting function in scope.
136 -- ^ Continuation with the lifting function in scope.
135 -> Eff es r
137 -> Eff es r
136−withLiftMap k = unsafeEff $ \es -> do
138+withLiftMap !_ k = unsafeEff $ \es -> do
139+ -- The LocalEnv parameter is not used, but we need it to constraint the
140+ -- localEs type variable. It's also strict so that callers don't cheat.
137 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
141 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
138 seqUnliftEff localEs $ \unlift -> do
142 seqUnliftEff localEs $ \unlift -> do
139 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
143 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
@@ -144,7 +148,7 @@ withLiftMap k = unsafeEff $ \es -> do
144--
148--
145-- to
149-- to
146--
150--
147−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
151+-- @'Eff' localEs a -> 'Eff' localEs b@
148--
152--
149-- /Note:/ the operation must not run its argument in a separate thread,
153-- /Note:/ the operation must not run its argument in a separate thread,
150-- attempting to do so will result in a runtime error.
154-- attempting to do so will result in a runtime error.
@@ -159,16 +163,20 @@ withLiftMap k = unsafeEff $ \es -> do
159--
163--
160-- >>> :{
164-- >>> :{
161-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
165-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
162−-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO $ \liftMap -> do
166+-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO env $ \liftMap -> do
163-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
167-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
164-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
168-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
165-- :}
169-- :}
166withLiftMapIO
170withLiftMapIO
167 :: (HasCallStack, IOE :> es)
171 :: (HasCallStack, IOE :> es)
172+ => LocalEnv localEs
173+ -- ^ Local environment.
168− => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
174+ -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
169 -- ^ Continuation with the lifting function in scope.
175 -- ^ Continuation with the lifting function in scope.
170 -> Eff es r
176 -> Eff es r
171−withLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
177+withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
178+ -- The LocalEnv parameter is not used, but we need it to constraint the
179+ -- localEs type variable. It's also strict so that callers don't cheat.
172 seqUnliftEff es $ \unlift -> mapIO $ unlift m
180 seqUnliftEff es $ \unlift -> mapIO $ unlift m
173
181
174----------------------------------------
182----------------------------------------
effectful/bench/Concurrency.hs+2−2
@@ -60,14 +60,14 @@ data Fork :: Effect where
60-- | Uses 'localUnliftIO' and 'withLiftMapIO'.
60-- | Uses 'localUnliftIO' and 'withLiftMapIO'.
61runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a
61runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a
62runFork1 = interpret $ \env -> \case
62runFork1 = interpret $ \env -> \case
63− ForkWithUnmask m -> withLiftMapIO $ \liftMap -> do
63+ ForkWithUnmask m -> withLiftMapIO env $ \liftMap -> do
64 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
64 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
65 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
65 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
66
66
67-- | Uses 'localUnlift' and 'withLiftMap'.
67-- | Uses 'localUnlift' and 'withLiftMap'.
68runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a
68runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a
69runFork2 = reinterpret A.runAsyncE $ \env -> \case
69runFork2 = reinterpret A.runAsyncE $ \env -> \case
70− ForkWithUnmask m -> withLiftMap $ \liftMap -> do
70+ ForkWithUnmask m -> withLiftMap env $ \liftMap -> do
71 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
71 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
72 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
72 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
73
73