module Main where

import Control.Monad.Trans

import System.IOR
import System.IOR.Resource

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

newtype P
  = P String

openP  :: String -> IO P
closeP :: P -> IO ()
writeP :: P -> String -> IO ()

openP s = do
    putStrLn ("opening " ++ s)
    return   (P s)

closeP (P s) =
    putStrLn ("closing " ++ s)

writeP (P s) msg =
    putStrLn ("writing " ++ msg ++ " to " ++ s)

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

newtype R r
  = R (Resource r P)

openR  :: String -> IOR r rs (R r)
closeR :: RElem r' rs => R r' -> IOR r rs ()
writeR :: RElem r' rs => R r' -> String -> IOR r rs ()

openR s = do
    p <- liftIO (openP s)
    fmap R (manage p closeP)

closeR (R r) =
    release r

writeR (R r) msg =
    liftIO (writeP (getResource r) msg)

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

main :: IO ()
main = runIOR $ do
    r     <- getIORTag
    res1a <- openR "res1a"
    res1b <- openR "res1b"
    newIOR $ do
        res2a <- openR "res2a"
        res1c <- withIORTag r $ openR "res1c"
        writeR res1b "msg1"
        closeR res1b
        writeR res1c "msg2"
        writeR res2a "msg3"
    writeR res1a "msg4"