This is a follow-up to my previous post. MaybeT and Transactions in runDb
I thought this will be a simple thing to do but I have been trying to figure this out for over a day and still haven't made much progress. So thought I will give up and ask!
I just added a try function (from Control.Exception.Lifted) to my previous code and I couldn't get the code to type check. Variants like catch and handle had similar issues.
eauth <- LiftIO (
try( runDb $ do
ma <- runMaybeT $ do
valid <- ...
case ma of
Just a -> return a
Nothing -> liftIO $ throwIO MyException
) :: IO (Either MyException Auth)
)
case eauth of
Right auth -> return auth
Left _ -> lift $ left err400 { errBody = "Could not create user"}
My runDb looks like this (I also tried a variant where I removed liftIO):
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
I get this error:
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
arising from a use of ‘runDb’
In the expression: runDb
In the first argument of ‘try’, namely
‘(runDb
$ do { ma <- runMaybeT ...
I am running inside servant handler and my return type is AppM Auth where
type AppM = ReaderT Config (EitherT ServantErr IO)
I have tried many combinations of lifting but doesn't seem to be helping. I thought I will take this opportunity to figure out things from scratch and I hit a wall as well. If someone could suggest how you arrived at the answer, it will be super instructive for me.
This has been my thought process:
I see runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
So that seems to imply it will be in the IO monad, which means try should work
I think check the definition of MonadBaseControl which has class MonadBase b m => MonadBaseControl b m | m -> b. At this point I am confused. This functional dependency logic seems to be suggest type m dictates what b will be but in the previous one b was specified as IO.
I check MonadBase and that did not give me any clue either.
I check SqlPersistT and got no clues either.
I reduced the problem to something very simple like result <- liftIO (try (evaluate (5 `div` 0)) :: IO (Either SomeException Int)) and that worked. So I was even more confused at this time. Doesn't runDb work in IO so shouldn't the same thing work for my original code?
I thought I can figure this out by backtracking but it seems like my level of Haskell knowledge is just not sufficient to get at the root of the problem. Appreciate if people can provide step by step pointers as to arrive at the right solution.
Thanks!
General type signature for try:
(MonadBaseControl IO m, Exception e) => m a -> m (Either e a)
Specialized type signature for try (as it appears in your code):
IO Auth -> IO (Either MyException Auth)
So, the monadic value that is the argument to try has type:
IO Auth
Everything listed above, you probably already understood. If we look at the type signature for your runDb, we get this:
runDb :: (MonadReader Config m, MonadIO m) => SqlPersistT m a -> m a
I sort of had to guess because you didn't provide a type signature, but that is probably what it is. So now, the problem should be a little clearer. You are trying to use runDb to create a monadic value for something that's supposed to be in IO. But IO doesn't satisfy the MonadReader Config instance that you need.
To make the mistake more clear, let's make runDb more monomorphic. You could give it this type signature instead:
type AppM = ReaderT Config (EitherT ServantErr IO)
runDb :: SqlPersistT AppM a -> AppM a
And now if you tried to compile your code, you would get an even better error. Instead of telling you
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
It would tell you that IO doesn't match AppM (although it would probably expand the type synonym). Practically, what this means is that you can't get the shared pool of database connections magically out of IO. You need the ReaderT Config that was passing it around everywhere.
The easiest fix I can think of would be to stop using exceptions where they aren't necessary:
mauth <- runDb $ runMaybeT $ do
... -- Same stuff you were doing earlier
case mauth of
Just auth -> return auth
Nothing -> lift $ left err400 { errBody = "Could not create user"}
Related
Hello community thank you for your time.
I have an error and I am not sure what the error is, but what I think the problem is:
There is no IO transformer from ext-1.2.4.1:Data.Text.Internal.Lazy.Text IO) to Web.Scotty.Internal.Types.ScottyT.
But I wondering why the compiler works with ext-1.2.4.1:Data.Text.Internal.Lazy.Text IO). That's why I am working just with String and I removed all occurrences of {-# LANGUAGE OverloadedStrings #-} but still get the error. On the other hand, this should be IO [String], shouldn't it?
And as you can mention I don't really know what ext-1.2.4.1:Data.Text.Internal.Lazy.Text IO) is.
At another place, I already use liftIO successfully for an a -> IO String function. And I think I use them the same way.
I think I get slowly a feeling for what a monad is, but not quite sure. I don't really know why I have to use a lift function at all.
Error message:
• No instance for (MonadIO
(Web.Scotty.Internal.Types.ScottyT
text-1.2.4.1:Data.Text.Internal.Lazy.Text IO))
arising from a use of ‘liftIO’
• In a stmt of a 'do' block:
paths <- liftIO $ getAllFilePaths2 path
In the expression:
do paths <- liftIO $ getAllFilePaths2 path
pathsToScotty paths
In an equation for ‘pathsToScotty2’:
pathsToScotty2 path
= do paths <- liftIO $ getAllFilePaths2 path
pathsToScotty paths
|
49 | paths <- liftIO $ getAllFilePaths2 path
Where the error occurred:
import Control.Monad.IO.Class
...
pathsToScotty2 :: String -> ScottyM ()
pathsToScotty2 path = do
paths <- liftIO $ getAllFilePaths2 path
pathsToScotty paths
getAllFilePaths2 :: String -> IO [String]
getAllFilePaths2 dir = do
putStrLn dir
isFile <- doesFileExist dir
if isFile
then return [dir]
else do
dirs <- listDirectory dir
foldl foldHelper2 (return []) $ map (\d -> show $ mconcat [dir, "/",d ]) dirs
foldHelper2 :: IO [String] -> String -> IO [String]
foldHelper2 ps path = do
paths <- ps
newPaths <- getAllFilePaths2 path
return (paths ++ newPaths)
Truly understanding monads takes time, practice, and patience, but it shouldn't be too hard to understand the need for liftIO by examining your types.
First off, the type of liftIO is MonadIO m => IO a -> m a. This means that the function can convert any IO action into an action in the monad m so long as m has an instance of MonadIO. In theory, this can only be implemented if m has some way of processing IO actions, so this function is embedding the given action into the m monad.
You're definitely in the right sort of place to use liftIO, so why isn't it working? That is, you have a value getAllFilePaths2 path of type IO [String], and you'd like it to be a value of type ScottyM [String] — this indeed seems like a good place to use liftIO. However, ScottyM is not an instance of MonadIO, as that error message you saw is trying to tell you, so you can't use liftIO.
This may seem crazy—can you really not embed IO actions into ScottyM?—but there's actually a good reason for this. What happens if the IO action throws an error? Does your whole web app crash? It would if you naively used liftIO. Instead, scotty provides the function liftAndCatchIO, which, as the docs describe, is "Like liftIO, but catch any IO exceptions and turn them into Scotty exceptions." This is the preferred way to embed IO actions into Scotty.
And here comes the final gotcha: Note that liftAndCatchIO actually produces values of type ActionM a, not ScottyM a. Additionally, there's no way to take a value in the ActionM monad and get it into the ScottyM monad. Instead, you need to use that value as an action. So, I'm not sure what pathsToScotty does, but it's very likely that you'll need to rewrite it.
I'm using Happstack to receive some parameters from an HTTP request then pass these parameters to a function that will retrieve data from the database and return this data in the HTTP response as follow:
myFunc :: IO String
myFunc = do r <- look "personId"
conn <- connectODBC "... my connection string ...";
vals <- quickQuery conn ("SELECT Name FROM Person where Id = ?") [(toSql r)];
return (processData vals)
handlers :: ServerPartT IO Response
handlers = do
x <- liftIO (myFunc);
decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse x
, ... other handlers ...
]
mainFunc = simpleHTTP nullConf handlers
But when I build the above code I get the following error:
No instance for (HasRqData IO) arising from a use of `look'
In a stmt of a 'do' block: r <- look "personId"
After reading questions on similar issues (like this one) I think I have to include HasRqData constraint somewhere, but I couldn't learn where and how.
As you may have guessed, this is too an issue with monads. There are a handful of them in happstack (HasRqData, among others), so you may well consider it a complicated case.
Let us begin with the innocent-looking look function.
look :: (Functor m, Monad m, HasRqData m) => String -> m String
Indeed, there is a non-trivial constraint HasRqData. Let us ask ourselves: what monads HaveRqData? (It so happens that IO has not!)
class HasRqData m where
...
Instances
HasRqData RqData
(MonadIO m, MonadPlus m) => HasRqData (ServerPartT m)
...
The other instances are derivative of these first two, so, it looks like we have to consider these two options first.
The RqData has limited effects — you can only do look and its derivatives, extracting information from the request at hand. As we want to also have other effects — querying the database, for one, — this is not enough for us.
The ServerPartT m is the general form of the same old friend of ours, ServerPart ≡ ServerPartT IO. It happens that it also HasRqData. This is not a coincidence, but rather an implication of the design of happstack — looks like the authors meant us to use this single monad everywhere, unless we need particular granularity. So, let's give it a try.
myFunc :: ServerPart String
myFunc = do r <- look "personId"
return undefined
This compiles.
Now, we don't even need to lift myFunc in handlers — our previous predicament solved itself. We will need to lift our access to the database though, by the same jar logic we discussed before.
I believe you can figure the details by yourself. In any case, let me know how it works out!
I'm trying to use the "citation-resolve" package in a Haskell project I'm working on, but I'm having trouble getting my head around using EitherT's in real code. I get that they're monad transformers, and I think I understand what that means, however I can't seem to actually work out how to use them. The toy example that represents what I'm trying to do is as follows:
module Main where
import Text.EditDistance
import Text.CSL.Input.Identifier
import Text.CSL.Reference
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either
main = do
putStrLn "Resolving definition"
let resRef = runEitherT $ resolveEither "doi:10.1145/2500365.2500595"
case resRef of
Left e -> do
putStrLn ("Got error: "++ e)
Right ref -> do
putStrLn ("Added reference to database: "++ (show ref))
Here, resolveEither has the type:
resolveEither :: (HasDatabase s,
Control.Monad.IO.Class.MonadIO m,
mtl-2.1.3.1:Control.Monad.State.Class.MonadState s m)
=> String -> EitherT String m Reference
and runEitherT $ resolveEither "ref" has the type:
runEitherT $ resolveEither "ref"
:: (HasDatabase s,
Control.Monad.IO.Class.MonadIO m,
mtl-2.1.3.1:Control.Monad.State.Class.MonadState s m)
=> m (Either String Reference)
However, this gives the following error:
Main.hs:10:34:
No instance for (Control.Monad.IO.Class.MonadIO (Either [Char]))
arising from a use of ‘resolveEither’
In the first argument of ‘runEitherT’, namely
‘(resolveEither "doi:10.1145/2500365.2500595")’
In the expression:
runEitherT (resolveEither "doi:10.1145/2500365.2500595")
In an equation for ‘resRef’:
resRef = runEitherT (resolveEither "doi:10.1145/2500365.2500595")
Which I have no idea how to resolve, or work around.
Any help would be appreciated, especially pointers to tutorials dealing with monad transformers from a usage perspective, not an implementation one.
Edit:
To reflect the comments on answers by dfeuer and Christian, I still get errors if I change main to the following:
main = do
putStrLn "Resolving definition"
resRef <- runEitherT (resolveEither "doi:10.1145/2500365.2500595")
case resRef of
Left e -> do
putStrLn ("Got error: "++ e)
Right ref -> do
putStrLn ("Added reference to database: "++ (show ref))
The error I get now is:
No instance for (MonadState s0 IO)
arising from a use of ‘resolveEither’
In the first argument of ‘runEitherT’, namely
‘(resolveEither "doi:10.1145/2500365.2500595")’
In a stmt of a 'do' block:
resRef <- runEitherT (resolveEither "doi:10.1145/2500365.2500595")
In the expression:
do { putStrLn "Resolving definition";
resRef <- runEitherT (resolveEither "doi:10.1145/2500365.2500595");
case resRef of {
Left e -> do { ... }
Right ref -> do { ... } } }
I'm editing my question as well as commenting, as nice code formatting is substantially easier here than in a comment.
I believe the problem is that you're trying to pattern match on resRef when what you probably want to do is execute it and pattern match on the result.
So you should try this:
main = do
putStrLn "Resolving definition"
resRef <- runEitherT $ resolveEither "doi:10.1145/2500365.2500595"
case resRef of
Left e -> do
You've encountered one of the shortcomings of the mtl class-based approach: intimidating type errors. I think it'll be helpful to imagine what the situation would look like with normal transformers-based monad transformers. I hope this will also help you get your feet with monad transformers in general. (It looks like you already understand most of this, by the way; I'm just spelling it out.)
Giving the types is a great way to start. Here's what you had:
resolveEither :: (HasDatabase s,
MonadIO m,
MonadState s m)
=> String -> EitherT String m Reference
There's a type hidden in the constraints, s, which came back to bite you a little later. The constraints, roughly speaking, express the following: s has a database (whatever that means in context); the monad or monad stack m has IO at its base, and somewhere in the monad stack m is a StateT s layer. The simplest monad stack m satisfying those properties would be HasDatabase s => StateT s IO. So we could write this:
resolveEither' :: HasDatabase s
=> String -> EitherT String (StateT s IO) Reference
resolveEither' = resolveEither
All we've done is specify the type of m so it's no longer a variable. We don't need to do that as long as we satisfy the class constraints.
Now it's clearer that there are two layers of monad transformers. Since our main function is in the IO monad, we want to end up with a value of type IO, which we can "run", for instance using <- in do notation. I think of it as "stripping away" layers of the monad transformer, from out to in. (This is what "using" monad transformers boils down to.)
For EitherT, there's a function runEitherT :: EitherT e m a -> m (Either e a). See how the m moves from "inside" the EitherT to "outside"? For me, that's the critical intuitive observation. Similarly for StateT, there's runStateT :: StateT s m a -> s -> m (a, s).
(Incidentally, both are defined as record accessors, which is idiomatic but causes them to show up a bit oddly in Haddock and with the "wrong" type signature; it took me a while to learn to look in the "Constructor" section on Haddocks and mentally add the EitherT e m a -> etc. to the front of the signature.)
So this adds up to a general solution, which you've basically worked out: we need an appropriate value of type s (which I'll call s), then we can use flip runStateT s . runEitherT $ resolveEither "ref" which has type IO ((Either String Reference), s). (Assuming I've kept the types straight in my head, which I probably didn't. I had forgotten flip the first time.) We can then pattern-match or use fst to get to the Either, which seems to be what you really want.
If you'd like me to explicate the errors GHC was giving you, I'd be glad. Informally, it was saying that you weren't "running" or stripping off all the monad transformers. More precisely, it was observing that IO wasn't something like StateT s IO. By using runStateT and runEitherT, you force or constrain the type such that the class constraints end up satisfied. This is kind of confusing when you get things slightly wrong.
Oh, regarding an idiomatic way to write the solution: I'm not sure that a separate retEither function would be idiomatic here, because it looks like it's meddling with global state, i.e. opening some sort of database file. It depends what the library's idiom is like.
Also, by using evalStateT, you're implicitly throwing away the state after evaluation, which may or may not be a bad idea. Does the library expect you to reuse the database connection?
Finally, you have some extra parentheses and some missing type signatures; hlint will help you with those.
Okay, so I think I've worked out a solution to my original problem, which was getting a value of the type IO (Either String Reference) from the function resolveEither (which it does for the resolveDef function it provides).
So, resolveEither returns a type of
(HasDatabase s, MonadIO m, MonadState s m) => String -> EitherT String m Reference
which we can transform to one of type
(HasDatabase s, MonadIO m, MonadState s m) => String -> m (Either String Reference)
using runEitherT . resolveEither. This was where I'd got up to when I asked the question. From there, i tried looking at the source to see how the library extracted a Reference type from the function resolveEither. The library uses the following function:
resolve :: (MonadIO m, MonadState s m, HasDatabase s) => String -> m Reference
resolve = liftM (either (const emptyReference) id) . runEitherT . resolveEither
however, we want to preserve the either, i.e. removing liftM (either (const emptyReference) id)
This however gets us back to where we started, so I looked at the source again, and worked out how this function is used. In the library, the function is used within the following, which transforms the output type of resolve from a value of type (MonadIO m, MonadState s m, HasDatabase s) => m Reference to one of type IO Reference:
resolveDef :: String -> IO Reference
resolveDef url = do
fn <- getDataFileName "default.db"
let go = withDatabaseFile fn $ resolve url
State.evalStateT go (def :: Database)
We can replace resolve in the previous with runEitherT.resolveEither to get a function that returns a IO (Either String Reference):
retEither s = do
fn <- getDataFileName "default.db"
let go = withDatabaseFile fn $ ( (runEitherT.resolveEither) s)
State.evalStateT go (Database Map.empty)
(I've replaced (def :: Database) with (Database Map.empty) as def is only defined internally in citation-resolve)
The overall solution then becomes:
module Main where
import Text.EditDistance
import Text.CSL.Input.Identifier.Internal
import Text.CSL.Input.Identifier
import Text.CSL.Reference
import Control.Monad.Trans.Either
import Control.Monad.State as State
import qualified Data.Map.Strict as Map
main = do
putStrLn "Resolving definition"
resRef <- retEither "doi:10.1145/2500365.2500595"
case resRef of
Left e -> putStrLn ("Got error: "++ e)
Right ref -> putStrLn ("Added reference to database: "++ (show ref))
retEither s = do
fn <- getDataFileName "default.db"
let go = withDatabaseFile fn $ ((runEitherT.resolveEither) s)
State.evalStateT go (Database Map.empty)
Which solves the original problem!
Any pointers on style, or ways of simplifying the whole process would however be very much appreciated.
I'm trying to "resume" a monadic computation from within IO and fearing that I may be out of luck. The situation is the following:
ioBracketFoo :: (a - > IO b) -> IO b
withBar :: MonadIO m => (a -> m b) -> m b
withBar action = liftIO $ ioBracketFoo $ \foo -> runMagic (action f)
Basically I want to resume my (unknown) monadic computation from within ioBracketFoo. If it were not a bracketing function then I'd be able to get the resource using res <- liftIO getFoo and release it later, and I wouldn't have to resume my monadic computation from within IO.
Is there any other creative use of lift or similar to make this possible?
This problem is sloved by MonadBaseControl. MonadBaseControl provides the functions to store and restart a monadic computation. You'll require an additional dependency to MonadBaseControl, which will prevent unstorable monads from beeing used in your bracket-funciton, for example
There is a tutorial on fp-complete, that should answer all basic questions.
I am practicing at getting consistent with my error handling, and I keep hoping to see the code that I've written start shrinking. But I built up a domain-meaningful persistence function, and the amount of code I had to write just to do monad handling and custom error handling is astounding.
For "programming errors", I just call error "assertion blown"
For really mundane things, I return Nothing (the requested object doesn't exist)
For errors that should be handled, I'm returning Either E V or its equivalent by creating a Control.Monad.Error instance to handle it.
I have in my application multiple functions which I would call primitives, but they can catch certain errors and will raise them my throwing a value of the DBError type. So, I've defined them like so:
data DBError = ConversionError ConvertError
| SaveError String
| OtherError String
deriving (Show, Eq)
instance Error DBError where
noMsg = OtherError "No message found"
strMsg s = OtherError s
type DBMonad = ErrorT DBError IO
selectWorkoutByID :: IConnection a => UUID -> a -> DBMonad (Maybe SetRepWorkout)
insertWorkout :: IConnection a => SetRepWorkout -> a -> DBMonad ()
At the level of the calling application, a Workout is a unique object persisted to the database, so the application only ever calls saveWorkout, which itself uses selectWorkoutByID, insertWorkout, and updateWorkout in the ways you would expect:
saveWorkout :: IConnection a => SetRepWorkout -> a -> DBMonad ()
saveWorkout workout conn =
r <- liftIO $ withTransaction conn $ \conn -> runErrorT $ do
w_res <- selectWorkoutByID (uuid workout) conn
case w_res of
Just w -> updateWorkout workout conn >> return ()
Nothing -> insertWorkout workout conn >> return ()
case r of
Right _ -> return ()
Left err -> throwError err
This is ugly. I have to run and unwrap a DBMonad, run that in the IO monad, lift the IO back up into the DBMonad, and then check the results and re-wrap the results in the DBMonad.
How can I do this with less, and easier to read, code?
I'm expecting that using my custom application monad to handle recoverable errors would help me to reduce the amount of code I have to write, but this is doing the opposite!
Here are some additional questions:
Is there a better way to build up application-semantic errors?
Should I be using Control.Exception instead?
After reviewing http://en.wikibooks.org/wiki/Haskell/Monad_transformers, which is the first document on Monad Transformers that really helped me understand them, I figured out a decent solution.
A new version of the saveWorkout function would look like this:
saveWorkout :: IConnection a => SetRepWorkout -> a -> DBMonad ()
saveWorkout workout conn =
ErrorT $ liftIO $ withTransaction conn $ \conn -> runErrorT $ do
w_res <- selectWorkoutByID (uuid workout) conn
case w_res of
Just w -> updateWorkout workout conn >> return ()
Nothing -> insertWorkout workout conn >> return ()
The deal is this:
withTransaction is returning IO Either DBError (). liftIO has the type MonadIO m => IO a -> m a. ErrorT is the standard constructor for everything of the ErrorT monad, and I defined DBMonad to be of that monad. So, I am working with these types:
withTransaction conn $ <bunch of code> :: IO (Either DBError ())
liftIO :: MonadIO m => IO (Either DBError ()) -> m (Either DBError ())
ErrorT :: IO (Either DBError ()) -> ErrorT IO DBError ()
Ideally, since ErrorT/DBMonad are part of the MonadTrans class, I would use simply lift in order to lift IO (Either DBError ()) back up into the ErrorT monad, but at this time I cannot get it to actually type check correctly. This solution, however, still makes the code better by removing the redundent re-wrapping that I had before.