summaryrefslogtreecommitdiff
path: root/testsuite/tests/typecheck/should_run/T5751.hs
blob: 7c7d8ab0b918319fb0c3604235163f41b293534e (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
38
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverlappingInstances, UndecidableInstances #-}
module Main where

class (Monad m) => MonadIO m where
    -- | Lift a computation from the 'IO' monad.
    liftIO :: IO a -> m a

instance MonadIO IO where
    liftIO = id

class XMLGenerator m where
    genElement :: (Maybe String, String) -> m ()

newtype IdentityT m a = IdentityT { runIdentityT :: m a }
    deriving (Functor, Applicative, Monad, MonadIO)

instance (MonadIO m) => (XMLGenerator (IdentityT m)) where
    genElement _ = liftIO $ putStrLn "in genElement"

main :: IO ()
main =
    do runIdentityT web
       putStrLn "done."

class (Widgets x) => MonadRender x
class (XMLGenerator m)  => Widgets m
-- instance Widgets (IdentityT IO) -- if you uncomment this, it will work
instance (XMLGenerator m, MonadRender m) => Widgets m
instance MonadRender (IdentityT IO)

web :: ( MonadIO m
       , Widgets m
       , XMLGenerator m
       ) => m ()
web =
    do liftIO $ putStrLn "before"
       genElement (Nothing, "p")
       return ()