[Haskell-beginners] Mixing IO and other monads

[Daniel Fischer]

On Monday 30 August 2010 00:56:06, Brian Victor wrote:
> I've managed to create the sort of nested case code that all the monad
> tutorials warn you against.  I haven't found a way to work myself out of
> it, though.  If I've understood monad transformers conceptually, this
> seems like the sort of thing they'd be good for, but I don't know how to
> actually make what I need.
>
> Here's the code I have.  getDefaultInputDeviceID and
> getDefaultOutputDeviceID are from PortMidi, and return IO (Maybe Int).
> openInput and openOutput return IO (Either PMStream PMError).  At this
> point, I'd be happy to get the second half of the function refactored
> into monads.
>
> main :: IO ()
> main = do
>     initialize
>     ideviceId <- getDefaultInputDeviceID
>     case ideviceId of
>         Nothing -> putStrLn "No default input device"
>         Just inputDeviceId -> do
>             odeviceId <- getDefaultOutputDeviceID
>             case odeviceId of
>                 Nothing -> putStrLn "No default output device"
>                 Just outputDeviceId -> do
>                     openInputResult <- openInput inputDeviceId
>                     case openInputResult of
>                         Right err -> putStrLn $ show err
>                         Left inputStream -> do
>                             openOutputResult <- openOutput
> outputDeviceId 0 case openOutputResult of
>                                 Right err -> putStrLn $ show err
>                                 Left outputStream -> runTranslationLoop
> inputStream outputStream
>
>
> It seems like I ought to be able to change the second half of the
> function to something like this:
>
> openStreamsAndLoop :: (Num a) => a -> a -> IO (Maybe err)
> openStreamsAndLoop inputDeviceId outputDeviceId = do
>     inputStream <- openInput inputDeviceId
>     outputStream <- openOutput outputDeviceId 0
>     runTranslationLoop inputStream outputStream
>     return Nothing
>
> But how do I create an IO (Maybe err) monad?

Not sure it's so much better, but here you go:


import Control.Monad.Trans
import Control.Monad.Instances

newtype ErrIO a = EIO { unErrIO :: IO (Either String a) }

runErrIO :: ErrIO a -> IO ()
runErrIO eio = unErrIO eio >>= either putStrLn (const $ return ())

instance Functor ErrIO where
    fmap f  = EIO . fmap (fmap f) . unErrIO

instance Monad ErrIO where
    return = EIO . return . Right
    eio >>= f = EIO $ do
        e <- unErrIO eio
        case e of
            Left oops -> return $ Left oops
            Right val -> unErrIO $ f val
    fail = EIO . return . Left

instance MonadIO ErrIO where
    liftIO io = EIO $ fmap Right io

tryMaybe :: String -> IO (Maybe a) -> ErrIO a
tryMaybe err act = EIO $ act >>= return . maybe (Left err) Right

reflect :: Show e => IO (Either r e) -> ErrIO r
reflect = EIO . fmap (either Right (Left . show))

main :: IO ()
main = runErrIO $ do
  liftIO initialize
  inputDeviceId <- tryMaybe "No default input device" 
getDefaultInputDeviceID
  outputDeviceId <- tryMaybe "No default output device" 
getDefaultOutputDeviceID
  inputStream <- reflect $ openInput inputDeviceId
  outputStream <- reflect $ openOutput outputDeviceId 0
  liftIO $ runTranslationLoop inputStream outputStream