blob: af961fe6818769285e4c547df605afa139e26664 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
module Main (main) where
import Control.Concurrent.STM
data Free f a = Pure a | Free (f (Free f a))
data SuspendF a
= forall r. StepSTM (STM r)
| forall r. StepIO (IO r)
effect :: STM a -> Free SuspendF a
effect a = Free $ StepSTM a
io :: IO a -> Free SuspendF a
io a = Free $ StepIO a
comb :: [Free SuspendF a] -> Free SuspendF a
comb vs = io $ do
_ <- mapM go vs
undefined
go :: Free SuspendF a -> IO (STM ())
go (Free (StepIO a)) = a >>= \_ -> go $ Pure undefined
go (Free (StepSTM a)) = pure $ a >>= \_ -> pure ()
go (Pure _) = pure $ pure ()
runWidget :: Free SuspendF a -> IO a
runWidget w = case w of
Free (StepIO io) -> do
_ <- io
undefined
-- Uncommenting this hid the original bug.
--main :: IO ()
main = runWidget $ comb $ replicate 10000000 (effect retry)
|
