haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use mplus (thanks @meteficha)

Browse Source
This commit is contained in:
Michael Snoyman 2014-04-10 20:30:14 +03:00
parent 4dc7a1258c
commit b67d225f56
1 changed files with 3 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -13,6 +13,7 @@ import Control.Applicative ((<$>))
import Control.Exception (fromException, bracketOnError, evaluate) import Control.Exception (fromException, bracketOnError, evaluate)
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Exception.Lifted (catch) import Control.Exception.Lifted (catch)
import Control.Monad (mplus)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LogLevel (LevelError), LogSource, import Control.Monad.Logger (LogLevel (LevelError), LogSource,
@ -91,12 +92,9 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -
([], Just $! HCError $! InternalError $! T.pack $! show (e :: E.SomeException)) ([], Just $! HCError $! InternalError $! T.pack $! show (e :: E.SomeException))
let contents = let contents =
case mcontents1 of case mcontents1 `mplus` mcontents2 of
Just x -> x Just x -> x
Nothing -> Nothing -> either id (HCContent defaultStatus . toTypedContent) contents'
case mcontents2 of
Just x -> x
Nothing -> either id (HCContent defaultStatus . toTypedContent) contents'
let handleError e = flip runInternalState resState $ do let handleError e = flip runInternalState resState $ do
yar <- rheOnError e yreq yar <- rheOnError e yreq
{ reqSession = finalSession { reqSession = finalSession