Skip to content

Commit 181e51d

Browse files
committed
Add MonadFail instance for Handler wrt #1545
1 parent 7ef9730 commit 181e51d

File tree

2 files changed

+12
-2
lines changed

2 files changed

+12
-2
lines changed

servant-server/CHANGELOG.md

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,11 @@
33

44
Package 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+
611
0.19
712
----
813

servant-server/src/Servant/Server/Internal/Handler.hs

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,17 +13,19 @@ import Control.Monad.Base
1313
import Control.Monad.Catch
1414
(MonadCatch, MonadMask, MonadThrow)
1515
import Control.Monad.Error.Class
16-
(MonadError)
16+
(MonadError, throwError)
1717
import Control.Monad.IO.Class
1818
(MonadIO)
1919
import Control.Monad.Trans.Control
2020
(MonadBaseControl (..))
2121
import Control.Monad.Trans.Except
2222
(ExceptT, runExceptT)
23+
import Data.String
24+
(fromString)
2325
import GHC.Generics
2426
(Generic)
2527
import Servant.Server.Internal.ServerError
26-
(ServerError)
28+
(ServerError, errBody, err500)
2729

2830
newtype 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+
3540
instance MonadBase IO Handler where
3641
liftBase = Handler . liftBase
3742

0 commit comments

Comments
 (0)