How to do control flow in Haskell - haskell

I'll give an example of what I want to do right away.
version1 :: IO ()
version1 =
if boolCheck
then case maybeCheck of
Nothing -> putStrLn "Error: simple maybe failed"
Just v -> case eitherCheck of
Left e -> putStrLn $ "Error: " ++ show e
Right w -> monadicBoolCheck v >>= \case
False -> putStrLn "Error: monadic bool check failed"
True -> print "successfully doing the thing"
else putStrLn "simple bool check failed"
Basically I want to "do a thing" under the condition that a number of checks turns out positive.
Whenever a single check turns out negative, I want to preserve the information about the offending check and abort the mission.
In real life those checks have different types, therefore I called them
boolCheck :: Bool
maybeCheck :: Maybe a
eitherCheck :: Show a => Either a b
monadicBoolCheck :: Monad m => m Bool
Those are just examples.
Feel free to also think of monadic Maybe, EitherT or a a singleton list where I extract head and fail when it is not a singleton.
Now I am trying to improve the above implementation and the Either monad came into my mind, because it has the notion of aborting with an error message.
version2 :: IO ()
version2 = do
result <- runEitherT $ do
if boolCheck
then pure ()
else left "simple bool check failed"
v <- case maybeCheck of
Just x -> pure x
Nothing -> left "simple maybe check failed"
w <- hoistEither . mapLeft show $ eitherCheck
monadicBoolCheck v >>= \case
True -> pure ()
False -> left "monadic bool check failed"
case result of
Left msg -> putStrLn $ "Error: " ++ msg
Right _ -> print "successfully doing the thing"
While I prefer version2, the improvement in readability is probably marginal.
Version2 is superior when it comes to adding further checks.
Is there an ultimately elegant way of doing this?
What I don't like:
1) I am partly abusing the Either monad and what I actually do is more like a Maybe monad with the rolls of Just and Nothing switched in the monadic bind
2) The conversion of the checks to Either requires either rather verbose use of case or a conversion function (like hoistEither).
Ways of improving readability might be:
1) define helper functions to allow code like
v <- myMaybePairToEither "This check failed" monadicMaybePairCheck
monadicMaybePairCheck :: Monad m => m (Maybe x, y)
...
myMaybePairToEither :: String -> m (Maybe x, y) -> EitherT m e z
myMaybePairToEither _ (Just x, y) = pure $ f x y
myMaybePairToEither msg (Nothing, _) = left msg
2) consistently use explicit cases, not even use hoistEither
3) defining my own monad to stop the Either abuse ... I could provide all the conversion functions along with it (if no-one has already done something like that)
4) use maybe and either where possible
5) ... ?

Use maybe, either, and the mtl package. By the by, eitherCheck :: Show a => Either a b's Show a constraint is probably not what you want: it lets callers choose whatever type they want as long as the type implements Show a. You were probably intending having a be a type such that callers would only be able to call show on the value. Probably!
{-# LANGUAGE FlexibleContexts #-}
newtype Error = Error String
gauntlet :: MonadError Error m => m ()
gauntlet = do
unless boolCheck (throw "simple bool check failed")
_ <- maybe (throw "simple maybe check failed") pure maybeCheck
_ <- either throw pure eitherCheck
x <- monadicBoolCheck
unless x (throw "monadic bool check failed")
return ()
where
throw = throwError . Error
version2 :: IO ()
version2 =
putStrLn (case gauntlet of
Left (Error e) ->
"Error: " ++ e
Right _ ->
"successfully doing thing")

"Define helper functions" is exactly how I would handle this. The errors library provides many already, with the possible exception of satisfying Bool functions. For those I would just use when/unless.
And of course, to the extent possible, you should promote the actions you're calling to be suitably polymorphic so that no conversion is needed.

So I'd probably start by reworking your version2 into something like
import Control.Monad.Trans
import Control.Monad.Trans.Either hiding (left, right)
import Control.Monad
import Control.Applicative
import Control.Arrow
version3 :: IO ()
version3 = eitherT onFailure onSuccess $ do
guard boolCheck <|> fail "simple bool check failed"
v <- hoistEither $ maybe (Left "simple maybe check failed") Right maybeCheck
w <- hoistEither . left show $ eitherCheck
lift (guard =<< monadicBoolCheck v) <|> fail "monadic boolcheck failed"
where
onFailure msg = putStrLn $ "Error: "++msg
onSuccess _ = print "successfully doing the thing"
Which I find more readable, but is still a bit awkward, so if I was doing a lot
of code like this, I'd introduce some helpers:
version4 :: IO ()
version4 = eitherT onFailure onSuccess $ do
failUnless "simple bool check failed" boolCheck
v <- hoistMaybe "simple maybe check failed" maybeCheck
w <- hoistEitherWith show eitherCheck
failUnless "monadic boolcheck failed" =<< lift (monadicBoolCheck v)
where
onFailure msg = putStrLn $ "Error: "++msg
onSuccess _ = print "successfully doing the thing"
failUnless :: Monad m => String -> Bool -> m ()
failUnless _ True = return ()
failUnless msg _ = fail msg
hoistMaybe :: Monad m => e -> Maybe a -> EitherT e m a
hoistMaybe err = hoistEither . maybe (Left err) Right
hoistEitherWith :: Monad m => (e -> e') -> Either e a -> EitherT e' m a
hoistEitherWith f = hoistEither . left f

In order to have the full range of possible options here, check out this gist:
https://gist.github.com/rubenmoor/c390901247e4e7bb97cf
It defines several helper functions, basically combining maybe, either and such with throwError. and results in code like this.
gauntlet :: MonadError Error m => m (a, b, c)
gauntlet = do
assertTrue boolCheck $ Error "simple bool check failed"
v <- assertJust maybeCheck $ Error "simple maybe check failed"
assertNothing maybeCheck' $ Error . show
w <- assertRight eitherCheck $ Error . show
b <- monadicBoolCheck
assertTrue b $ Error "monadic bool check failed"
x <- assertSingletonList list $ Error "list not singleton"
pure (v, w, x)
version3 :: IO ()
version3 = putStrLn $
case gauntlet of
Left (Error e) -> "Error: " ++ e
Right result -> "successfully doing thing with result"

Related

Enforcing strictness in Haskell

While doing some TTD in Haskell, I recently developed the following function:
import Test.HUnit
import Data.Typeable
import Control.Exception
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun = catch (fun >> assertFailure msg) handle
where
msg = show errType ++ " exception was not raised!"
handle (SomeException e) [...]
The function takes a Type representation of an expected exception and an IO action. The problem is that most of the time I don't get the exception thrown even though I should have been, because of laziness. Often failing parts of fun are actually never evaluated here.
To remedy this i tried to replace (fun >> assertFailure msg) with (seq fun $ assertFailure msg). I also tried to enable BangPatterns extension and put a bang before fun binding, but none of it helped. So how can I really force Haskell to evaluate fun strictly?
You have to distinguish between:
Evaluating the value of type IO a
Running the action represented by it, which may have side effects and returns a value of type a, and
Evaluating the result of type a (or parts of it).
These always happen in that order, but not necessarily all of it. The code
foo1 :: IO a -> IO ()
foo1 f = do
seq f (putStrLn "done")
will do only the first, while
foo2 :: IO a -> IO ()
foo2 f = do
f -- equivalent to _ <- f
putStrLn "done"
also does the second and finally
foo3 :: IO a -> IO ()
foo3 f = do
x <- f
seq x $ putStrLn "done"
also does the third (but the usual caveats of using seq on a complex data type like lists apply).
Try these arguments and observe that foo1, foo2 and foo3 treat them differently.
f1 = error "I am not a value"
f2 = fix id -- neither am I
f3 = do {putStrLn "Something is printed"; return 42}
f4 = do {putStrLn "Something is printed"; return (error "x has been evaluated")}
f5 = do {putStrLn "Something is printed"; return (Just (error "x has been deeply evaluated"))}
You probably need to force the value to its normal form, not just its weak head normal form. For example, evaluating Just (error "foo") to WHNF won't trigger the exception, it'll just evaluate Just. I'd use the combination of evaluate (which allows to properly sequence forced evaluation with IO actions) and rnf (or force if you'd need the value for something):
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
catch (fun >>= evaluate . rnf >> assertFailure msg) handle
where ...
However, be careful, as assertFailure is implemented using exceptions, so wrapping into the catch block might catch it as well. So I'd suggest to evaluate the computation using try and call assertFailure outside the try block:
import Test.HUnit
import Data.Typeable
import Control.DeepSeq
import Control.Exception
assertException :: (NFData a, Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
(try (fun >>= evaluate . rnf) :: IO (Either SomeException ())) >>= check
where
check (Right _) =
assertFailure $ show errType ++ " exception was not raised!"
check (Left (SomeException ex))
| typeOf ex == errType = return () -- the expected exception
| otherwise = assertFailure
$ show ex ++ " is not " ++ show errType

the statement <- doesn't compile for Maybe

import Network.HTTP.Conduit
import qualified Data.HashMap.Lazy as LHashMap
import Network.HTTP.Types
getJSONObject :: String -> IO Object
--.............
main = do
jsonObject <- getJSONObject "example.com"
String a <- LHashMap.lookup "some_key" jsonObject -- doesn't compile
--.....................................
The error is:
Couldn't match type `Maybe' with `IO'
Expected type: IO Value
Actual type: Maybe Value
Indeed, LHashMap.lookup returns Maybe, not IO. But shouldn't <- work with Monads like Maybe?
How do I make it work?
UPDATE:
According to the error above, the code below should not work due to the same thing:
let toPrint = do
Object jsonObject <- decode $ responseBody res :: Maybe Value
Object jsonObject2 <- LHashMap.lookup "key1" jsonObject
Object jsonObject3 <- LHashMap.lookup "key2" jsonObject2
Array d <- LHashMap.lookup "key3" jsonObject3
String val <- return $ d ! 1
return val
case toPrint of
Just a -> IO.putStrLn a
_ -> error "Unexpected JSON"
But it does work.
All the monadic values in do-notation need to be from the same Monad. It's easy to see this if you desugar the do notation:
main = getJSONObject "example.com" >>= (\jsonObject ->
LHashMap.lookup "some_key" jsonObject >>= (\String a -> ... ))
And look at the type of >>=
>>= :: Monad m => m a -> (a -> m b) -> m b
Note that though the parameter m makes >>= polymorphic, it's the same m for both arguments and the return value.
In particular, that means that the typechecker requires that getJSONObject "example.com" return a value in the same monad that LHashMap.lookup "some_key" jsonObject >>= (\String a -> ...) does, which requires that LHashMap.lookup "some_key" jsonObject be in that same monad. And thus your error.
You need to figure out how you want to handle failure:
You could just make it into a pattern-match exception by using a let statment instead of a bind (not recommended):
% cat Temp.hs
module Main where
main = do
let Just x = Nothing
putStrLn $ "Hello " ++ x
% runhaskell Temp.hs
Temp.hs: Temp.hs:4:7-22: Irrefutable pattern failed for pattern Data.Maybe.Just x
%
You could make it into a failure in the IO monad, which would make it into a slightly different exceptio (also not recommended)n
% cat Temp.hs
module Main where
main = do
Just x <- return Nothing
putStrLn $ "Hello " ++ x
% runhaskell Temp.hs
Temp.hs: user error (Pattern match failure in do expression at Temp.hs:4:3-8)
%
You could use a case statement (recommended):
% cat Temp.hs
module Main where
main = do
case Nothing of
Nothing -> return ()
Just x -> putStrLn $ "Hello " ++ x
% runhaskell Temp.hs
%
In a do block the monad that you use is meant to be homogenous, since it desugars to
(>>=) :: Monad m => m a -> (a -> m b) -> m b
Since the m is consistent throughout bind, we also have to be consistent with it throughout our block.
the correct solution here is to handle the maybe in a pure way, and not treat it "monadically". A simple solution might be to just use a case expression
case LHashMap.lookup "some_key" jsonObject of
Just res -> some IO here
Nothing -> handle failure here
or just to smash that into an expression with
maybe :: b -> (a -> b) -> Maybe a -> b

Parsec: error message at specific location

Using Parsec how does one indicate an error at a specific position if a semantic rule is violated. I know typically we don't want to do such things, but consider the example grammar.
<foo> ::= <bar> | ...
<bar> ::= a positive integer power of two
The <bar> rule is a finite set (my example is arbitrary), and a pure approach to the above could be a careful application of the choice combinator, but this might be impractical in space and time. In recursive descent or toolkit-generated parsers the standard trick is to parse an integer (a more relaxed grammar) and then semantically check the harder constraints. For Parsec, I could use a natural parser and check the result calling fail when that doesn't match or unexpected or whatever. But if we do that, the default error location is the wrong one. Somehow I need to raise the error at the earlier state.
I tried a brute force solution and wrote a combinator that uses getPosition and setPosition as illustrated by this very similar question. Of course, I was also unsuccessful (the error location is, of course wrong). I've run into this pattern many times. I am kind of looking for this type of combinator:
withPredicate :: (a -> Bool) -> String -> P a -> P a
withPredicate pred lbl p = do
ok <- lookAhead $ fmap pred (try p) <|> return False -- peek ahead
if ok then p -- consume the input if the value passed the predicate
else fail lbl -- otherwise raise the error at the *start* of this token
pPowerOfTwo = withPredicate isPowerOfTwo "power of two" natural
where isPowerOfTwo = (`elem` [2^i | i<-[1..20]])
The above does not work. (I tried variants on this as well.) Somehow the parser backtracks a says it's expecting a digit. I assume it's returning the error that made it the furthest. Even {get,set}ParserState fails erase that memory.
Am I handling this syntactic pattern wrong? How would all you Parsec users approach these type of problems?
Thanks!
I think both your ideas are OK. The other two answers deal with Parsec, but I'd like to note that in both
cases Megaparsec just does the right thing:
{-# LANGUAGE TypeApplications #-}
module Main (main) where
import Control.Monad
import Data.Void
import Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
withPredicate1 :: (a -> Bool) -> String -> Parser a -> Parser a
withPredicate1 f msg p = do
r <- lookAhead p
if f r
then p
else fail msg
withPredicate2 :: (a -> Bool) -> String -> Parser a -> Parser a
withPredicate2 f msg p = do
mpos <- getNextTokenPosition -- †
r <- p
if f r
then return r
else do
forM_ mpos setPosition
fail msg
main :: IO ()
main = do
let msg = "I only like numbers greater than 42!"
parseTest' (withPredicate1 #Integer (> 42) msg L.decimal) "11"
parseTest' (withPredicate2 #Integer (> 42) msg L.decimal) "22"
If I run it:
The next big Haskell project is about to start!
λ> :main
1:1:
|
1 | 11
| ^
I only like numbers greater than 42!
1:1:
|
1 | 22
| ^
I only like numbers greater than 42!
λ>
Try it for yourself! Works as expected.
† getNextTokenPosition is more correct than getPosition for streams where tokens contain position of their beginning and end in themselves. This may or may not be important in your case.
It's not a solution I like, but you can hypnotize Parsec into believing it's had a single failure with consumption:
failAt pos msg = mkPT (\_ -> return (Consumed (return $ Error $ newErrorMessage (Expect msg) pos)))
Here's a complete example:
import Control.Monad
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.Error
import Text.Parsec.Prim
import Debug.Trace
failAt pos msg = mkPT (\_ -> return (Consumed (return $ Error $ newErrorMessage (Expect msg) pos)))
type P a = Parsec String () a
withPredicate :: (a -> Bool) -> String -> P a -> P a
withPredicate pred msg p = do
pos <- getPosition
x <- p
unless (pred x) $ failAt pos msg
return x
natural = read <$> many1 digit
pPowerOfTwo = withPredicate isPowerOfTwo "power of two" natural
where isPowerOfTwo = (`elem` [2^i | i<-[1..20]])
main = print $ runParser pPowerOfTwo () "myinput" "4095"
When run, it results in:
Left "myinput" (line 1, column 1):
expecting power of two
I think the problem stems from how Parsec picks the "best error" in the non-deterministic setting. See Text.Parsec.Error.mergeError. Specifically, this selects the longest match when choosing which error is the error to report. I think we need some way to make Parsec order errors differently, which may be too obscure for us solving this problem.
In my case, I here's how I worked around the problem:
I solved stacked an Exception monad within my ParsecT type.
type P m = P.ParsecT String ParSt (ExceptT Diagnostic m)
Then I introduced a pair of combinators:
(Note: Loc is my internal location type)
-- stops hard on an error (no backtracking)
-- which is why I say "semantic" instead of "syntax" error
throwSemanticError :: (MonadTrans t, Monad m) => Loc -> String -> t (ExceptT Diagnostic m) a
throwSemanticError loc msg = throwSemanticErrorDiag $! Diagnostic loc msg
withLoc :: Monad m => (Loc -> P m a) -> P m a
withLoc pa = getLoc >>= pa
Now in parsing I can write:
parsePrimeNumber = withLoc $ \loc ->
i <- parseInt
unless (isPrime i) $ throwSemanticError loc "number is not prime!"
return i
The top level interface to run one of these monads is really nasty.
runP :: Monad m
=> ParseOpts
-> P m a
-> String
-> m (ParseResult a)
runP pos pma inp =
case runExceptT (P.runParserT pma (initPSt pos) "" inp) of
mea -> do
ea <- mea
case ea of
-- semantic error (throwSemanticError)
Left err -> return $! PError err
-- regular parse error
Right (Left err) -> return $ PError (errToDiag err)
-- success
Right (Right a) -> return (PSuccess a [])
I'm not terribly happy with this solution and desire something better.
I wish parsec had a:
semanticCheck :: (a -> Parsec Bool) -> Parsec a -> Parsec a
semanticCheck pred p =
a <- p
z <- pred a
unless z $
... somehow raise the error from the beginning of this token/parse
rather than the end ... and when propagating the error up,
use the end parse position, so this parse error beats out other
failed parsers that make it past the beginning of this token
(but not to the end)
return a
Using lookAhead, we can run a parser without consuming any input or registering any new errors, but record the state that we end up in. We can then apply a guard to the result of the parser. The guard can fail in whatever manner it desires if the value does not pass the semantic check. If the guard fails, then the error is located at the initial position. If the guard succeeds, we reset the parser to the recorded state, avoiding the need to re-execute p.
guardP :: Stream s m t => (a -> ParsecT s u m ()) -> ParsecT s u m a -> ParsecT s u m a
guardP guard p = do
(a, s) <- try . lookAhead $ do
a <- p
s <- getParserState
return (a, s)
guard a
setParserState s
return a
We can now implement pPowerOfTwo:
pPowerOfTwo :: Stream s m Char => ParsecT s u m Integer
pPowerOfTwo = guardP guardPowerOfTwo natural <?> "power of two"
where guardPowerOfTwo s = unless (s `elem` [2^i | i <- [1..20]]) . unexpected $ show s

Error check within do block in Haskell

i have the following set of actions:
action1 :: IO Bool
action2 :: IO Bool
action3 :: IO Bool
some actions are just composition of another actions
complexAction = do
action1
action2
action3
What i need is the construction that checks result of each action and returns False in a case of false. I can do it manually but i know for sure that haskell does have tools to get rid of that kind of boilerplate.
The simplest way is
complexAction = fmap and (sequence [action1, action2, action3])
But you could also write your own combinator to stop after the first action:
(>>/) :: Monad m => m Bool -> m Bool -> m Bool
a >>/ b = do
yes <- a
if yes then b else return False
You'd want to declare the fixity to make it associative
infixl 1 >>/
Then you can do
complexAction = action1 >>/ action2 >>/ action3
I'd suggest you to use MaybeT monad transformer instead. Using it has many advantages over just returning IO Bool:
Your actions can have different types and return values (not just true/false). If you don't need any results, just use MaybeT IO ().
Later ones can depend on results of preceding ones.
Since MaybeT produces monads that are instances of MonadPlus, you can use all monad plus operations. Namely mzero for a failed action and x mplus y, which will run y iff x fails.
A slight disadvantage is that you have to lift all IO actions to MaybeT IO. This can be solved by writing your actions as MonadIO m => ... -> m a instead of ... -> IO a.
For example:
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
-- Lift print and putStrLn
print' :: (MonadIO m, Show a) => a -> m ()
print' = liftIO . print
putStrLn' :: (MonadIO m) => String -> m ()
putStrLn' = liftIO . putStrLn
-- Add something to an argument
plus1, plus3 :: Int -> MaybeT IO Int
plus1 n = print' "+1" >> return (n + 1)
plus3 n = print' "+3" >> return (n + 3)
-- Ignore an argument and fail
justFail :: Int -> MaybeT IO a
justFail _ = mzero
-- This action just succeeds with () or fails.
complexAction :: MaybeT IO ()
complexAction = do
i <- plus1 0
justFail i -- or comment this line out <----------------<
j <- plus3 i
print' j
-- You could use this to convert your actions to MaybeT IO:
boolIOToMaybeT :: IO Bool -> MaybeT IO ()
boolIOToMaybeT x = do
r <- lift x
if r then return () else mzero
-- Or you could have even more general version that works with other
-- transformers as well:
boolIOToMaybeT' :: (MonadIO m, MonadPlus m) => IO Bool -> m ()
boolIOToMaybeT' x = do
r <- liftIO x
if r then return () else mzero
main :: IO ()
main = runMaybeT complexAction >>= print'
As Petr says, for anything but a narrow and contained case, you're almost certainly better off wiring your code for proper error handling from the outset. I know I've often regretted not doing this, condemning myself to some very tedious refactoring.
If I may, I'd like to recommend Gabriel Gonzalez's errors package, which imposes a little more coherence on Haskell's various error-handling mechanisms than has been traditional. It allows you to plumb Eithers through your code, and Either is a good type for capturing errors. (By contrast, Maybe will lose information on the error side.) Once you've installed the package, you can write things like this:
module Errors where
import Control.Error
import Data.Traversable (traverse)
data OK = OK Int deriving (Show)
action1, action2, action3 :: IO (Either String OK)
action1 = putStrLn "Running action 1" >> return (Right $ OK 1)
action2 = putStrLn "Running action 2" >> return (Right $ OK 2)
action3 = putStrLn "Running action 3" >> return (Left "Oops on 3")
runStoppingAtFirstError :: [IO (Either String OK)] -> IO (Either String [OK])
runStoppingAtFirstError = runEitherT . traverse EitherT
...with output like
*Errors> runStoppingAtFirstError [action1, action2]
Running action 1
Running action 2
Right [OK 1,OK 2]
*Errors> runStoppingAtFirstError [action1, action3, action2]
Running action 1
Running action 3
Left "Oops on 3"
(But note that the computation here stops at the first error and doesn't soldier on until the bitter end -- which might not be what you had wanted. The errors package is certainly wide-ranging enough that many other variations are possible.)

Extracting a Maybe value in IO

Given the following:
> (liftM2 fromMaybe) (ioError $ userError "OOPS") (return $ Just "ok")
ghci gives me
*** Exception: user error (OOPS)
Of course, fromMaybe is working correctly:
> (liftM2 fromMaybe) (return $ "not me") (return $ Just "ok")
"ok"
But it seems that the IO operation is being carried out and then discarded:
> (liftM2 fromMaybe) (putStrLn "computing.." >> "discarded") (return $ Just "ok")
computing..
"ok"
Why is this happening? Is there any way to make the IO monad lazier?
Specifically, given value :: IO (Maybe a) what's a (clean, concise) way to say
result <- (liftM2 fromMaybe) err value
and have it unpack result or throw an IOError accordingly?
I don't know that making IO lazier is the right direction here. What you seem to want to do is first get at the Maybe, then eliminate it. This can be written several ways, here's one option:
test :: IO (Maybe a) -> IO a
test = (>>= maybe (ioError $ userError "oops") return)
If you translate from liftM2 to do-notation, it's obvious why your code fails:
do x <- ioError $ userError "OOPS"
y <- return $ Just "ok"
return $ fromMaybe x y
This will never go past the first line, as it's unconditionally throwing an exception.
Anthony's suggestion will work fine, but if you don't care about the specific exception thrown, you can also use pattern matching:
do Just result <- value
If the pattern doesn't match, this will call fail, which in the case of the IO monad throws an exception.
> Just x <- return Nothing
*** Exception: user error (Pattern match failure in do expression at <interactive>:1:0-5)
what's a (clean, concise) way to ... unpack [the] result or throw an IOError accordingly?
I recommend you avoid relying on throwing errors. Instead, handle the "error" explicitly:
maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM err f value = do
x <- value
case x of
Just y -> f y
Nothing -> err
-- This can be written simply as:
maybeM err f value = do
x <- value
maybe err f x
-- or even shorter! This is starting to look like Anthony's answer :)
maybeM err f value = value >>= maybe err f
The function's inputs and types should speak for themselves. You use it by giving it an action to perform for the Nothing case, or a function to perform on the value inside for the Just case. For your particular inputs this would look like:
maybeM (ioError $ userError "OOPS") return (return $ Just "ok")
So if you absolutely must, then the "concise way to unpack the result or throw an IOError" would be:
-- compare to fromJust, a function to be avoided
fromJustIO :: IO (Maybe a) -> IO a
fromJustIO = maybeM (ioError $ userError "OOPS") return
Notice how the type signature for this is practically Maybe a -> a, which is the essence of magicMonadUnwrap :: Monad m => m a -> a, which should set off some red flags. However, you can use this atrocity in a simple manner:
result <- fromJustIO value
Although again, I strongly discourage the use of exceptions here. Try handling errors in a more elegant way than simply exploding, by using maybeM and providing an IO action to execute in the event of failure.

Resources