on master help sign in
Merge pull request #1546 from hasufell/PR/hasufell/issue-1545/monad-fail

Add `MonadFail` instance for `Handler` wrt #1545

commit8fccfccae04a2f7d2bbb013a53be3ff2967b8cfa authorGaël Deest <gael.deest@tweag.io> dateMon 28 Feb 2022, 09:47 (5 years ago) parent7ef9730181e51d
2 files changed+12−2
servant-server/CHANGELOG.md+5 servant-server/src/Servant/Server/Internal/Handler.hs+7−2
servant-server/CHANGELOG.md+5
@@ -3,6 +3,11 @@
33
44Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
55
6+Unreleased
7+----------
8+
9+- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
10+
6110.19
712----
813
servant-server/src/Servant/Server/Internal/Handler.hs+7−2
@@ -13,17 +13,19 @@ import Control.Monad.Base
1313import Control.Monad.Catch
1414 (MonadCatch, MonadMask, MonadThrow)
1515import Control.Monad.Error.Class
16− (MonadError)
16+ (MonadError, throwError)
1717import Control.Monad.IO.Class
1818 (MonadIO)
1919import Control.Monad.Trans.Control
2020 (MonadBaseControl (..))
2121import Control.Monad.Trans.Except
2222 (ExceptT, runExceptT)
23+import Data.String
24+ (fromString)
2325import GHC.Generics
2426 (Generic)
2527import Servant.Server.Internal.ServerError
26− (ServerError)
28+ (ServerError, errBody, err500)
2729
2830newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
2931 deriving
@@ -32,6 +34,9 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
3234 , MonadThrow, MonadCatch, MonadMask
3335 )
3436
37+instance MonadFail Handler where
38+ fail str = throwError err500 { errBody = fromString str }
39+
3540instance MonadBase IO Handler where
3641 liftBase = Handler . liftBase
3742