I am building a Haskell application and trying to figure out how I am going to build the error handling mechanism. In the real application, I'm doing a bunch of work with Mongo. But, for this, I'm going to simplify by working with basic IO operations on a file.
So, for this test application, I want to read in a file and verify that it contains a proper fibonnacci sequence, with each value separated by a space:
1 1 2 3 5 8 13 21
Now, when reading the file, any number of things could actually be wrong, and I am going to call all of those exceptions in the Haskell usage of the word.
data FibException = FileUnreadable IOError
| FormatError String String
| InvalidValue Integer
| Unknown String
instance Error FibException where
noMsg = Unknown "No error message"
strMsg = Unknown
Writing a pure function that verifies the sequence and throws an error in the case that the sequence is invalid is easy (though I could probably do better):
verifySequence :: String -> (Integer, Integer) -> Either FibException ()
verifySequence "" (prev1, prev2) = return ()
verifySequence s (prev1, prev2) =
let readInt = reads :: ReadS Integer
res = readInt s in
case res of
[] -> throwError $ FormatError s
(val, rest):[] -> case (prev1, prev2, val) of
(0, 0, 1) -> verifySequence rest (0, 1)
(p1, p2, val') -> (if p1 + p2 /= val'
then throwError $ InvalidValue val'
else verifySequence rest (p2, val))
_ -> throwError $ InvalidValue val
After that, I want the function that reads the file and verifies the sequence:
type FibIOMonad = ErrorT FibException IO
verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
sequenceStr <- liftIO $ readFile path
case (verifySequence sequenceStr (0, 0)) of
Right res -> return res
Left err -> throwError err
This function does exactly what I want if the file is in the invalid format (it returns Left (FormatError "something")) or if the file has a number out of sequence (Left (InvalidValue 15)). But it throws an error if the file specified does not exist.
How do I catch the IO errors that readFile may produce so that I can transform them into the FileUnreadable error?
As a side question, is this even the best way to do it? I see the advantage that the caller of verifyFibFile does not have to set up two different exception handling mechanisms and can instead catch just one exception type.
You might consider EitherT and the errors package in general. http://hackage.haskell.org/packages/archive/errors/1.3.1/doc/html/Control-Error-Util.html has a utility tryIO for catching IOError in EitherT and you could use fmapLT to map error values to your custom type.
Specifically:
type FibIOMonad = EitherT FibException IO
verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
sequenceStr <- fmapLT FileUnreadable (tryIO $ readFile path)
hoistEither $ verifySequence sequenceStr (0, 0)
#Savanni D'Gerinel: you are on the right track. Let's extract your error-catching code from verifyFibFile to make it more generic, and modify it slightly so that it works directly in ErrorT:
catchError' :: ErrorT e IO a -> (IOError -> ErrorT e IO a) -> ErrorT e IO a
catchError' m f =
ErrorT $ catchError (runErrorT m) (fmap runErrorT f)
verifyFibFile can now be written as:
verifyFibFile' :: FilePath -> FibIOMonad ()
verifyFibFile' path = do
sequenceStr <- catchError' (liftIO $ readFile path) (throwError . FileUnReadable)
ErrorT . return $ verifySequence sequenceStr' (0, 0)
Notice what we have done in catchError'. We have stripped the ErrorT constructor from the ErrorT e IO a action, and also from the return value of the error-handling function, knowing than we can reconstruct them afterwards by wrapping the result of the control operation in ErrorT again.
Turns out that this is a common pattern, and it can be done with monad transformers other than ErrorT. It can get tricky though (how to do this with ReaderT for example?). Luckily, the monad-control packgage already provides this functionality for many common transformers.
The type signatures in monad-control can seem scary at first. Start by looking at just one function: control. It has the type:
control :: MonadBaseControl b m => (RunInBase m b -> b (StM m a)) -> m a
Let's make it more specific by making b be IO:
control :: MonadBaseControl IO m => (RunInBase m IO -> IO (StM m a)) -> m a
m is a monad stack built on top of IO. In your case, it would be ErrorT IO.
RunInBase m IO is a type alias for a magical function, that takes a value of type m a and returns a value of type IO *something*, something being some complex magic that encodes the state of the whole monad stack inside IO and lets you reconstruct the m a value afterwards, once you have "fooled" the control operation that only accepts IO values. control provides you with that function, and also handles the reconstruction for you.
Applying this to your problem, we rewrite verifyFibFile once more as:
import Control.Monad.Trans.Control (control)
import Control.Exception (catch)
verifyFibFile'' :: FilePath -> FibIOMonad ()
verifyFibFile'' path = do
sequenceStr <- control $ \run -> catch (run . liftIO $ readFile path)
(run . throwError . FileUnreadable)
ErrorT . return $ verifySequence sequenceStr' (0, 0)
Keep in mind that this only works when the proper instance of MonadBaseControl b m exists.
Here is a nice introduction to monad-control.
So, here's an answer that I have developed. It centers around getting readFile wrapped into the proper catchError statement, and then lifted.
verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
contents <- liftIO $ catchError (readFile path >>= return . Right) (return . Left . FileUnreadable)
case contents of
Right sequenceStr' -> case (verifySequence sequenceStr' (0, 0)) of
Right res -> return res
Left err -> throwError err
Left err -> throwError err
So, verifyFibFile gets a little more nested in this solution.
readFile path has type IO String, obviously. In this context, the type for catchError will be:
catchError :: IO String -> (IOError -> IO String) -> IO String
So, my strategy was to catch the error and turn it into the left side of an Either, and turn the successful value into the right side, changing my data type to this:
catchError :: IO (Either FibException String) -> (IOError -> IO (Either FibException String)) -> IO (Either FibException String)
I do this by, in the first parameter, simply wrapping the result into Right. I figure that I won't actually execute the return . Right branch of the code unless readFile path was successful. In the other parameter to catch, I start with an IOError, wrap it in Left, and then return it back into the IO context. After that, no matter what the result is, I lift the IO value up into the FibIOMonad context.
I'm bothered by the fact that the code gets even more nested. I have Left values, and all of those Left values get thrown. I'm basically in an Either context, and I had thought that one of the benefits Either's implementation of the Monad class was that Left values would simply be passed along through the binding operations and that no further code in that context would be executed. I would love some elucidation on this, or to see how the nesting can be removed from this function.
Maybe it can't. It does seem that the caller, however, can call verifyFibFile repeatedly and execution basically stops the first time verifyFibFile returns an error. This works:
runTest = do
res <- verifyFibFile "goodfib.txt"
liftIO $ putStrLn "goodfib.txt"
--liftIO $ printResult "goodfib.txt" res
res <- verifyFibFile "invalidValue.txt"
liftIO $ putStrLn "invalidValue.txt"
res <- verifyFibFile "formatError.txt"
liftIO $ putStrLn "formatError.txt"
Main> runErrorT $ runTest
goodfib.txt
Left (InvalidValue 17)
Given the files that I have created, both invalidValue.txt and formatError.txt cause errors, but this function returns Left (InvalidValue ...) for me.
That's okay, but I still feel like I've missed something with my solution. And I have no idea whether I'll be able to translate this into something that makes MongoDB access more robust.
Related
I have this very simple function
import qualified Data.ByteString.Lazy as B
getJson :: IO B.ByteString
getJson = B.readFile jsonFile
readJFile :: IO (Maybe Response)
readJFile = parsing >>= (\d ->
case d of
Left err -> return Nothing
Right ps -> return (Just ps))
where parsing = fmap eitherDecode getJson :: IO (Either String Response)
where jsonFile is a path to a file on my harddrive (pardon the lack of do-notation, but I found this more clear to work with)
my question is; is there a way for me to ditch the IO part so I can work with the bytestring alone?
I know that you can pattern match on certain monads like Either and Maybe to get their values out, but can you do something similar with IO?
Or voiced differently: is there a way for me to make readJFile return Maybe Response without the IO?
To expand on my comments, here's how you can do it:
getJson :: IO B.ByteString
getJson = B.readFile jsonFile -- as before
readJFile :: B.ByteString -> Maybe Response -- look, no IO
readJFile b = case eitherDecode b of
Left err -> Nothing
Right ps -> Just ps
In the end, you combine everything in one IO action again:
getAndProcess :: IO (Maybe Response)
getAndProcess = do
b <- getJson
return (readJFile b)
You never need to "drag a monad" through any functions, unless they all need to actually do IO. Just lift the entire chain into the monad with fmap (or liftM / liftM2 / ...).
For instance,
f1 :: B.ByteString -> K
f2 :: K -> I
f3 :: K -> J
f4 :: I -> J -> M
and your entire thing is supposed to be like
m :: M
m = let k = "f1 getJson"
in f4 (f2 k) (f3 k)
The you can simply do
m = fmap (\b -> let k = f1 b
in f4 (f2 k) (f3 k) )
getJson
Incidentally, this might look nicer with do notation:
m = do
b <- getJson
return $ let k = f1 b
in f4 (f2 k) (f3 k)
Concerning you edit and the question
is there a way for me to make readJFile return Maybe Response without the IO?
No, that can't possibly work, because readJFile does need to do IO. There's no way escaping from the IO monad then, that's the whole point of it! (Well, there is unsafePerformIO as Ricardo says, but this is definitely not a valid application for it.)
If it's the clunkiness of unpacking Maybe values in the IO monad, and the signatures with parens in them, you may want to looks at the MaybeT transformer.
readJFile' :: MaybeT IO Response
readJFile' = do
b <- liftIO getJson
case eitherDecode b of
Left err -> mzero
Right ps -> return ps
No, there is no safe way to get a value out of the IO monad. Instead you should do the work inside the IO monad by applying functions with fmap or bind (>>=). Also you should use decode instead of eitherDecode when you want your result to be in Maybe.
getJson :: IO B.ByteString
getJson = B.readFile jsonFile
parseResponse :: B.ByteString -> Maybe Response
parseResponse = decode
readJFile :: IO (Maybe Response)
readJFile = fmap parseResponse getJSON
You could also use do notation if that is clearer to you:
readJFile :: IO (Maybe Response)
readJFile = do
bytestring <- getJson
return $ decode bytestring
Note that you dont even need the parseResponse function since readJFile specifies the type.
In general, yes, there is a way. Accompanied by a lot of "but", but there is. You're asking for what it's called an unsafe IO operation: System.IO.Unsafe. It's used to write wrappers when calling to external libraries usually, it's not something to resort to in regular Haskell code.
Basically, you can call unsafePerformIO :: IO a -> a which does exactly what you want, it strips out the IO part and gives you back wrapped value of type a. But, if you look at the documentation, there are a number of requirements which you should guarantee yourself to the system, which all end up in the same idea: even though you performed the operation via IO, the answer should be the result of a function, as expected from any other haskell function which does not operate in IO: it should always have the same result without side effects, only based on the input values.
Here, given your code, this is obviously NOT the case, since you're reading from a file. You should just continue working within the IO monad, by calling your readJFile from within another function with result type IO something. Then, you'll be able to read the value within the IO wrapper (being in IO yourself), work on it, and then re-wrap the result in another IO when returning.
Let's say that I'd like to rework the following function:
runCmd :: FilePath -> ErrorT String IO ()
runCmd cmd = do
Left e <- liftIO $ tryIOError $ do
(inp, outp, errp, pid) <- runInteractiveProcess cmd [] Nothing Nothing
mapM_ (`hSetBuffering` LineBuffering) [inp, outp, errp]
forever (hGetLine outp >>= putStrLn) -- IO error when process ends
unless (isEOFError e) $ throwError $ "IO Error: " ++ ioeGetErrorString e
It tries to run cmd and read the output. If it fails with an IO error, I catch it with tryIOError, pass it through to the enclosing ErrorT monad, and then deal with the error.
It's kind of a roundabout way to do it, especially since there are functions like catch and handle that allow me to use a handler to deal with the error. But they are typed IO:
handle :: Exception e => (e -> IO a) -> IO a -> IO a
catch :: Exception e => IO a -> (e -> IO a) -> IO a
How do I cleanly restructure the above code so that I can handle the IO errors and pass it through the ErrorT monad?
If you really want to use ErrorT, you can try something like this
import Control.Exception
import Control.Monad.Error
wrapException :: IO a -> ErrorT String IO a
wrapException io = do
either <- liftIO $ tryJust Just io
case either of
Left e -> throwError . show $ (e :: SomeException)
Right v -> return v
But this isn't perfect because you still are limited to IO in what can throw exceptions. What you can do to help is to use
catchException :: ErrorT String IO a -> ErrorT String IO a
catchException = either throwError return <=< wrapException . runErrorT
What this does is grab any exceptions that are propagating up and trap them back in the ErrorT monad. This still isn't perfect since you need to explicitly wrap all exception throwing pieces of code in it. But it's not terrible.
I would avoid using an ErrorT for this in the first place. Have runCmd simply return an IO () (or throw an IOError if issues arise), and defer error handling to the callers:
runCmd :: FilePath -> IO ()
runCmd cmd =
handleIOError (\e -> if isEOFError e then return () else ioError e) $ do
-- same code as before
(inp, outp, errp, pid) <- runInteractiveProcess cmd [] Nothing Nothing
mapM_ (`hSetBuffering` LineBuffering) [inp, outp, errp]
forever (hGetLine outp >>= putStrLn)
where handleIOError = flip catchIOError
caller :: IO ()
caller = catchIOError (runCmd "/bin/ls") $ \e ->
-- error handling code
If you need to catch the IOError in ErrorT code elsewhere, you can use liftIO there:
errorTCaller :: ErrorT String IO ()
errorTCaller = liftIO caller
Following a haskell tutorial, the author provides the following implementation of the withFile method:
withFile' :: FilePath -> IOMode -> (Handle -> IO a) -> IO a
withFile' path mode f = do
handle <- openFile path mode
result <- f handle
hClose handle
return result
But why do we need to wrap the result in a return? Doesn't the supplied function f already return an IO as can be seen by it's type Handle -> IO a?
You're right: f already returns an IO, so if the function were written like this:
withFile' path mode f = do
handle <- openFile path mode
f handle
there would be no need for a return. The problem is hClose handle comes in between, so we have to store the result first:
result <- f handle
and doing <- gets rid of the IO. So return puts it back.
This is one of the tricky little things that confused me when I first tried Haskell. You're misunderstanding the meaning of the <- construct in do-notation. result <- f handle doesn't mean "assign the value of f handle to result"; it means "bind result to a value 'extracted' from the monadic value of f handle" (where the 'extraction' happens in some way that's defined by the particular Monad instance that you're using, in this case the IO monad).
I.e., for some Monad typeclass m, the <- statement takes an expression of type m a in the right hand side and a variable of type a on the left hand side, and binds the variable to a value. Thus in your particular example, with result <- f handle, we have the types f result :: IO a, result :: a and return result :: IO a.
PS do-notation has also a special form of let (without the in keyword in this case!) that works as a pure counterpart to <-. So you could rewrite your example as:
withFile' :: FilePath -> IOMode -> (Handle -> IO a) -> IO a
withFile' path mode f = do
handle <- openFile path mode
let result = f handle
hClose handle
result
In this case, because the let is a straightforward assignment, the type of result is IO a.
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.
I have a very typical setup with a set of functions in the IO monad that can throw errors. To date I have just been dealing with errors at the end of the monad chain by pattern matching the Either result from runErrorT:
replLisp :: LispScope -> String -> IO String
replLisp s input = do
result <- runErrorT (evalLisp s input)
return $ either (id) (show) result
I would now like to add some error handling to my Hacked little scheme, but I'm having trouble making the type checker happy.
How does one use catchError? An example or two would be helpful.
This is my latest attempt:
catch :: [LispVal] -> IOThrowsError LispVal
catch [action rescue] = do
eval action >>= catchError $ eval rescue
Here is an example use of catchError to recover from a prior call to throwError:
import Control.Monad.Error
import Control.Monad.Identity
type MyMonad = ErrorT String Identity
runMyMonad = runIdentity . runErrorT
main = do
let x = runMyMonad (func 5 0)
print x
func :: Double -> Double -> MyMonad Double
func w x = do
y <- (divider x) `catchError` (\_ -> return 1)
return (w + y)
divider :: Double -> MyMonad Double
divider x = do
when (x == 0) (throwError "Can not divide by zero!")
return (10 / x)
Despite passing 0 in for division we can complete with the handlers result of 1 to obtain output of Right 6.0.
Does this help? Your question didn't really say what the issue was.
Error monads like Either and Maybe don't allow you to observe the error from within the same monad: you have to run the monad in order to observe it. Exceptions in IO are one notable exception (ahem) because IO is the end of the line... you can't go any further from there.
You have a few possibilities:
Since you're writing a mini-interpreter, it's probably a good idea to explicitly manage all the exceptions, using the ErrorT monad only for true, unrecoverable errors.
For any call that may error that you want to be able to recover from, perform a runErrorT and inspect that result, before passing along the result in the current monad.