Fix servant-server

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

@@ -12,7 +12,6 @@
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances       #-}
 
 #if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802
 #define HAS_TYPE_ERROR
@@ -34,73 +33,74 @@ module Servant.Server.Internal
   , module Servant.Server.Internal.ServantErr
   ) where
 
-import           Control.Monad              (join, when)
+import           Control.Monad
-import           Control.Monad.Trans        (liftIO)
+                 (join, when)
-import           Control.Monad.Trans.Resource (runResourceT)
+import           Control.Monad.Trans
+                 (liftIO)
+import           Control.Monad.Trans.Resource
+                 (runResourceT)
 import qualified Data.ByteString                            as B
 import qualified Data.ByteString.Builder                    as BB
 import qualified Data.ByteString.Char8                      as BC8
 import qualified Data.ByteString.Lazy                       as BL
-import           Data.Maybe                 (fromMaybe, mapMaybe,
+import           Data.Either
-                                             isNothing, maybeToList)
+                 (partitionEithers)
-import           Data.Either                (partitionEithers)
 import qualified Data.Map.Strict                            as Map
-import           Data.String                (IsString (..))
+import           Data.Maybe
-import           Data.String.Conversions    (cs, (<>))
+                 (fromMaybe, isNothing, mapMaybe, maybeToList)
-import           Data.Tagged                (Tagged(..), retag, untag)
+import           Data.String
+                 (IsString (..))
+import           Data.String.Conversions
+                 (cs, (<>))
+import           Data.Tagged
+                 (Tagged (..), retag, untag)
 import qualified Data.Text                                  as T
 import           Data.Typeable
-import           GHC.TypeLits               (KnownNat, KnownSymbol, natVal,
+import           GHC.TypeLits
-                                             symbolVal)
+                 (KnownNat, KnownSymbol, natVal, symbolVal)
-import           Network.HTTP.Types         hiding (Header, ResponseHeaders)
 import qualified Network.HTTP.Media                         as NHM
-import           Network.Socket             (SockAddr)
+import           Network.HTTP.Types                         hiding
-import           Network.Wai                (Application, Request,
+                 (Header, ResponseHeaders)
-                                             httpVersion, isSecure,
+import           Network.Socket
-                                             lazyRequestBody,
+                 (SockAddr)
-                                             rawQueryString, remoteHost,
+import           Network.Wai
-                                             requestHeaders, requestMethod,
+                 (Application, Request, httpVersion, isSecure, lazyRequestBody,
-                                             responseLBS, responseStream,
+                 rawQueryString, remoteHost, requestHeaders, requestMethod,
-                                             vault)
+                 responseLBS, responseStream, vault)
 import           Prelude ()
 import           Prelude.Compat
-import           Web.HttpApiData            (FromHttpApiData, parseHeader,
+import           Servant.API
-                                             parseQueryParam,
+                 ((:<|>) (..), (:>), Accept (..), BasicAuth,
-                                             parseUrlPieceMaybe,
+                 BoundaryStrategy (..), Capture', CaptureAll, Description,
-                                             parseUrlPieces)
+                 EmptyAPI, FramingRender (..), Header', If, IsSecure (..),
-import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capture',
+                 QueryFlag, QueryParam', QueryParams, Raw,
-                                              CaptureAll, Verb, EmptyAPI,
+                 ReflectMethod (reflectMethod), RemoteHost, ReqBody',
-                                              ReflectMethod(reflectMethod),
+                 SBool (..), SBoolI (..), Stream, StreamGenerator (..),
-                                              IsSecure(..), Header', QueryFlag,
+                 Summary, ToStreamGenerator (..), Vault, Verb,
-                                              QueryParam', QueryParams, Raw,
+                 WithNamedContext)
-                                              RemoteHost, ReqBody', Vault,
+import           Servant.API.ContentTypes
-                                              WithNamedContext,
+                 (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
-                                              Description, Summary,
+                 AllMime, MimeRender (..), canHandleAcceptH)
-                                              Accept(..),
+import           Servant.API.Modifiers
-                                              FramingRender(..), Stream,
+                 (FoldLenient, FoldRequired, RequestArgument,
-                                              StreamGenerator(..), ToStreamGenerator(..),
+                 unfoldRequestArgument)
-                                              BoundaryStrategy(..),
+import           Servant.API.ResponseHeaders
-                                              If, SBool (..), SBoolI (..))
+                 (DynHeaders (..), GetHeaders, Headers, getHeaders,
-import           Servant.API.Modifiers       (unfoldRequestArgument, RequestArgument, FoldRequired, FoldLenient)
+                 getResponse)
-import           Servant.API.ContentTypes    (AcceptHeader (..),
+import           Web.HttpApiData
-                                              AllCTRender (..),
+                 (FromHttpApiData, parseHeader, parseQueryParam,
-                                              AllCTUnrender (..),
+                 parseUrlPieceMaybe, parseUrlPieces)
-                                              AllMime,
-                                              MimeRender(..),
-                                              canHandleAcceptH)
-import           Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
-                                              getResponse, DynHeaders,
-                                              DynResponse, withDynHeaders)
 
-import           Servant.Server.Internal.Context
 import           Servant.Server.Internal.BasicAuth
+import           Servant.Server.Internal.Context
 import           Servant.Server.Internal.Handler
 import           Servant.Server.Internal.Router
 import           Servant.Server.Internal.RoutingApplication
 import           Servant.Server.Internal.ServantErr
 
 #ifdef HAS_TYPE_ERROR
-import GHC.TypeLits (TypeError, ErrorMessage (..))
+import           GHC.TypeLits
+                 (ErrorMessage (..), TypeError)
 #endif
 
 class HasServer api context where
@@ -286,7 +286,7 @@ instance OVERLAPPING_
          ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
          ) => HasServer (Verb method status ctypes (DynHeaders a)) context where
 
-  type ServerT (Verb method status ctypes (DynHeaders a)) m = m (DynResponse a)
+  type ServerT (Verb method status ctypes (DynHeaders a)) m = m (DynHeaders a)
   hoistServerWithContext _ _ nt s = nt s
 
   route Proxy _ = methodRouter (\x -> (Map.toList (dynHeaders x), dynResponse x))

servant/src/Servant/API.hs

@@ -109,11 +109,10 @@ import           Servant.API.RemoteHost
 import           Servant.API.ReqBody
                  (ReqBody, ReqBody')
 import           Servant.API.ResponseHeaders
-                 (AddHeader, BuildHeadersTo (buildHeadersTo),
+                 (AddHeader, BuildHeadersTo (buildHeadersTo), DynHeaders (..),
-                 DynHeaders(..), DynResponse(..), withDynHeaders,
                  GetHeaders (getHeaders), HList (..), Headers (..),
                  ResponseHeader (..), addHeader, getHeadersHList, getResponse,
-                 noHeader)
+                 noHeader, withDynHeaders)
 import           Servant.API.Stream
                  (BoundaryStrategy (..), BuildFromStream (..),
                  ByteStringParser (..), FramingRender (..),

servant/src/Servant/API/ResponseHeaders.hs

@@ -36,7 +36,6 @@ module Servant.API.ResponseHeaders
 
     , -- * "Dynamic" response headers
       DynHeaders(..)
-    , DynResponse(..)
     , withDynHeaders
     ) where
 
@@ -177,22 +176,20 @@ noHeader = addOptionalHeader MissingHeader
 
 -- | Combinator to use when you want your endpoint to return a response
 --   along with some response headers, dynamically,
---   by simply building a value of type 'DynResponse a', which is just a
+--   by simply building a value of type 'DynHeaders a', which is just a
 --   response of type @a@ along with a map from header names to header values.
 --
 --   For all other interpretations than the server one, this combinator basically
 --   has no effect and behaves just as if you were using @a@ directly.
-data DynHeaders a
+data DynHeaders a = DynHeaders
-
-data DynResponse a = DynResponse
   { dynResponse :: a
   , dynHeaders  :: Map HTTP.HeaderName ByteString
   } deriving (Typeable, Eq, Show, Functor)
 
 -- | Build a \"response with headers\", where the headers are
 --   provided at runtime as a 'Map' from header name to header value.
-withDynHeaders :: a -> Map HTTP.HeaderName ByteString -> DynResponse a
+withDynHeaders :: a -> Map HTTP.HeaderName ByteString -> DynHeaders a
-withDynHeaders = DynResponse
+withDynHeaders = DynHeaders
 
 -- $setup
 -- >>> import Servant.API