{-# OPTIONS -fglasgow-exts #-} 

-- parser.hs: Copyright (C)2001,2002 Keean Schupke.
--
--		Polymorphic monadic consumer based parser.

module Main where

import Control.Monad hiding (guard)
import Control.Concurrent
import Control.Exception as Exception
import Lib.Monad.MonadT 
import IO
import Network

------------------------------------------------------------------------------

class Monad m => MonadIO m where
	ioBracket :: m a -> (a -> m b) -> (a -> m c) -> m c
	liftIO :: IO a -> m a

instance MonadIO IO where
	ioBracket = Exception.bracket
	liftIO = id

instance (MonadIO m,MonadT t m) => MonadIO (t m) where
	ioBracket = up3 ioBracket
	liftIO = up . liftIO

------------------------------------------------------------------------------

newtype Region marks m a = Region { unRegion :: (m a) } deriving Monad
class InRegion a b
instance InRegion () b

newtype Private mark h = Private h
liftR :: (InRegion mark marks) => (h -> m a) -> Private mark h -> Region marks m a
liftR f (Private h) = Region $ f h 

bracketR :: MonadIO m => m h -> (h -> m b) -> (forall mark . InRegion mark marks => Private mark h -> Region marks m a) -> Region marks m a
bracketR f g h = Region $ ioBracket f g (\(x :: t) -> unRegion $ h ((Private x) :: Private () t))

runR :: (forall mark . Region mark m a) -> m a
runR = unRegion

test1 = bracketR (openFile "/etc/services" ReadMode) (hClose) (\f -> do
	c1 <- (liftR hGetChar) f
	c2 <- (liftR hGetChar) f
	return [c1,c2])

-- test2 = bracketR (openFile "/etc/services" ReadMode) (hClose) (\f -> return f)
test3 = bracketR (openFile "/etc/services" ReadMode) (hClose) (\f -> (liftR hGetChar) f)
-- test4 = bracketR (openFile "/etc/services" ReadMode) (hClose) (\f -> return ((liftR hGetChar) f))
-- test5 = bracketR (openFile "/etc/services" ReadMode) (hClose) (\f -> f)

main = do
	runR test1 >>= print
	-- runR test2 >>= print
	runR test3 >>= print
	-- runR test4 >>= print