Merge pull request #1546 from hasufell/PR/hasufell/issue-1545/monad-fail

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

servant-server/CHANGELOG.md

@@ -3,6 +3,11 @@
 
 Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
 
+Unreleased
+----------
+
+- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
+
 0.19
 ----
 

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

@@ -13,17 +13,19 @@ import           Control.Monad.Base
 import           Control.Monad.Catch
                  (MonadCatch, MonadMask, MonadThrow)
 import           Control.Monad.Error.Class
-                 (MonadError)
+                 (MonadError, throwError)
 import           Control.Monad.IO.Class
                  (MonadIO)
 import           Control.Monad.Trans.Control
                  (MonadBaseControl (..))
 import           Control.Monad.Trans.Except
                  (ExceptT, runExceptT)
+import           Data.String
+                 (fromString)
 import           GHC.Generics
                  (Generic)
 import           Servant.Server.Internal.ServerError
-                 (ServerError)
+                 (ServerError, errBody, err500)
 
 newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
   deriving
@@ -32,6 +34,9 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
     , MonadThrow, MonadCatch, MonadMask
     )
 
+instance MonadFail Handler where
+  fail str = throwError err500 { errBody = fromString str }
+
 instance MonadBase IO Handler where
   liftBase = Handler . liftBase