[Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

Ryan Ingram ryani.spam at gmail.com
Wed Sep 3 08:07:06 EDT 2008


Looks like MaybeT?
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/MaybeT-0.1.1

> readHandle x = runMaybeT $ do
>     ref <-  MaybeT (return x)
>     liftIO (readIORef ref)
> readField f h = runMaybeT $ do
>     a <- MaybeT (readHandle h)
>     return (f a)

(or, the short version)
> readHandle x = runMaybeT (liftIO . readIORef =<< MaybeT (return x))
> readField f = runMaybeT . liftM f . MaybeT . readHandle

As a bonus, readHandle and readField work in any MonadIO due to the
use of liftIO (as opposed to just lift).

  -- ryan





On Wed, Sep 3, 2008 at 3:09 AM, minh thu <noteed at gmail.com> wrote:
> Hi,
>
> I'd like to write a data structure to be used inside the IO monad.
> The structure has some handles of type Maybe (IORef a),
> i.e. IORef are pointers and the Maybe is like null pointers.
>
> So I came up with the following functions :
>
> readHandle :: Maybe (IORef a) -> IO (Maybe a)
> readField :: (a -> b) -> Maybe (IORef a) -> IO (Maybe b)
>
> readHandle Nothing  = do
>  return Nothing
> readHandle (Just r) = do
>  v <- readIORef r
>  return $ Just v
>
> readField f h = do
>  m <- readHandle h
>  return $ fmap f m
>
> Is it something usual ?
> Are there any related functions in the standard libraries ?
>
> Thanks,
> Thu
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list