summaryrefslogtreecommitdiff
path: root/testsuite/tests/profiling/should_run/ioprof.hs
blob: 98c7f4e24160406d94e5c9c9fe9d3004570d53a4 (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
import Control.Concurrent
import Control.Exception
import Control.Monad (ap, liftM)
import Control.Applicative

type S = String

newtype M s a = M { unM :: s -> (s,a) }

instance Monad (M s) where
  (M m) >>= k = M $ \s -> case m s of
                            (s',a) -> unM (k a) s'
  return a = M $ \s -> (s,a)

instance Functor (M s) where
    fmap = liftM

instance Applicative (M s) where
    pure  = return
    (<*>) = ap

errorM :: String -> M s a
errorM s = M $ \_ -> error s

runM :: M s a -> s -> a
runM (M m) s = case m s of (_,a) -> a

main = print (runM (bar ["a","b"]) "state")

bar :: [String] -> M s [String]
bar xs = mapM foo xs

foo :: String -> M s String
foo x = errorM x