module Control.Monad.Restricted where
import Data.Monoid
import Control.Concurrent
import Control.Monad.State
import qualified System.Environment as Env
import System.IO.Error (catchIOError, isDoesNotExistError)
type Morph m n = forall a . m a -> n a
newtype MorphD m n = MorphD { runMorphD :: Morph m n }
class (Monad m) => NewRef m where
newRef' :: a -> m (MorphD (StateT a m) m)
instance NewRef IO where
newRef' x = do
vx <- liftIO $ newMVar x
return $ MorphD $ \m -> modifyMVar vx $ liftM swap . runStateT m
where
swap (a, b) = (b, a)
class Monad m => SafeIO m where
getArgs :: m [String]
getProgName :: m String
lookupEnv :: String -> m (Maybe String)
instance SafeIO IO where
getArgs = Env.getArgs
getProgName = Env.getProgName
lookupEnv v = catchIOError (liftM Just $ Env.getEnv v) $ \e ->
if isDoesNotExistError e then return Nothing else ioError e
newtype MonadMonoid a = MonadMonoid { runMonadMonoid :: a () }
instance Monad m => Monoid (MonadMonoid m) where
mempty = MonadMonoid $ return ()
MonadMonoid a `mappend` MonadMonoid b = MonadMonoid $ a >> b