git.iko.soy/effectful
on master help sign in
Make runEff return a pure value

Fixes #3.

commit2c6a634712bdf05d1250679d36f8f09e8c65473b authorAndrzej Rybczak <andrzej@rybczak.net> dateWed 23 Jun 2021, 13:23 (5 years ago) parent545bc49
6 files changed+51−21
compare with master
unifiedsplit
bench/Countdown.hs+8−8 bench/Main.hs+8−8 effectful.cabal+2−1 src/Effectful/Internal/Monad.hs+14−3 src/Effectful/Resource.hs+1−1 tests/Main.hs+18
bench/Countdown.hs+8−8
@@ -85,10 +85,10 @@ programEffectfulStatic = do
8585 programEffectfulStatic
8686{-# NOINLINE programEffectfulStatic #-}
8787
88−countdownEffectfulStatic :: Integer -> IO (Integer, Integer)
88+countdownEffectfulStatic :: Integer -> (Integer, Integer)
8989countdownEffectfulStatic n = E.runEff . E.runState n $ programEffectfulStatic
9090
91−countdownEffectfulStaticDeep :: Integer -> IO (Integer, Integer)
91+countdownEffectfulStaticDeep :: Integer -> (Integer, Integer)
9292countdownEffectfulStaticDeep n = E.runEff
9393 . runR . runR . runR . runR . runR
9494 . E.runState n
@@ -110,10 +110,10 @@ programEffectfulMVar = do
110110 programEffectfulMVar
111111{-# NOINLINE programEffectfulMVar #-}
112112
113−countdownEffectfulMVar :: Integer -> IO (Integer, Integer)
113+countdownEffectfulMVar :: Integer -> (Integer, Integer)
114114countdownEffectfulMVar n = E.runEff . ME.runState n $ programEffectfulMVar
115115
116−countdownEffectfulMVarDeep :: Integer -> IO (Integer, Integer)
116+countdownEffectfulMVarDeep :: Integer -> (Integer, Integer)
117117countdownEffectfulMVarDeep n = E.runEff
118118 . runR . runR . runR . runR . runR
119119 . ME.runState n
@@ -135,13 +135,13 @@ programEffectfulDynamic = do
135135 programEffectfulDynamic
136136{-# NOINLINE programEffectfulDynamic #-}
137137
138−countdownEffectfulDynPure :: Integer -> IO (Integer, Integer)
138+countdownEffectfulDynPure :: Integer -> (Integer, Integer)
139139countdownEffectfulDynPure n = E.runEff . DE.runState n $ programEffectfulDynamic
140140
141−countdownEffectfulDynMVar :: Integer -> IO (Integer, Integer)
141+countdownEffectfulDynMVar :: Integer -> (Integer, Integer)
142142countdownEffectfulDynMVar n = E.runEff . DE.runStateMVar n $ programEffectfulDynamic
143143
144−countdownEffectfulDynPureDeep :: Integer -> IO (Integer, Integer)
144+countdownEffectfulDynPureDeep :: Integer -> (Integer, Integer)
145145countdownEffectfulDynPureDeep n = E.runEff
146146 . runR . runR . runR . runR . runR
147147 . DE.runState n
@@ -150,7 +150,7 @@ countdownEffectfulDynPureDeep n = E.runEff
150150 where
151151 runR = E.runReader ()
152152
153−countdownEffectfulDynMVarDeep :: Integer -> IO (Integer, Integer)
153+countdownEffectfulDynMVarDeep :: Integer -> (Integer, Integer)
154154countdownEffectfulDynMVarDeep n = E.runEff
155155 . runR . runR . runR . runR . runR
156156 . DE.runStateMVar n
bench/Main.hs+8−8
@@ -23,10 +23,10 @@ countdown :: Integer -> Benchmark
2323countdown n = bgroup (show n)
2424 [ bgroup "shallow"
2525 [ bench "reference" $ nf countdownRef n
26− , bench "effectful (pure-static)" $ nfAppIO countdownEffectfulStatic n
27− , bench "effectful (pure-dynamic)" $ nfAppIO countdownEffectfulDynPure n
28− , bench "effectful (MVar-static)" $ nfAppIO countdownEffectfulMVar n
29− , bench "effectful (MVar-dynamic)" $ nfAppIO countdownEffectfulDynMVar n
26+ , bench "effectful (pure-static)" $ nf countdownEffectfulStatic n
27+ , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPure n
28+ , bench "effectful (MVar-static)" $ nf countdownEffectfulMVar n
29+ , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVar n
3030#ifdef VERSION_freer_simple
3131 , bench "freer-simple" $ nf countdownFreerSimple n
3232#endif
@@ -42,10 +42,10 @@ countdown n = bgroup (show n)
4242#endif
4343 ]
4444 , bgroup "deep"
45− [ bench "effectful (pure-static)" $ nfAppIO countdownEffectfulStaticDeep n
46− , bench "effectful (pure-dynamic)" $ nfAppIO countdownEffectfulDynPureDeep n
47− , bench "effectful (MVar-static)" $ nfAppIO countdownEffectfulMVarDeep n
48− , bench "effectful (MVar-dynamic)" $ nfAppIO countdownEffectfulDynMVarDeep n
45+ [ bench "effectful (pure-static)" $ nf countdownEffectfulStaticDeep n
46+ , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPureDeep n
47+ , bench "effectful (MVar-static)" $ nf countdownEffectfulMVarDeep n
48+ , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVarDeep n
4949#ifdef VERSION_freer_simple
5050 , bench "freer-simple" $ nf countdownFreerSimpleDeep n
5151#endif
effectful.cabal+2−1
@@ -84,9 +84,10 @@ library
8484test-suite test
8585 import: language
8686
87− ghc-options: -threaded -rtsopts
87+ ghc-options: -threaded -rtsopts -with-rtsopts=-N4
8888
8989 build-depends: base <5
90+ , async
9091 , effectful
9192 , exceptions
9293 , lifted-base
src/Effectful/Internal/Monad.hs+14−3
@@ -38,6 +38,7 @@ import Control.Monad.IO.Class
3838import Control.Monad.IO.Unlift
3939import Control.Monad.Trans.Control
4040import GHC.Magic (oneShot)
41+import System.IO.Unsafe (unsafePerformIO)
4142
4243import Effectful.Internal.Effect
4344import Effectful.Internal.Env
@@ -46,8 +47,15 @@ type role Eff nominal representational
4647
4748newtype Eff (es :: [Effect]) a = Eff { unEff :: Env es -> IO a }
4849
49−runEff :: Eff '[] a -> IO a
50−runEff (Eff m) = m =<< emptyEnv
50+-- | Run a pure 'Eff' computation.
51+--
52+-- For the impure version see 'runIOE'.
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).
58+ unsafePerformIO $ m =<< emptyEnv
5159
5260unsafeEff :: (Env es -> IO a) -> Eff es a
5361unsafeEff m = Eff (oneShot m)
@@ -141,8 +149,11 @@ instance MonadMask (Eff es) where
141149data IOE :: Effect where
142150 IOE :: IOE m r
143151
152+-- | Run an impure 'Eff' computation.
153+--
154+-- For the pure version see 'runEff'.
144155runIOE :: Eff '[IOE] a -> IO a
145−runIOE = runEff . evalEffect (IdE IOE)
156+runIOE m = unEff (evalEffect (IdE IOE) m) =<< emptyEnv
146157
147158instance IOE :> es => MonadIO (Eff es) where
148159 liftIO = unsafeEff_
src/Effectful/Resource.hs+1−1
@@ -26,7 +26,7 @@ newtype Resource :: Effect where
2626 Resource :: R.InternalState -> Resource m r
2727
2828-- | Run the resource effect.
29−runResource :: Eff (Resource : es) a -> Eff es a
29+runResource :: IOE :> es => Eff (Resource : es) a -> Eff es a
3030runResource (Eff m) = unsafeEff $ \es0 -> do
3131 size0 <- sizeEnv es0
3232 istate <- R.createInternalState
tests/Main.hs+18
@@ -1,5 +1,6 @@
11module Main (main) where
22
3+import Control.Concurrent.Async
34import Control.Monad.IO.Class
45import Test.Tasty
56import Test.Tasty.HUnit
@@ -19,6 +20,7 @@ main = defaultMain $ testGroup "effectful"
1920 , testCase "stateM" test_stateM
2021 , testCase "deep stack" test_deepStack
2122 , testCase "exceptions" test_exceptions
23+ , testCase "concurrency" test_concurrentState
2224 , testCase "local effects" test_localEffects
2325 ]
2426 ]
@@ -87,6 +89,22 @@ test_exceptions = runIOE $ do
8789 _ <- E.throwM Ex
8890 modify @Int (+2)
8991
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+
90108test_localEffects :: Assertion
91109test_localEffects = runIOE $ do
92110 x <- runHasInt 0 $ do