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
Related
I'm using the following scenario as an example to learn how to handle errors in a simple way. The scenario is basically read a file path from an environment variable, then read and print the file with the file path.
The following code works, but I don't like the printFile because it has nested case of, a bit hard to read. I wonder if there is a clean way to get rid of it and keep the printFile function flat without using lookupEnv?
How would you simplify this error handling flow?
module Main where
import Control.Exception (IOException, handle, throw)
import System.Environment (getEnv)
import System.IO.Error (isDoesNotExistError)
data MissingError
= MissingEnv String
| MissingFile String
deriving (Show)
main :: IO ()
main = do
eitherFile <- printFile
either print print eitherFile
getEnv' :: String -> MissingError -> IO (Either MissingError String)
getEnv' env err = handle (missingEnv err) $ Right <$> (getEnv env)
readFile' :: FilePath -> MissingError -> IO (Either MissingError String)
readFile' path err = handle (missingFile err) $ Right <$> (readFile path)
missingEnv :: MissingError -> IOException -> IO (Either MissingError String)
missingEnv err = const $ return $ Left err
missingFile :: MissingError -> IOException -> IO (Either MissingError String)
missingFile err e
| isDoesNotExistError e = return $ Left err
| otherwise = throw e
printFile :: IO (Either MissingError String)
printFile = do
eitherFilePath <- getEnv' "FOLDER" (MissingEnv "FOLDER")
case eitherFilePath of
Left err -> return $ Left err
Right path -> readFile' path (MissingFile path)
You can use the ExceptT monad transformer for this. I haven't tried to run the following proposed changes, but it compiles, so I hope it works.
First, import the module that contains ExceptT:
import Control.Monad.Trans.Except
Next, change the printFile function:
printFile :: IO (Either MissingError String)
printFile = runExceptT $ do
path <- ExceptT $ getEnv' "FOLDER" (MissingEnv "FOLDER")
ExceptT $ readFile' path (MissingFile path)
You have functions that return IO (Either MissingError String), so wrapping them in ExceptT gives you do notation that enables you to access the String embedded in what's effectively ExcepT MissingError IO String.
Then unwrap the ExceptT return value with runExceptT.
The suggestion to use ExceptT is of course a good one but IMHO the proposed answer is still somewhat verbose and you can go a bit farther by simply "staying" in the ExceptT monad throughout your code. Also I would not recommend handling IO exceptions all over the place. Even with a small code base you would lose oversight of your code quickly. tryIOError is useful in this regard. And finally rethinking the definition of your errors would also yield easier to understand and a more solid solution. The end result would look something like this:
module Main where
import Data.Bifunctor (first)
import Control.Monad.Except (ExceptT(..), runExceptT)
import System.Environment (getEnv)
import System.IO.Error (tryIOError, isDoesNotExistError)
data MyError = MissingError String
| SomeIOError IOError
deriving (Show)
main :: IO ()
main = do
result <- runExceptT printFile
print result
getEnv' :: String -> ExceptT MyError IO String
getEnv' env = mapIOError ("getting env var " ++ env) $ getEnv env
readFile' :: FilePath -> ExceptT MyError IO String
readFile' path = mapIOError ("reading file " ++ path) $ readFile path
printFile :: ExceptT MyError IO String
printFile = do
path <- getEnv' "FOLDER"
readFile' path
mapIOError :: String -> IO a -> ExceptT MyError IO a
mapIOError msg = ExceptT . fmap (first mapError) . tryIOError
where mapError err | isDoesNotExistError err = MissingError msg
mapError err = SomeIOError err
Could someone give a super simple (few lines) monad transformer example, which is non-trivial (i.e. not using the Identity monad - that I understand).
For example, how would someone create a monad that does IO and can handle failure (Maybe)?
What would be the simplest example that would demonstrate this?
I have skimmed through a few monad transformer tutorials and they all seem to use State Monad or Parsers or something complicated (for a newbee). I would like to see something simpler than that. I think IO+Maybe would be simple, but I don't really know how to do that myself.
How could I use an IO+Maybe monad stack?
What would be on top? What would be on bottom? Why?
In what kind of use case would one want to use the IO+Maybe monad or the Maybe+IO monad? Would that make sense to create such a composite monad at all? If yes, when, and why?
This is available here as a .lhs file.
The MaybeT transformer will allow us to break out of a monad computation much like throwing an exception.
I'll first quickly go over some preliminaries. Skip down to Adding Maybe powers to IO for a worked example.
First some imports:
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
Rules of thumb:
In a monad stack IO is always on the bottom.
Other IO-like monads will also, as a rule, always appear on the bottom, e.g. the state transformer monad ST.
MaybeT m is a new monad type which adds the power of the Maybe monad to the monad m - e.g. MaybeT IO.
We'll get into what that power is later. For now, get used to thinking of MaybeT IO as the maybe+IO monad stack.
Just like IO Int is a monad expression returning an Int, MaybeT IO Int is a MaybeT IO expression returning an Int.
Getting used to reading compound type signatures is half the battle to understanding monad transformers.
Every expression in a do block must be from the same monad.
I.e. this works because each statement is in the IO-monad:
greet :: IO () -- type:
greet = do putStr "What is your name? " -- IO ()
n <- getLine -- IO String
putStrLn $ "Hello, " ++ n -- IO ()
This will not work because putStr is not in the MaybeT IO monad:
mgreet :: MaybeT IO ()
mgreet = do putStr "What is your name? " -- IO monad - need MaybeT IO here
...
Fortunately there is a way to fix this.
To transform an IO expression into a MaybeT IO expression use liftIO.
liftIO is polymorphic, but in our case it has the type:
liftIO :: IO a -> MaybeT IO a
mgreet :: MaybeT IO () -- types:
mgreet = do liftIO $ putStr "What is your name? " -- MaybeT IO ()
n <- liftIO getLine -- MaybeT IO String
liftIO $ putStrLn $ "Hello, " ++ n -- MaybeT IO ()
Now all of the statement in mgreet are from the MaybeT IO monad.
Every monad transformer has a "run" function.
The run function "runs" the top-most layer of a monad stack returning
a value from the inside layer.
For MaybeT IO, the run function is:
runMaybeT :: MaybeT IO a -> IO (Maybe a)
Example:
ghci> :t runMaybeT mgreet
mgreet :: IO (Maybe ())
ghci> runMaybeT mgreet
What is your name? user5402
Hello, user5402
Just ()
Also try running:
runMaybeT (forever mgreet)
You'll need to use Ctrl-C to break out of the loop.
So far mgreet doesn't do anything more than what we could do in IO.
Now we'll work on an example which demonstrates the power of mixing
the Maybe monad with IO.
Adding Maybe powers to IO
We'll start with a program which asks some questions:
askfor :: String -> IO String
askfor prompt = do
putStr $ "What is your " ++ prompt ++ "? "
getLine
survey :: IO (String,String)
survey = do n <- askfor "name"
c <- askfor "favorite color"
return (n,c)
Now suppose we want to give the user the ability to end the survey
early by typing END in response to a question. We might handle it
this way:
askfor1 :: String -> IO (Maybe String)
askfor1 prompt = do
putStr $ "What is your " ++ prompt ++ " (type END to quit)? "
r <- getLine
if r == "END"
then return Nothing
else return (Just r)
survey1 :: IO (Maybe (String, String))
survey1 = do
ma <- askfor1 "name"
case ma of
Nothing -> return Nothing
Just n -> do mc <- askfor1 "favorite color"
case mc of
Nothing -> return Nothing
Just c -> return (Just (n,c))
The problem is that survey1 has the familiar staircasing issue which
doesn't scale if we add more questions.
We can use the MaybeT monad transformer to help us here.
askfor2 :: String -> MaybeT IO String
askfor2 prompt = do
liftIO $ putStr $ "What is your " ++ prompt ++ " (type END to quit)? "
r <- liftIO getLine
if r == "END"
then MaybeT (return Nothing) -- has type: MaybeT IO String
else MaybeT (return (Just r)) -- has type: MaybeT IO String
Note how all of the statemens in askfor2 have the same monad type.
We've used a new function:
MaybeT :: IO (Maybe a) -> MaybeT IO a
Here is how the types work out:
Nothing :: Maybe String
return Nothing :: IO (Maybe String)
MaybeT (return Nothing) :: MaybeT IO String
Just "foo" :: Maybe String
return (Just "foo") :: IO (Maybe String)
MaybeT (return (Just "foo")) :: MaybeT IO String
Here return is from the IO-monad.
Now we can write our survey function like this:
survey2 :: IO (Maybe (String,String))
survey2 =
runMaybeT $ do a <- askfor2 "name"
b <- askfor2 "favorite color"
return (a,b)
Try running survey2 and ending the questions early by typing END as a response to either question.
Short-cuts
I know I'll get comments from people if I don't mention the following short-cuts.
The expression:
MaybeT (return (Just r)) -- return is from the IO monad
may also be written simply as:
return r -- return is from the MaybeT IO monad
Also, another way of writing MaybeT (return Nothing) is:
mzero
Furthermore, two consecutive liftIO statements may always combined into a single liftIO, e.g.:
do liftIO $ statement1
liftIO $ statement2
is the same as:
liftIO $ do statement1
statement2
With these changes our askfor2 function may be written:
askfor2 prompt = do
r <- liftIO $ do
putStr $ "What is your " ++ prompt ++ " (type END to quit)?"
getLine
if r == "END"
then mzero -- break out of the monad
else return r -- continue, returning r
In a sense, mzero becomes a way of breaking out of the monad - like throwing an exception.
Another example
Consider this simple password asking loop:
loop1 = do putStr "Password:"
p <- getLine
if p == "SECRET"
then return ()
else loop1
This is a (tail) recursive function and works just fine.
In a conventional language we might write this as a infinite while loop with a break statement:
def loop():
while True:
p = raw_prompt("Password: ")
if p == "SECRET":
break
With MaybeT we can write the loop in the same manner as the Python code:
loop2 :: IO (Maybe ())
loop2 = runMaybeT $
forever $
do liftIO $ putStr "Password: "
p <- liftIO $ getLine
if p == "SECRET"
then mzero -- break out of the loop
else return ()
The last return () continues execution, and since we are in a forever loop, control passes back to the top of the do block. Note that the only value that loop2 can return is Nothing which corresponds to breaking out of the loop.
Depending on the situation you might find it easier to write loop2 rather than the recursive loop1.
Suppose you have to work with IO values that "may fail" in some sense, like foo :: IO (Maybe a), func1 :: a -> IO (Maybe b) and func2 :: b -> IO (Maybe c).
Manually checking for the presence of errors in a chain of binds quickly produces the dreaded "staircase of doom":
do
ma <- foo
case ma of
Nothing -> return Nothing
Just a -> do
mb <- func1 a
case mb of
Nothing -> return Nothing
Just b -> func2 b
How to "automate" this in some way? Perhaps we could devise a newtype around IO (Maybe a) with a bind function that automatically checks if the first argument is a Nothing inside IO, saving us the trouble of checking it ourselves. Something like
newtype MaybeOverIO a = MaybeOverIO { runMaybeOverIO :: IO (Maybe a) }
With the bind function:
betterBind :: MaybeOverIO a -> (a -> MaybeOverIO b) -> MaybeOverIO b
betterBind mia mf = MaybeOverIO $ do
ma <- runMaybeOverIO mia
case ma of
Nothing -> return Nothing
Just a -> runMaybeOverIO (mf a)
This works! And, looking at it more closely, we realize that we aren't using any particular functions exclusive to the IO monad. Generalizing the newtype a little, we could make this work for any underlying monad!
newtype MaybeOverM m a = MaybeOverM { runMaybeOverM :: m (Maybe a) }
And this is, in essence, how the MaybeT transformer works. I have left out a few details, like how to implement return for the transformer, and how to "lift" IO values into MaybeOverM IO values.
Notice that MaybeOverIO has kind * -> * while MaybeOverM has kind (* -> *) -> * -> * (because its first "type argument" is a monad type constructor, that itself requires a "type argument").
Sure, the MaybeT monad transformer is:
newtype MaybeT m a = MaybeT {unMaybeT :: m (Maybe a)}
We can implement its monad instance as so:
instance (Monad m) => Monad (MaybeT m) where
return a = MaybeT (return (Just a))
(MaybeT mmv) >>= f = MaybeT $ do
mv <- mmv
case mv of
Nothing -> return Nothing
Just a -> unMaybeT (f a)
This will allow us to perform IO with the option of failing gracefully in certain circumstances.
For instance, imagine we had a function like this:
getDatabaseResult :: String -> IO (Maybe String)
We can manipulate the monads independently with the result of that function, but if we compose it as so:
MaybeT . getDatabaseResult :: String -> MaybeT IO String
We can forget about that extra monadic layer, and just treat it as a normal monad.
Given the proof of concept code below I'd like to be able to somehow perform my foo function with the ability to output the string Paul! and the possibility of getting its return value inside the InputT monad-transformer without using unsafePerformIO to remove the IO wrapper after runExceptT.
import Control.Monad.Except
import System.IO.Unsafe (unsafePerformIO)
import System.Console.Haskeline
type ErrorWithIO = ExceptT String IO
foo :: String -> ErrorWithIO String
foo "paul" = do liftIO $ putStrLn "Paul!"
return "OK!"
foo _ = throwError "ERROR!"
runRepl :: IO ()
runRepl = runInputT defaultSettings $ loop
loop :: InputT IO ()
loop = do
line <- getInputLine "> "
case line of
Nothing -> return ()
Just input -> do return $ putStrLn "asd"
case unsafePerformIO $ runExceptT $ foo input of
Left err -> outputStrLn err >> loop
Right res -> do
x <- outputStrLn . show $ res
loop
main :: IO ()
main = runRepl >> putStrLn "Goodbye!"
Am I missing something obvious here?
Since InputT IO is a MonadIO, you can use liftIO with this type:
liftIO :: IO a -> InputT IO a
So,
do ...
x <- liftIO $ runExceptT $ foo input
case x of
Left err -> ...
Right res -> ...
Alternatively, use Control.Monad.Trans.lift instead.
I'm trying to use the ExceptT monad transformer to catch any exception thrown by a function, like so:
import Control.Exception
import Control.Monad.Trans.Except
badFunction :: ExceptT SomeException IO ()
badFunction = throw DivideByZero
main :: IO ()
main = do
r <- runExceptT badFunction
case r of Left _ -> putStrLn "caught error"
Right _ -> putStrLn "nope, didn't catch no error"
... but the exception happily flies by. What am I doing wrong?
Edit: to clarify, the aim is to catch any exception thrown by a function, regardless of how the exception was thrown. If it makes any difference, the real function call is at the bottom of a fairly deep monad transformer stack. I don't mind missing things like thrown strings (bad programmer!).
First, you catch your runtime exception. It can be done by using either monad-control (and lifted-base) or exceptions. Michael Snoyman has a nice article comparing the two: Exceptions and monad transformers
Second, you embed the caught exception in ExceptT.
Here's the complete working code:
import Control.Exception.Lifted
import Control.Monad.Trans.Except
badFunction :: ExceptT SomeException IO ()
badFunction = throw DivideByZero
intercept
:: ExceptT SomeException IO a
-> ExceptT SomeException IO a
intercept a = do
r <- try a
case r of
Right x -> return x
Left e -> throwE e
main :: IO ()
main = do
r <- runExceptT $ intercept badFunction
case r of Left _ -> putStrLn "caught error"
Right _ -> putStrLn "nope, didn't catch no error"
A more compact (but perhaps somewhat less obvious) definition of intercept is
intercept
:: ExceptT SomeException IO a
-> ExceptT SomeException IO a
intercept = handle throwE
I believe you want throwE, not throw.
Also, it'll be an ArithException, not a SomeException.
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.