{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, UndecidableInstances  #-}
{-

This code hangs when running under Ubuntu Precise. Though a Precise chroot on an Ubuntu Lucid machine works -- indicating it could be kernel specific.

The following changes make the code work:

 1. replacing 'readTVar u' with 'return ()'
 2. removing the 'Wrapper' monad and just using 'StateT'
 3. deriving the 'MonadState' instance instead of righting it by hand
 4. copying the definition of 'modify' into the local module and use that instead of the imported version

-}
module Main (main) where

import Control.Monad.State    (MonadState, StateT, modify, evalStateT, get, put)
import Control.Monad.Trans    (MonadIO(liftIO))
import Control.Concurrent.STM (TVar, atomically, newTVar, readTVar)

newtype Wrapper a = Wrapper { unWrapper :: StateT (TVar ()) IO a }
    deriving (Functor, MonadIO, Monad)

instance (MonadState (TVar ()) Wrapper) where  
  get   = Wrapper get
  put s = Wrapper (put s)

setUnique :: Wrapper ()
setUnique =
    do u <- get
       _ <- liftIO $ atomically $ readTVar u
       return ()

main :: IO ()
main =
      do putStrLn "hello"
         u <- atomically $ newTVar ()
         evalStateT (unWrapper (modify id >> setUnique)) u