4f77232 · effectful · git.iko.soy

git.iko.soy/effectful

on master help sign in

Don't export the constructor of Eff

4f77232Andrzej Rybczak5 years ago

src/Effectful/Error.hs+4−4

compare with master

unifiedsplit

@@ -50,13 +50,13 @@ runError

50 :: forall e es a. Typeable e

51 => Eff (Error e : es) a

52 -> Eff es (Either (CallStack, e) a)

53−runError (Eff m) = unsafeEff $ \es0 -> mask $ \release -> do

53+runError m = unsafeEff $ \es0 -> mask $ \release -> do

54 -- A unique tag is picked so that different runError handlers for the same

55 -- type don't catch each other's exceptions.

56 tag <- newUnique

57 size0 <- sizeEnv es0

58 es <- unsafeConsEnv (IdE (Error @e tag)) noRelinker es0

59− r <- tryErrorIO tag (release $ m es) `onException` unsafeTailEnv size0 es

59+ r <- tryErrorIO tag (release $ unEff m es) `onException` unsafeTailEnv size0 es

60 _ <- unsafeTailEnv size0 es

61 pure r

@@ -72,10 +72,10 @@ catchError

72 => Eff es a

73 -> (CallStack -> e -> Eff es a)

74 -> Eff es a

75−catchError (Eff m) handler = do

75+catchError m handler = do

76 readerEffectM @(Error e) $ \(IdE (Error tag)) -> unsafeEff $ \es -> do

77 size <- sizeEnv es

78− catchErrorIO tag (m es) $ \cs e -> do

78+ catchErrorIO tag (unEff m es) $ \cs e -> do

79 checkSizeEnv size es

80 unEff (handler cs e) es

src/Effectful/Internal/Monad.hs+27−17

@@ -7,11 +7,12 @@

7-- in subsequent releases.

8module Effectful.Internal.Monad

9 ( -- * Monad

10− Eff(..)

10+ Eff

11 , runEff

13 -- ** Access to the internal representation

14 , RunIn

15+ , unEff

15 , unsafeEff

16 , unsafeEff

16 , unsafeEff_

17 , unsafeEff_

17 , unsafeUnliftEff

18 , unsafeUnliftEff

@@ -20,10 +21,14 @@ module Effectful.Internal.Monad

20 , IOE

21 , IOE

21 , runIOE

22 , runIOE

23− -- * Helpers

24+ -- * Low-level helpers

25+

26+ -- ** Running

24 , runEffect

27 , runEffect

25 , evalEffect

28 , evalEffect

26 , execEffect

29 , execEffect

30+

31+ -- ** Modification

27 , getEffect

32 , getEffect

28 , putEffect

33 , putEffect

29 , stateEffect

34 , stateEffect

@@ -47,7 +52,7 @@ import Effectful.Internal.Env

48type role Eff nominal representational

53type role Eff nominal representational

50−newtype Eff (es :: [Effect]) a = Eff { unEff :: Env es -> IO a }

55+newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)

52-- | Run a pure 'Eff' computation.

57-- | Run a pure 'Eff' computation.

53--

58--

@@ -63,6 +68,11 @@ runEff (Eff m) =

63 unsafeDupablePerformIO $ m =<< emptyEnv

68 unsafeDupablePerformIO $ m =<< emptyEnv

65----------------------------------------

70----------------------------------------

71+-- Access to the internal representation

72+

73+-- | Peel off the constructor of 'Eff'.

74+unEff :: Eff es a -> Env es -> IO a

75+unEff (Eff m) = m

67-- | Access underlying 'IO' monad along with the environment.

77-- | Access underlying 'IO' monad along with the environment.

68unsafeEff :: (Env es -> IO a) -> Eff es a

78unsafeEff :: (Env es -> IO a) -> Eff es a

@@ -100,10 +110,10 @@ type RunIn es m = forall r. Eff es r -> m r

100unsafeUnliftEff :: (RunIn es IO -> IO a) -> Eff es a

110unsafeUnliftEff :: (RunIn es IO -> IO a) -> Eff es a

101unsafeUnliftEff f = unsafeEff $ \es -> do

111unsafeUnliftEff f = unsafeEff $ \es -> do

102 tid0 <- myThreadId

112 tid0 <- myThreadId

103− f $ \(Eff m) -> do

113+ f $ \m -> do

104 tid <- myThreadId

114 tid <- myThreadId

105 if tid == tid0

115 if tid == tid0

106− then m es

116+ then unEff m es

107 else error $ "Running Eff computations in a different thread is "

117 else error $ "Running Eff computations in a different thread is "

108 ++ "currently only possible via the AsyncE effect"

118 ++ "currently only possible via the AsyncE effect"

109

119

@@ -134,18 +144,18 @@ instance MonadThrow (Eff es) where

134 throwM = unsafeEff_ . throwM

144 throwM = unsafeEff_ . throwM

135

145

136instance MonadCatch (Eff es) where

146instance MonadCatch (Eff es) where

137− catch (Eff m) handler = unsafeEff $ \es -> do

147+ catch m handler = unsafeEff $ \es -> do

138 size <- sizeEnv es

148 size <- sizeEnv es

139− m es `catch` \e -> do

149+ unEff m es `catch` \e -> do

140 checkSizeEnv size es

150 checkSizeEnv size es

141 unEff (handler e) es

151 unEff (handler e) es

142

152

143instance MonadMask (Eff es) where

153instance MonadMask (Eff es) where

144 mask k = unsafeEff $ \es -> mask $ \restore ->

154 mask k = unsafeEff $ \es -> mask $ \restore ->

145− unEff (k $ \(Eff m) -> unsafeEff $ restore . m) es

155+ unEff (k $ \m -> unsafeEff $ restore . unEff m) es

146

156

147 uninterruptibleMask k = unsafeEff $ \es -> uninterruptibleMask $ \restore ->

157 uninterruptibleMask k = unsafeEff $ \es -> uninterruptibleMask $ \restore ->

148− unEff (k $ \(Eff m) -> unsafeEff $ restore . m) es

158+ unEff (k $ \m -> unsafeEff $ restore . unEff m) es

149

159

150 generalBracket acquire release use = unsafeEff $ \es -> mask $ \restore -> do

160 generalBracket acquire release use = unsafeEff $ \es -> mask $ \restore -> do

151 size <- sizeEnv es

161 size <- sizeEnv es

@@ -188,25 +198,25 @@ instance IOE :> es => MonadUnliftIO (Eff es) where

188-- Helpers

198-- Helpers

189

199

190runEffect :: i e -> Eff (e : es) a -> Eff es (a, i e)

200runEffect :: i e -> Eff (e : es) a -> Eff es (a, i e)

191−runEffect e0 (Eff m) = unsafeEff $ \es0 -> do

201+runEffect e0 m = unsafeEff $ \es0 -> do

192 size0 <- sizeEnv es0

202 size0 <- sizeEnv es0

193 bracket (unsafeConsEnv e0 noRelinker es0)

203 bracket (unsafeConsEnv e0 noRelinker es0)

194 (unsafeTailEnv size0)

204 (unsafeTailEnv size0)

195− (\es -> (,) <$> m es <*> getEnv es)

205+ (\es -> (,) <$> unEff m es <*> getEnv es)

196

206

197evalEffect :: i e -> Eff (e : es) a -> Eff es a

207evalEffect :: i e -> Eff (e : es) a -> Eff es a

198−evalEffect e (Eff m) = unsafeEff $ \es0 -> do

208+evalEffect e m = unsafeEff $ \es0 -> do

199 size0 <- sizeEnv es0

209 size0 <- sizeEnv es0

200 bracket (unsafeConsEnv e noRelinker es0)

210 bracket (unsafeConsEnv e noRelinker es0)

201 (unsafeTailEnv size0)

211 (unsafeTailEnv size0)

202− (\es -> m es)

212+ (\es -> unEff m es)

203

213

204execEffect :: i e -> Eff (e : es) a -> Eff es (i e)

214execEffect :: i e -> Eff (e : es) a -> Eff es (i e)

205−execEffect e0 (Eff m) = unsafeEff $ \es0 -> do

215+execEffect e0 m = unsafeEff $ \es0 -> do

206 size0 <- sizeEnv es0

216 size0 <- sizeEnv es0

207 bracket (unsafeConsEnv e0 noRelinker es0)

217 bracket (unsafeConsEnv e0 noRelinker es0)

208 (unsafeTailEnv size0)

218 (unsafeTailEnv size0)

209− (\es -> m es *> getEnv es)

219+ (\es -> unEff m es *> getEnv es)

210

220

211getEffect :: e :> es => Eff es (i e)

221getEffect :: e :> es => Eff es (i e)

212getEffect = unsafeEff $ \es -> getEnv es

222getEffect = unsafeEff $ \es -> getEnv es

@@ -221,10 +231,10 @@ stateEffect f = unsafeEff $ \es -> unsafeStateEnv f es

221{-# INLINE stateEffect #-}

231{-# INLINE stateEffect #-}

222

232

223localEffect :: e :> es => (i e -> i e) -> Eff es a -> Eff es a

233localEffect :: e :> es => (i e -> i e) -> Eff es a -> Eff es a

224−localEffect f (Eff m) = unsafeEff $ \es -> do

234+localEffect f m = unsafeEff $ \es -> do

225 bracket (unsafeStateEnv (\e -> (e, f e)) es)

235 bracket (unsafeStateEnv (\e -> (e, f e)) es)

226 (\e -> unsafePutEnv e es)

236 (\e -> unsafePutEnv e es)

227− (\_ -> m es)

237+ (\_ -> unEff m es)

228{-# INLINE localEffect #-}

238{-# INLINE localEffect #-}

229

239

230readerEffectM :: e :> es => (i e -> Eff es a) -> Eff es a

240readerEffectM :: e :> es => (i e -> Eff es a) -> Eff es a

src/Effectful/Interpreter.hs+2−2

@@ -35,11 +35,11 @@ data Interpreter (e :: Effect) = forall localEs. Interpreter

35 }

37runInterpreter :: Env es -> Interpreter e -> Eff (e : es) a -> IO a

38−runInterpreter es0 e (Eff m) = do

38+runInterpreter es0 e m = do

39 size0 <- sizeEnv es0

40 bracket (unsafeConsEnv e relinker es0)

41 (unsafeTailEnv size0)

42− (\es -> m es)

42+ (\es -> unEff m es)

43 where

44 relinker :: Relinker Interpreter e

45 relinker = Relinker $ \relink Interpreter{..} -> do

src/Effectful/Resource.hs+2−2

@@ -27,12 +27,12 @@ newtype Resource :: Effect where

28-- | Run the resource effect.

29runResource :: IOE :> es => Eff (Resource : es) a -> Eff es a

30−runResource (Eff m) = unsafeEff $ \es0 -> do

30+runResource m = unsafeEff $ \es0 -> do

31 size0 <- sizeEnv es0

32 istate <- R.createInternalState

33 mask $ \restore -> do

34 es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0

35− a <- restore (m es) `catch` \e -> do

35+ a <- restore (unEff m es) `catch` \e -> do

36 _ <- unsafeTailEnv size0 es

37 RI.stateCleanupChecked (Just e) istate

38 throwIO e

src/Effectful/Writer.hs+2−2

@@ -39,10 +39,10 @@ listen

39 :: forall w es a. (Writer w :> es, Monoid w)

40 => Eff es a

41 -> Eff es (a, w)

42−listen (Eff m) = unsafeEff $ \es -> mask $ \restore -> do

42+listen m = unsafeEff $ \es -> mask $ \restore -> do

43 w0 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer mempty))) es

44 -- If an exception is thrown, restore e0 and keep parts of e1.

45− a <- restore (m es) `onException`

45+ a <- restore (unEff m es) `onException`

46 unsafeModifyEnv (\(IdE (Writer w)) -> IdE (Writer (w0 <> w))) es

47 w1 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer (w0 <> w)))) es

48 pure (a, w1)

src/Effectful/Writer/MVar.hs+2−2

@@ -44,11 +44,11 @@ listen

44 :: forall w es a. (Writer w :> es, Monoid w)

45 => Eff es a

46 -> Eff es (a, w)

47−listen (Eff m) = unsafeEff $ \es -> uninterruptibleMask $ \restore -> do

47+listen m = unsafeEff $ \es -> uninterruptibleMask $ \restore -> do

48 v1 <- newMVar mempty

49 -- Replace thread local MVar with a fresh one for isolated listening.

50 v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es

51− a <- restore (m es) `onException` merge es v0 v1

51+ a <- restore (unEff m es) `onException` merge es v0 v1

52 (a, ) <$> merge es v0 v1

53 where

54 -- Merge results accumulated in the local MVar with the mainline. If an