Add MkHandler pattern synonym

This bidirectional pattern synonym makes it easier to build `Handler a`
values from `IO (Either ServerError a)` values, and is a complement to
the already existing `runHandler` function.

Solves #1732.

Author: Daniel Díaz

servant-server/src/Servant/Server.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE PatternSynonyms     #-}
 
 -- | This module lets you implement 'Server's for defined APIs. You'll
 -- most likely just need 'serve'.
@@ -25,6 +26,7 @@ module Servant.Server
   , emptyServer
   , Handler (..)
   , runHandler
+  , pattern MkHandler
 
     -- * Debugging the server layout
   , layout

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

@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE PatternSynonyms            #-}
 module Servant.Server.Internal.Handler where
 
 import           Prelude ()
@@ -19,7 +20,7 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Control
                  (MonadBaseControl (..))
 import           Control.Monad.Trans.Except
-                 (ExceptT, runExceptT)
+                 (ExceptT(ExceptT), runExceptT)
 import           Data.String
                  (fromString)
 import           GHC.Generics
@@ -51,3 +52,10 @@ instance MonadBaseControl IO Handler where
 
 runHandler :: Handler a -> IO (Either ServerError a)
 runHandler = runExceptT . runHandler'
+
+-- | Pattern synonym that matches directly on the inner 'IO' action.
+--
+-- To lift 'IO' actions that don't carry a 'ServerError', use 'Control.Monad.IO.Class.liftIO' instead.
+pattern MkHandler :: IO (Either ServerError a) -> Handler a
+pattern MkHandler ioe = Handler (ExceptT ioe)
+{-# COMPLETE MkHandler #-}