[Haskell-beginners] Lifting (Either SqlError a) in a monad stack

Karl Voelker ktvoelker at gmail.com
Tue Aug 27 01:18:16 CEST 2013


The problem is that the Either SqlError monad is not actually a part of
your "monad stack". It's just something that appears in the result type of
safeConnect and safeInsert. In order to put Either SqlError into your
stack, you'll need a monad transformer which exhibits Either-like
semantics, such as EitherT or ErrorT. Then your safeConnect would have type
"ConnectInfo -> EitherT SqlError IO Connection".

http://hackage.haskell.org/packages/archive/either/3.4.1/doc/html/Control-Monad-Trans-Either.html
http://hackage.haskell.org/packages/archive/transformers/0.3.0.0/doc/html/Control-Monad-Trans-Error.html

-Karl


On Mon, Aug 26, 2013 at 2:05 PM, Bryan Vicknair <bryanvick at gmail.com> wrote:

> I'm at the beginning of the monad transformers journey, and this is
> stumping
> me. I've read "Monad Transformers Step by Step" which made me confident
> enough
> to play with simple stacks, but I'm a bit lost in the following example
> from
> work. Please excuse any incorrect transformer terminology.
>
> In a WAI web app, I want to chain these two actions inside a monad stack:
>
> > safeConnect :: ConnectInfo         -> IO (Either SqlError Connection)
> > safeInsert  :: Thing -> Connection -> IO (Either SqlError Id)
>
> Here is an example where I would like 'result' to be (Right Id) only if
> the DB
> connection *and* the insert were successful, (Left SqlError) otherwise.
>
> > add :: Request -> ResourceT IO Response
> > add _ = do
> >   result <- liftIO $ safeConnect devConnInfo >>= safeInsert thing
> >   case result of
> >     (Left e)  -> return $ dbErr e
> >     (Right _) -> return $ postRedirect
> >   where thing = exampleThing
>
> The compiler tells me (edited for brevity):
>
>     Expected type: Either SqlError Connection -> GHC.Types.IO a0
>       Actual type: Connection -> GHC.Types.IO (Either SqlError Id)
>     In the return type of a call of `safeInsert'
>     In the second argument of `(>>=)', namely
>       `safeInsert thing'
>
> How can I chain safeConnect and safeInsert using the (Either SqlError a)
> monad
> inside WAI's (ResourceT IO Response) monad stack?
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130826/98d85c5e/attachment.htm>


More information about the Beginners mailing list