Mixing IO and other monads
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? -- Brian
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
On Mon, 30 Aug 2010 00:56:06 +0200, Brian Victor
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
This can be made more readable if main is split up:
main :: IO () main = do initialize ideviceId <- getDefaultInputDeviceID case ideviceId of Nothing -> putStrLn "No default input device" Just inputDeviceId -> main2 inputDeviceId where main2 inputDeviceId = do odeviceId <- getDefaultOutputDeviceID case odeviceId of Nothing -> putStrLn "No default output device" Just outputDeviceId -> main3 inputDeviceId outputDeviceId
main3 inputDeviceId outputDeviceId = do openInputResult <- openInput inputDeviceId case openInputResult of Right err -> putStrLn $ show err Left inputStream -> main4 inputDeviceId outputDeviceId inputStream
main4 inputDeviceId outputDeviceId inputStream = do openOutputResult <- openOutput outputDeviceId 0 case openOutputResult of Right err -> putStrLn $ show err Left outputStream -> runTranslationLoop inputStream outputStream
This can be made more compact with the aid of the following two functions:
ifLeft x f = x' <- x case x' of Right err -> putStrLn $ show err Left y -> f y
ifJust x f msg = x' <- x case x' of Nothing -> putStrLn msg Just y -> f y
The main program than becomes:
main :: IO () main = do initialize ifJust getDefaultInputDeviceID main2 "No default input device"
where main2 inputDeviceId = ifJust getDefaultOutputDeviceID (main3 inputDeviceId) "No default output device"
main3 inputDeviceId outputDeviceId = ifLeft (openInput inputDeviceId) (main4 inputDeviceId outputDeviceId)
main4 inputDeviceId outputDeviceId inputStream = ifLeft (openOutput outputDeviceId 0) (runTranslationLoop inputStream)
Of course, another thing to prevent long lines, is to use two spaces for indentation. Met vriendelijke groet, Henk-Jan van Tuyl -- http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html --
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 On 8/29/10 18:56 , Brian Victor wrote:
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?
You don't really need one; use the existing plumbing.
ioE :: e -> IO (Maybe a) -> IO a ioE e a = a >>= \r -> case r of Just r' -> r' Nothing -> fail e
io :: IO (Either e a) -> IO a io a = a >>= \r -> case r of Right v -> v Left e -> fail $ show e
main = do initialize iDeviceId <- ioE "No default input device" getDefaultInputDeviceId oDeviceId <- ioE "No default output device" getDefaultOutputDeviceId inputStream <- io $ openInput inputDeviceId outputStream <- io $ openOutput outputDeviceId 0 runTranslationLoop inputStream outputStream
If you really want a monad transformer, ErrorT is probably the one to look at (Control.Monad.Error). But it won't be pretty unless you rewrite the functions getDefault(...) and open(...) to use it as well. - -- brandon s. allbery [linux,solaris,freebsd,perl] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH -----BEGIN PGP SIGNATURE----- Version: GnuPG v2.0.10 (Darwin) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/ iEYEARECAAYFAkx70+cACgkQIn7hlCsL25V+7QCgkBPSUIzfpnRX69utD7o8d4oz 8FkAn3Sn47biInZg7dp56rThwamVmzu9 =tPWe -----END PGP SIGNATURE-----
Sorry it took so long, but I have to thank everyone who responded. You all gave me some good ideas. Brandon's approach most closely resembled what I'm going with for the moment. I did have to make a few changes, which are shown below for archival purposes. The changes are: 1) Made the first parameter to ioE a String since fail requires it. 2) Switched left/right in io since that's how PortMidi does it. 3) Added (Show e) constraint to io 4) Added return to the Just and Left branches of the case. ioE :: String -> IO (Maybe a) -> IO a ioE e a = a >>= \r -> case r of Just r' -> return r' Nothing -> fail e io :: (Show e) => IO (Either a e) -> IO a io a = a >>= \r -> case r of Left v -> return v Right e -> fail $ show e main :: IO () main = do initialize inputDeviceId <- ioE "No default input device" getDefaultInputDeviceID outputDeviceId <- ioE "No default output device" getDefaultOutputDeviceID inputStream <- io $ openInput inputDeviceId outputStream <- io $ openOutput outputDeviceId 0 putStrLn "Starting translation" runTranslationLoop inputStream outputStream Thanks again! -- Brian
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 On 9/7/10 08:58 , Brian Victor wrote:
4) Added return to the Just and Left branches of the case.
That's in the running for my most common error when writing Haskell code :/ - -- brandon s. allbery [linux,solaris,freebsd,perl] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH -----BEGIN PGP SIGNATURE----- Version: GnuPG v2.0.10 (Darwin) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/ iEYEARECAAYFAkyGZK0ACgkQIn7hlCsL25W30gCePwo25uCqGeRtFrahIBkOBaxl BowAn0vbrQLl+pinGgix/TK1NgigoPl7 =RGFE -----END PGP SIGNATURE-----
participants (4)
-
Brandon S Allbery KF8NH -
Brian Victor -
Daniel Fischer -
Henk-Jan van Tuyl