git.iko.soy/effectful
on master help sign in
Make runEff return a pure value
2c6a634Andrzej Rybczak
bench/Countdown.hs+8−8
compare with master
unifiedsplit
@@ -85,10 +85,10 @@ programEffectfulStatic = do
85 programEffectfulStatic
85 programEffectfulStatic
86{-# NOINLINE programEffectfulStatic #-}
86{-# NOINLINE programEffectfulStatic #-}
87
87
88−countdownEffectfulStatic :: Integer -> IO (Integer, Integer)
88+countdownEffectfulStatic :: Integer -> (Integer, Integer)
89countdownEffectfulStatic n = E.runEff . E.runState n $ programEffectfulStatic
89countdownEffectfulStatic n = E.runEff . E.runState n $ programEffectfulStatic
90
90
91−countdownEffectfulStaticDeep :: Integer -> IO (Integer, Integer)
91+countdownEffectfulStaticDeep :: Integer -> (Integer, Integer)
92countdownEffectfulStaticDeep n = E.runEff
92countdownEffectfulStaticDeep n = E.runEff
93 . runR . runR . runR . runR . runR
93 . runR . runR . runR . runR . runR
94 . E.runState n
94 . E.runState n
@@ -110,10 +110,10 @@ programEffectfulMVar = do
110 programEffectfulMVar
110 programEffectfulMVar
111{-# NOINLINE programEffectfulMVar #-}
111{-# NOINLINE programEffectfulMVar #-}
112
112
113−countdownEffectfulMVar :: Integer -> IO (Integer, Integer)
113+countdownEffectfulMVar :: Integer -> (Integer, Integer)
114countdownEffectfulMVar n = E.runEff . ME.runState n $ programEffectfulMVar
114countdownEffectfulMVar n = E.runEff . ME.runState n $ programEffectfulMVar
115
115
116−countdownEffectfulMVarDeep :: Integer -> IO (Integer, Integer)
116+countdownEffectfulMVarDeep :: Integer -> (Integer, Integer)
117countdownEffectfulMVarDeep n = E.runEff
117countdownEffectfulMVarDeep n = E.runEff
118 . runR . runR . runR . runR . runR
118 . runR . runR . runR . runR . runR
119 . ME.runState n
119 . ME.runState n
@@ -135,13 +135,13 @@ programEffectfulDynamic = do
135 programEffectfulDynamic
135 programEffectfulDynamic
136{-# NOINLINE programEffectfulDynamic #-}
136{-# NOINLINE programEffectfulDynamic #-}
137
137
138−countdownEffectfulDynPure :: Integer -> IO (Integer, Integer)
138+countdownEffectfulDynPure :: Integer -> (Integer, Integer)
139countdownEffectfulDynPure n = E.runEff . DE.runState n $ programEffectfulDynamic
139countdownEffectfulDynPure n = E.runEff . DE.runState n $ programEffectfulDynamic
140
140
141−countdownEffectfulDynMVar :: Integer -> IO (Integer, Integer)
141+countdownEffectfulDynMVar :: Integer -> (Integer, Integer)
142countdownEffectfulDynMVar n = E.runEff . DE.runStateMVar n $ programEffectfulDynamic
142countdownEffectfulDynMVar n = E.runEff . DE.runStateMVar n $ programEffectfulDynamic
143
143
144−countdownEffectfulDynPureDeep :: Integer -> IO (Integer, Integer)
144+countdownEffectfulDynPureDeep :: Integer -> (Integer, Integer)
145countdownEffectfulDynPureDeep n = E.runEff
145countdownEffectfulDynPureDeep n = E.runEff
146 . runR . runR . runR . runR . runR
146 . runR . runR . runR . runR . runR
147 . DE.runState n
147 . DE.runState n
@@ -150,7 +150,7 @@ countdownEffectfulDynPureDeep n = E.runEff
150 where
150 where
151 runR = E.runReader ()
151 runR = E.runReader ()
152
152
153−countdownEffectfulDynMVarDeep :: Integer -> IO (Integer, Integer)
153+countdownEffectfulDynMVarDeep :: Integer -> (Integer, Integer)
154countdownEffectfulDynMVarDeep n = E.runEff
154countdownEffectfulDynMVarDeep n = E.runEff
155 . runR . runR . runR . runR . runR
155 . runR . runR . runR . runR . runR
156 . DE.runStateMVar n
156 . DE.runStateMVar n
bench/Main.hs+8−8
@@ -23,10 +23,10 @@ countdown :: Integer -> Benchmark
23countdown n = bgroup (show n)
23countdown n = bgroup (show n)
24 [ bgroup "shallow"
24 [ bgroup "shallow"
25 [ bench "reference" $ nf countdownRef n
25 [ bench "reference" $ nf countdownRef n
26− , bench "effectful (pure-static)" $ nfAppIO countdownEffectfulStatic n
26+ , bench "effectful (pure-static)" $ nf countdownEffectfulStatic n
27− , bench "effectful (pure-dynamic)" $ nfAppIO countdownEffectfulDynPure n
27+ , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPure n
28− , bench "effectful (MVar-static)" $ nfAppIO countdownEffectfulMVar n
28+ , bench "effectful (MVar-static)" $ nf countdownEffectfulMVar n
29− , bench "effectful (MVar-dynamic)" $ nfAppIO countdownEffectfulDynMVar n
29+ , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVar n
30#ifdef VERSION_freer_simple
30#ifdef VERSION_freer_simple
31 , bench "freer-simple" $ nf countdownFreerSimple n
31 , bench "freer-simple" $ nf countdownFreerSimple n
32#endif
32#endif
@@ -42,10 +42,10 @@ countdown n = bgroup (show n)
42#endif
42#endif
43 ]
43 ]
44 , bgroup "deep"
44 , bgroup "deep"
45− [ bench "effectful (pure-static)" $ nfAppIO countdownEffectfulStaticDeep n
45+ [ bench "effectful (pure-static)" $ nf countdownEffectfulStaticDeep n
46− , bench "effectful (pure-dynamic)" $ nfAppIO countdownEffectfulDynPureDeep n
46+ , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPureDeep n
47− , bench "effectful (MVar-static)" $ nfAppIO countdownEffectfulMVarDeep n
47+ , bench "effectful (MVar-static)" $ nf countdownEffectfulMVarDeep n
48− , bench "effectful (MVar-dynamic)" $ nfAppIO countdownEffectfulDynMVarDeep n
48+ , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVarDeep n
49#ifdef VERSION_freer_simple
49#ifdef VERSION_freer_simple
50 , bench "freer-simple" $ nf countdownFreerSimpleDeep n
50 , bench "freer-simple" $ nf countdownFreerSimpleDeep n
51#endif
51#endif
effectful.cabal+2−1
@@ -84,9 +84,10 @@ library
84test-suite test
84test-suite test
85 import: language
85 import: language
86
86
87− ghc-options: -threaded -rtsopts
87+ ghc-options: -threaded -rtsopts -with-rtsopts=-N4
88
88
89 build-depends: base <5
89 build-depends: base <5
90+ , async
90 , effectful
91 , effectful
91 , exceptions
92 , exceptions
92 , lifted-base
93 , lifted-base
src/Effectful/Internal/Monad.hs+14−3
@@ -38,6 +38,7 @@ import Control.Monad.IO.Class
38import Control.Monad.IO.Unlift
38import Control.Monad.IO.Unlift
39import Control.Monad.Trans.Control
39import Control.Monad.Trans.Control
40import GHC.Magic (oneShot)
40import GHC.Magic (oneShot)
41+import System.IO.Unsafe (unsafePerformIO)
41
42
42import Effectful.Internal.Effect
43import Effectful.Internal.Effect
43import Effectful.Internal.Env
44import Effectful.Internal.Env
@@ -46,8 +47,15 @@ type role Eff nominal representational
46
47
47newtype Eff (es :: [Effect]) a = Eff { unEff :: Env es -> IO a }
48newtype Eff (es :: [Effect]) a = Eff { unEff :: Env es -> IO a }
48
49
50+-- | Run a pure 'Eff' computation.
51+--
52+-- For the impure version see 'runIOE'.
49−runEff :: Eff '[] a -> IO a
53+runEff :: Eff '[] a -> a
54+runEff (Eff m) =
55+ -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
56+ -- side effects was performed (unless someone sneakily introduced side effects
57+ -- with unsafeEff, but then all bets are off).
50−runEff (Eff m) = m =<< emptyEnv
58+ unsafePerformIO $ m =<< emptyEnv
51
59
52unsafeEff :: (Env es -> IO a) -> Eff es a
60unsafeEff :: (Env es -> IO a) -> Eff es a
53unsafeEff m = Eff (oneShot m)
61unsafeEff m = Eff (oneShot m)
@@ -141,8 +149,11 @@ instance MonadMask (Eff es) where
141data IOE :: Effect where
149data IOE :: Effect where
142 IOE :: IOE m r
150 IOE :: IOE m r
143
151
152+-- | Run an impure 'Eff' computation.
153+--
154+-- For the pure version see 'runEff'.
144runIOE :: Eff '[IOE] a -> IO a
155runIOE :: Eff '[IOE] a -> IO a
145−runIOE = runEff . evalEffect (IdE IOE)
156+runIOE m = unEff (evalEffect (IdE IOE) m) =<< emptyEnv
146
157
147instance IOE :> es => MonadIO (Eff es) where
158instance IOE :> es => MonadIO (Eff es) where
148 liftIO = unsafeEff_
159 liftIO = unsafeEff_
src/Effectful/Resource.hs+1−1
@@ -26,7 +26,7 @@ newtype Resource :: Effect where
26 Resource :: R.InternalState -> Resource m r
26 Resource :: R.InternalState -> Resource m r
27
27
28-- | Run the resource effect.
28-- | Run the resource effect.
29−runResource :: Eff (Resource : es) a -> Eff es a
29+runResource :: IOE :> es => Eff (Resource : es) a -> Eff es a
30runResource (Eff m) = unsafeEff $ \es0 -> do
30runResource (Eff m) = unsafeEff $ \es0 -> do
31 size0 <- sizeEnv es0
31 size0 <- sizeEnv es0
32 istate <- R.createInternalState
32 istate <- R.createInternalState
tests/Main.hs+18
@@ -1,5 +1,6 @@
1module Main (main) where
1module Main (main) where
2
2
3+import Control.Concurrent.Async
3import Control.Monad.IO.Class
4import Control.Monad.IO.Class
4import Test.Tasty
5import Test.Tasty
5import Test.Tasty.HUnit
6import Test.Tasty.HUnit
@@ -19,6 +20,7 @@ main = defaultMain $ testGroup "effectful"
19 , testCase "stateM" test_stateM
20 , testCase "stateM" test_stateM
20 , testCase "deep stack" test_deepStack
21 , testCase "deep stack" test_deepStack
21 , testCase "exceptions" test_exceptions
22 , testCase "exceptions" test_exceptions
23+ , testCase "concurrency" test_concurrentState
22 , testCase "local effects" test_localEffects
24 , testCase "local effects" test_localEffects
23 ]
25 ]
24 ]
26 ]
@@ -87,6 +89,22 @@ test_exceptions = runIOE $ do
87 _ <- E.throwM Ex
89 _ <- E.throwM Ex
88 modify @Int (+2)
90 modify @Int (+2)
89
91
92+test_concurrentState :: Assertion
93+test_concurrentState =
94+ replicateConcurrently_ 2 . runIOE . runState x $ do
95+ r <- goDownward 0
96+ assertEqual_ "x = n" x r
97+ where
98+ x :: Int
99+ x = 1000000
100+
101+ goDownward :: State Int :> es => Int -> Eff es Int
102+ goDownward acc = get @Int >>= \case
103+ 0 -> pure acc
104+ n -> do
105+ put @Int $ n - 1
106+ goDownward $ acc + 1
107+
90test_localEffects :: Assertion
108test_localEffects :: Assertion
91test_localEffects = runIOE $ do
109test_localEffects = runIOE $ do
92 x <- runHasInt 0 $ do
110 x <- runHasInt 0 $ do