I'm using Servant with custom monad stack:
newtype AppHandler a = AppHandler { runHandler :: ReaderT Config (ExceptT ServantErr IO) a }
deriving (Functor, Applicative, Monad, MonadReader Config, MonadError ServantErr, MonadIO)
data Config = Config
{ getPool :: ConnectionPool }
Now, in many handlers I just need to do fetch some data (Persistent) from db and act upon it, so I've got:
runDb :: (MonadReader Config m, MonadIO m) => SqlPersistT IO b -> m b
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
As it turns out, when fetching from db, you're bound to work with Maybe, and quite often when the Maybe is Nothing, you just want to throw error so that Servant server will turn it into proper HTTP response. This led me to the discovery of Control.Error.Util and the (!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a helper. So I tried following:
someHandler :: AppHandler NoContent
someHandler = do
entity <- (runDb $ getCompanyByName companyName) !? err400
-- some more logic
return NoContent
But this does not compile, the result of !? here is ExceptT ServantErr m0 (Entity SomeEntity) but I no longer work with such handler type, it requires the AppHandler (Entity SomeEntity). How would I convert such value back to my handler type?
You want a variant of (!?) that is polymorphic in which monad it returns. For example:
(!??) :: MonadError e m => m (Maybe a) -> e -> m a
act !?? err = act >>= maybe (throwError err) return
Then, provided err400 :: ServantError -- which is the type of errors you declared AppHandler to have -- you will be able to write
runDb (getCompanyByName companyName) !?? err400
In general to convert a value of type m a to ReaderT r m a just use lift.
So perhaps this will work for you:
entity <- lift $ (runDb $ getCompanyByName companyName) !? err400
if the entire (runDb ...) !? err400 is an ExceptT ServantError ... value.
Also, this servant issue discussion:
https://github.com/haskell-servant/servant/issues/286
might be helpful.
Related
I'm trying to implement a simple web server that interacts with some other API and stores the response after doing some processing.
To encapsulate the possibility of failure (empty response, incorrect request, etc) I am using ExceptT as following:
getExample
:: (MonadIO m, MonadReader ApplicationConfig m)
=> ExceptT ApplicationError m [Example]
getExample = do
partOfReq <- asks requestForSometing
fn1 =<< fn2 partOfReq
and I have another function that stores the response in a database using insertMany_ from Persistent.
storeExample
:: ( MonadIO m
, PersistStoreWrite backend
, PersistEntityBackend Example ~ BaseBackend backend
)
=> [Example]
-> ReaderT backend m ()
storeExample = insertMany_
Now I want to write a function
getResponseAndStore = ... {- A combination of getExample and storeExample -}
that will do both of these things and bubble up ApplicationConfig and PersistEntityBackend requirements to the top where the user could provide them in a bundle.
Would that be possible?
If so - What would the strategy/implementation be?
If no - What changes shall I consider?
Edit: This is what I'm doing currently.
getResponseAndStore
:: ( MonadIO m
, MonadReader ApplicationConfig m
, PersistStoreWrite backend
, PersistEntityBackend Example ~ BaseBackend backend
)
=> ReaderT backend (ExceptT ApplicationError m) ()
getResponseAndStore = storeExample =<< lift getExample
I was able to make a function that does just want I want to. The secret sauce was using withPostgresqlConn.
process :: ReaderT ApplicationConfig IO (Either ApplicationError ())
process = do
appConfig <- ask
connStr <- asks connectionString
runStdoutLoggingT
$ withPostgresqlConn connStr
$ flip ($) appConfig
. runReaderT
. runExceptT
. runReaderT getResponseAndStore
can't you use the MonadError syntax instead?
getExample
:: (MonadIO m, MonadReader ApplicationConfig m, MonadError ApplicationError m)
=> [Example]
getExample = -- ...
getResponseAndStore :: (MonadIO m, MonadReader ApplicationConfig m, PersistStoreWrite backend, PersistEntityBackend Example ~ BaseBackend backend, MonadError ApplicationError m) => -- etc.
Here is an issue of gluing together monads. Not in a stack form, but in a form of needing to unwrap one monad to run the operation inside another.
Two domains: Weblog and App. But, keep in mind that the App domain will be calling into additional ones in the same way that it currently calls in to Weblog. Both have their own monad stacks. Both keep track of their own state.
newtype WeblogM a = WeblogM (ReaderT Weblog (ErrorT WeblogError IO) a)
deriving (Monad, MonadIO, Reader.MonadReader Weblog, Error.MonadError WeblogError)
newtype AppM a = AppM (ReaderT App (EitherT AppError IO) a)
deriving ( Functor, Applicative, Monad
, MonadReader App, MonadError AppError)
In order to run a WeblogM operation inside of an AppM function, I'm finding that I have to unwrap the WeblogM and rewrap it, using functions like this:
runWeblogHere :: forall a. Weblog.Weblog -> Weblog.WeblogM a -> AppM a
runWeblogHere weblog action =
runIO (left . WeblogError) (Weblog.runWeblog weblog action)
runIO :: (e -> EitherT AppError IO a) -> IO (Either e a) -> AppM a
runIO handler = AppM . lift . handleT handler . EitherT
However, that does leave my actual passthrough operations quite simple:
getPage :: Weblog.PageId -> AppM Weblog.WikiPage
getPage pageid = do
App{weblog} <- ask
runWeblogHere weblog $ Weblog.getWikiPage pageid
This bothers me already because I have other monadic libraries that I already know that I'm going to plug in to the AppM architecture, and I'm worried about writing a runXHere method, which is really boilerplate, for each one of them.
I have a suggestion to create a MonadWeblog class to correspond to WeblogM, in much the same way that MonadReader corresponds to ReaderT. That appeals to me more because I can start isolating the monad glue into my instance of MonadWeblog (or, really, MonadX).
If we ignore the newtypes, and convert both error transformers to ExceptT, the two monads stacks share a similar structure:
import Control.Monad
import Control.Monad.Trans.Except (ExceptT, catchE)
import Control.Monad.Trans.Reader
type M env err r = ReaderT env (ExceptT err IO) r
Using the withReaderT and mapReaderT functions, we we can define:
changeMonad :: (env' -> env)
-> (err -> ExceptT err' IO r)
-> M env err r
-> M env' err' r
changeMonad envLens handler = withReaderT envLens . mapReaderT (flip catchE handler)
Edit: To ease the wrapping and unwrapping of the newtypes, we can make them instances of Wrapped from the lens library, and define a more general conversion function:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
newtype N1 r = N1 { getN1 :: M (Int,Int) String r }
$(makeWrapped ''N1)
--instance Wrapped (N1 r) where
-- type Unwrapped (N1 r) = M (Int,Int) String r
-- _Wrapped' = iso getN1 N1
newtype N2 r = N2 { getN2 :: M Int Char r }
$(makeWrapped ''N2)
changeMonad' :: (Wrapped (n1 r),
Unwrapped (n1 r) ~ M env' err' r,
Wrapped (n2 r),
Unwrapped (n2 r) ~ M env err r)
=> (env' -> env)
-> (err -> ExceptT err' IO r)
-> n2 r
-> n1 r
changeMonad' envLens handler =
view _Unwrapped' . changeMonad envLens handler . view _Wrapped'
changeN2N1 :: N2 r -> N1 r
changeN2N1 = changeMonad' fst (\c -> throwE [c])
Wrapped is a typeclass that says: "I'm actually a newtype, here's a generic way to add/remove the newtype constructor".
If the lens dependency is too heavy, the newtype package provides similar functionality.
How to use MonadBaseControl from monad-control to lift simpleHTTP function defined in happstack-server?
Current type of simpleHTTP:
simpleHTTP :: ToMessage a
=> Conf -> ServerPartT IO a -> IO ()
Expected type of simpleHTTPLifted:
simpleHTTPLifted :: (MonadBaseControl IO m, ToMessage a)
=> Conf -> ServerPartT m a -> m ()
My current attempt (does not compile):
simpleHTTPLifted conf action =
liftBaseWith (\runInBase ->
let
fixTypes :: UnWebT m a -> UnWebT IO a
fixTypes c = runInBase c
in simpleHTTP conf (mapServerPartT fixTypes action)
)
Note that similar puzzle is in my related question: MonadBaseControl: how to lift ThreadGroup
I'd like to understand how to in general lift such functions and what are usual steps taken when presented with such a type puzzle?
EDIT: I guess I need a function of type (StM m a -> a). restoreM is pretty close, but does not make it. I've also found an ugly version of fixTypes:
fixTypes :: UnWebT m a -> UnWebT IO a
fixTypes c = do
x <- newIORef undefined
_ <- runInBase (c >>= liftBase . writeIORef x)
readIORef x
This relies on IO being the base monad which is not an optimal solution.
I don't think you can lift this in general for any MonadBaseControl IO m. There are some ms for which we can.
In General
UnWebT m is isomorphic to WebT m which has a MonadTransControl instance. You can convert to and from WebT with mkWebT :: UnWebT m a -> WebT m a and ununWebT :: WebT m a -> UnWebT m a.
MonadBaseControl is a fancy wrapper around a stack of MonadTransControl transformers that flattens the stack so that running and restoring state happens all the way down the stack and all the way back up it again. You can understand MonadBaseControl by understanding MonadTransControl, which I'll repeat briefly here:
class MonadTrans t => MonadTransControl t where
data StT t :: * -> *
liftWith :: Monad m => (Run t -> m a) -> t m a
restoreT :: Monad m => m (StT t a) -> t m a
type Run t = forall n b. Monad n => t n b -> n (StT t b)
The class says with liftWith, "I'll provide a temporary way to run t ms in m, which you can use to build actions in m, which I will in turn run." The StT type of the result says, "the results of the t m things I run in m for you aren't going to be generally available in t m; I need to save my state somewhere, and you have to give me a chance to restore my state if you want the results."
Another way of saying approximately the same thing is, "I can temporarily unwrap the base monad". The question of implementing fixTypes is reduced to "Given that we can temporarily unwrap a WebT from an m and can temporarily unwrap an m from IO, can we permanently unwrap an m from an IO?" for which the answer, barring the capabilities of IO, is almost certainly "no".
IO Tricks
I suspect that there exist ms such that the "ugly" fixTypes will do horrible things like never call writeIORef and thus return undefined or execute code asynchronously and therefore call writeIORef after readIORef. I'm not sure. This is made complicated to reason about due to the possibility that the action created by liftBaseWith is never used in such degenerate cases.
For Comonads
There should be a way to lift simpleHttp without IO tricks precisely when the state of the monad m is a Comonad and therefore has a function extract :: StM m a -> a. For example, this would be the case for StateT s m which essentially has StM s a ~ (s, a).
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Happstack.Server.SimpleHTTP
import Control.Comonad
import Control.Monad.Base
import Control.Monad.Trans.Control
simpleHTTPLifted :: forall m a. (MonadBaseControl IO m, Comonad (StM m), ToMessage a)
=> Conf -> ServerPartT m a -> m ()
simpleHTTPLifted conf action =
liftBaseWith (\runInBase ->
let
fixTypes :: UnWebT m b -> UnWebT IO b
fixTypes = fmap extract . runInBase
in simpleHTTP conf (mapServerPartT fixTypes action)
)
In practice this isn't very useful because the newtypes defined in the older versions of monad-control don't have Comonad instances and the type synonymns in the newer versions of monad-control make no effort to have the result as the last type argument. For example, in the newest version of monad-control type StT (StateT s) a = (a, s) .
I'm using the EitherT monad transformer. Combining it with the IO monad, I'm afraid I would get an exception and it would not be caught.
Indeed the exception just passes through:
import Control.Monad.Trans
import Control.Error
import System.Directory
main = runEitherT testEx >>= print
testEx :: EitherT String IO ()
testEx = lift $ removeFile "non existing filename"
But the EitherT otherwise fits the bill perfectly to convey to callers the error. So I want to use that, not throw exceptions...
I looked at try from Control.Exception:
try :: Exception e => IO a -> IO (Either e a)
It looks to be exactly what I want, it would fit in my EitherT IO stack... (probably with an added hoistEither and maybe fmapL and it starts looking verbose though) But a naive lift $ try doesn't typecheck.
I'm sure this problem has been solved thousands of times, but I can't find any good link describing this exact issue. How is this supposed to be solved?
EDIT By "how is this supposed to be solved", I was interested in the idiomatic solution, what would be the standard way to handle that in haskell. From the answers so far, it seems the idiomatic way is to let the exceptions be thown and handle them higher-up. Seems like a bit counter-intuitive to have two flows of control and return paths, but it is apparently the way it's meant to be done.
I actually think EitherT is not the right thing to do here. What you're trying to say is "IO is for side-effects, and EitherT is for exceptions." But that's not true: IO always has the potential to result in an exception, so all you're doing is adding a false sense of security to your API, and introducing two ways that exceptions can be thrown instead of one. In addition, instead of using the well structured SomeException favored by IO, you're reducing down to String, which throws away information.
Anyway, if you're convinced that this is what you want to do, it's not too difficult. It looks something like:
eres <- liftIO $ try x
case eres of
Left e -> throwError $ show (e :: SomeException)
Right x -> return x
Note, however, that this will also swallow up async exceptions, which is usually not what you want to do. I think a better approach for that is enclosed-exceptions.
You don't want to lift trying the computation, then you'd get an Exception e => EitherT a IO (Either e ()).
testEx :: (Exception e, MonadTrans m) => m IO (Either e ())
testEx = lift . try $ fails
You don't want the error in the result, you want to integrate the error into the EitherT. You want to integrate trying somethign with your EitherT
testEx :: (Exception e) => EitherT e IO ()
testEx = EitherT . try $ fails
We'll do this in general, then get just the message you want.
Integrate try with EitherT
You can extract the idea of integrating try with EitherT
tryIO :: (Exception e) => IO a -> EitherT e IO a
tryIO = EitherT . try
Or, for any underlying MonadIO as
tryIO :: (Exception e, MonadIO m) => IO a -> EitherT e m a
tryIO = EitherT . liftIO . try
(tryIO conflicts with a name from Control.Error. I couldn't come up with another name for this.)
You can then say you are willing to catch any exception. SomeException will catch all exceptions. If you are only interested in specific exceptions, use a different type. See Control.Exception for the details. If you aren't sure what you want to catch, you probably only want to catch IOExceptions; this is what tryIO from Control.Error does; see the last section.
anyException :: EitherT SomeException m a -> EitherT SomeException m a
anyException = id
You only want to keep the error message from the exception
message :: (Show e, Functor m) => EitherT e m a -> EitherT String m a
message = bimapEitherT show id
Then you can write
testEx :: EitherT String IO ()
testEx = message . anyException . tryIO $ fails
Integrate try with MonadError
You can instead integrate trying something with any MonadError, using MonadError and MonadIO to penetrate the transformer stack.
import Control.Monad.Except
tryIO :: (MonadError e m, MonadIO m, Exception e) => IO a -> m a
tryIO = (>>= either throwError return) . liftIO . try
You can write testEx in terms of this tryIO and anyException and message from the previous section
testEx :: EitherT String IO ()
testEx = message . anyException . tryIO $ fails
tryIO from Control.Error
The tryIO from Control.Error is essentially our first tryIO, except it only catches IOExceptions instead of any exception. It's actually defined as
tryIO :: (MonadIO m) => IO a -> EitherT IOException m a
tryIO = EitherT . liftIO . try
We can use it with message to write testEx as
testEx :: EitherT String IO ()
testEx = message . tryIO $ fails
This is another simple approach: Let's define a custom monad transformer just like EitherT is defined:
{-# LANGUAGE FlexibleInstances, FunctionalDependencies #-}
import Control.Arrow (left)
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Error
import Control.Monad.IO.Class
newtype ErrT a m b = ErrT { runErrT :: m (Either a b) }
instance (Monad m) => Monad (ErrT a m) where
-- ...
instance (Monad m) => MonadError a (ErrT a m) where
-- ...
instance MonadTrans (ErrT a) where
lift = ErrT . liftM Right
together with the appropriate Applicative, Monad and MonadError instances.
Now let's add a means for an IOError to be converted to our error type. We can have a type class for this so that we're free in how we use the transformer.
class FromIOError e where
fromIOException :: IOError -> e
Finally, we'll implement MonadIO in such a way that liftIO always catches IOErrors and converts them to the pure data type in the left part:
instance (MonadIO m, FromIOError a) => MonadIO (ErrT a m) where
liftIO = ErrT . liftIO . liftM (left fromIOException)
. (try :: IO a -> IO (Either IOError a))
Now if we put all this in a module and export just the data type, runErrT, but not the constructor ErrT, everything that does IO within ErrT will have the exceptions properly handled, because IO actions can be introduced only through liftIO.
It'd be also possible to replace IOError with SomeException and handle all exceptions, if desired.
It seems a lot easier to maintain state through exceptions by holding on to an IORef than to try to use the State Monad. Below we have 2 alternative State Monads. One uses StateT and the other ReaderT IORef. The ReaderT IORef can easily run a final handler on the last known state.
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
import Control.Monad.State (MonadState, execStateT, modify, StateT)
import Control.Applicative (Applicative)
import Control.Monad (void)
import Control.Monad.IO.Class ( MonadIO, liftIO )
import Data.IORef
import Control.Exception.Base
import Control.Monad.Reader (MonadReader, runReaderT, ask, ReaderT)
type StateRef = IORef Int
newtype ReadIORef a = ReadIORef { unStIORef :: ReaderT StateRef IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadReader StateRef)
newtype St a = StM { unSt :: StateT Int IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadState Int)
eval :: St a -> Int -> IO Int
eval = execStateT . unSt
evalIORef :: ReadIORef a -> StateRef -> IO a
evalIORef = runReaderT . unStIORef
add1 :: St ()
add1 = modify (+ 1)
add1Error :: St ()
add1Error = do
modify (+ 1)
error "state modified"
add1IORef :: ReadIORef Int
add1IORef = do
ioref <- ask
liftIO $ do
modifyIORef' ioref (+ 1)
readIORef ioref
add1IORefError :: ReadIORef Int
add1IORefError = do
ioref <- ask
liftIO $ do
modifyIORef' ioref (+ 1)
void $ error "IORef modified"
readIORef ioref
ignore :: IO a -> IO a
ignore action = catch action (\(_::SomeException) -> return $ error "ignoring exception")
main :: IO ()
main = do
st <- newIORef 1
resIO <- evalIORef add1IORef st >> evalIORef add1IORef st
print resIO -- 3
resSt <- eval add1 1 >>= eval add1
print resSt -- 3
stFinal <- newIORef 1
void $ ignore $ finally (evalIORef add1IORefError stFinal) (evalIORef add1IORef stFinal)
print =<< readIORef st -- 3
-- how can the final handler function use the last state of the original?
void $ ignore $ finally (eval add1Error 1) (eval add1 1)
print "?"
So at the end of the main function, how can I run a final handler that has access to the last existing state of the State Monad even when an exception is thrown? Or is the ReaderT IORef optimal or is there a better alternative?
There is a way, but let me first explain recovering state from errors in terms of ErrorT and StateT, because I find that it illuminates the general case very well.
Let's first imagine the case where ErrorT is on the outside of StateT. In other words:
m1 :: ErrorT e (StateT s m) r
If you unwrap both the ErrorT and StateT newtypes you get:
runErrorT m1
:: StateT s m (Either e r)
runStateT (runErrorT m1)
:: s -> m (Either e r, s)
The unwrapped type says that we recover the final state, even if we receive an error. So just remember that ErrorT on the outside of StateT means we can recover from errors while still preserving the current state.
Now, let's switch the order:
m2 :: StateT s (ErrorT e m r)
runStateT m2
:: s -> ErrorT e m (r, s)
runErrorT . runStateT m2
:: s -> m (Either e (r, s))
This type tells a different story: we only recover the ending state if our computation succeeds. So just remember that ErrorT on the inside of StateT means that we can't recover the state.
This might seem curious to somebody familiar with the mtl, which provides the following MonadError instance for StateT:
instance (MonadError e m) => MonadError e (StateT s m) where ...
How does StateT recover gracefully from errors after what I just said? Well, it turns out that it does not. If you write the following code:
(m :: StateT s (ErrorT e m) r) `catchError` f
... then if m uses throwError, f will begin from m's initial state, not the state that m was at when it threw the error.
Okay, so now to answer your specific question. Think of IO as having a built-in ErrorT layer by default. This means that if you can't get rid of this ErrorT layer then it will always be inside your StateT and when it throws errors you won't be able to recover the current state.
Similarly, you can think of IO as having a built-in StateT layer by default that is below the ErrorT layer. This layer conceptually holds the IORefs, and because it is "inside" the ErrorT layer it always survives errors and preserves IORef values.
This means that the only way you can use a StateT layer above the IO monad and have it survive an exception is to get rid of IOs ErrorT layer. There is only one way to do this:
Wrap every IO action in tryIO
Mask asynchronous exceptions and only unmask them in the middle of tryIO statements.
My personal recommendation is to go the IORef route since there are some people who will not be happy about masking asynchronous exceptions outside of tryIO statements, because then you cannot interrupt pure computations.
Are you throwing these exceptions, or is a library?
Because if it's the former, why not use an EitherT transformer to do the exception handling?
You just need to be careful of the order: StateT s (EitherT e IO) a won't let you see the final state if there's an error, but EitherT e (StateT s IO) a will.
StateT s (EitherT e IO) a ~ IO (Either e (s -> (a,s)))
EitherT e (StateT s IO) a ~ IO (s -> (Either e a, s))
If you're using a library that throws exceptions, and you want to maintain state then you'd need to capture the exceptions within the State monad, using lift $ catch libraryCall exceptionHandler.
If you try to catch the exception outside of the State monad, like you're doing here, then that's isomorphic to StateT s (EitherT e IO) a, as you're using the error capabilities within IO to do the catching. The state is unavailable at that level.