Ticket #5751: AnotherLoop.hs

File AnotherLoop.hs, 924 bytes (added by JeremyShaw, 2 years ago)

example program which exits with <<loop>> under 7.4

Line 
1{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverlappingInstances, UndecidableInstances #-}
2module Main where
3
4import Control.Monad.Trans (MonadIO(..))
5
6class XMLGenerator m where
7    genElement :: (Maybe String, String) -> m ()
8
9newtype IdentityT m a = IdentityT { runIdentityT :: m a }
10    deriving (Monad, MonadIO)
11
12instance (MonadIO m) => (XMLGenerator (IdentityT m)) where
13    genElement _ = liftIO $ putStrLn "in genElement"
14
15main :: IO ()
16main = 
17    do runIdentityT web
18       putStrLn "done."
19
20class (Widgets x) => MonadRender x
21class (XMLGenerator m)  => Widgets m
22-- instance Widgets (IdentityT IO) -- if you uncomment this, it will work
23instance MonadRender m => Widgets m
24instance MonadRender (IdentityT IO)
25
26web :: ( MonadIO m
27       , Widgets m
28       , XMLGenerator m
29       ) => m ()
30web =
31    do liftIO $ putStrLn "before"
32       genElement (Nothing, "p")
33       return ()