4e53c38 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Fix servant-server

4e53c38Oleg Grenrus9 years ago

servant-server/src/Servant/Server/Internal.hs+75−75

compare with master

unifiedsplit

@@ -1,25 +1,24 @@

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE ConstraintKinds #-}

3−{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DataKinds #-}

4−{-# LANGUAGE DeriveDataTypeable #-}

4+{-# LANGUAGE DeriveDataTypeable #-}

5−{-# LANGUAGE FlexibleContexts #-}

5+{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE MultiParamTypeClasses #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE OverloadedStrings #-}

8+{-# LANGUAGE OverloadedStrings #-}

9−{-# LANGUAGE PolyKinds #-}

9+{-# LANGUAGE PolyKinds #-}

10−{-# LANGUAGE RankNTypes #-}

10+{-# LANGUAGE RankNTypes #-}

11−{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

12−{-# LANGUAGE TupleSections #-}

12+{-# LANGUAGE TupleSections #-}

13−{-# LANGUAGE TypeFamilies #-}

13+{-# LANGUAGE TypeFamilies #-}

14−{-# LANGUAGE TypeOperators #-}

14+{-# LANGUAGE TypeOperators #-}

15−{-# LANGUAGE UndecidableInstances #-}

17#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802

16#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802

18#define HAS_TYPE_ERROR

17#define HAS_TYPE_ERROR

19#endif

18#endif

21#ifdef HAS_TYPE_ERROR

20#ifdef HAS_TYPE_ERROR

22−{-# LANGUAGE UndecidableInstances #-}

21+{-# LANGUAGE UndecidableInstances #-}

23#endif

22#endif

25#include "overlapping-compat.h"

24#include "overlapping-compat.h"

@@ -34,73 +33,74 @@ module Servant.Server.Internal

34 , module Servant.Server.Internal.ServantErr

33 , module Servant.Server.Internal.ServantErr

35 ) where

34 ) where

37−import Control.Monad (join, when)

36+import Control.Monad

37+ (join, when)

38−import Control.Monad.Trans (liftIO)

38+import Control.Monad.Trans

39+ (liftIO)

39−import Control.Monad.Trans.Resource (runResourceT)

40+import Control.Monad.Trans.Resource

41+ (runResourceT)

40−import qualified Data.ByteString as B

42+import qualified Data.ByteString as B

41−import qualified Data.ByteString.Builder as BB

43+import qualified Data.ByteString.Builder as BB

42−import qualified Data.ByteString.Char8 as BC8

44+import qualified Data.ByteString.Char8 as BC8

43−import qualified Data.ByteString.Lazy as BL

45+import qualified Data.ByteString.Lazy as BL

44−import Data.Maybe (fromMaybe, mapMaybe,

46+import Data.Either

47+ (partitionEithers)

48+import qualified Data.Map.Strict as Map

49+import Data.Maybe

45− isNothing, maybeToList)

50+ (fromMaybe, isNothing, mapMaybe, maybeToList)

46−import Data.Either (partitionEithers)

51+import Data.String

47−import qualified Data.Map.Strict as Map

48−import Data.String (IsString (..))

52+ (IsString (..))

49−import Data.String.Conversions (cs, (<>))

53+import Data.String.Conversions

54+ (cs, (<>))

50−import Data.Tagged (Tagged(..), retag, untag)

55+import Data.Tagged

56+ (Tagged (..), retag, untag)

51−import qualified Data.Text as T

57+import qualified Data.Text as T

52import Data.Typeable

58import Data.Typeable

59+import GHC.TypeLits

53−import GHC.TypeLits (KnownNat, KnownSymbol, natVal,

60+ (KnownNat, KnownSymbol, natVal, symbolVal)

54− symbolVal)

61+import qualified Network.HTTP.Media as NHM

62+import Network.HTTP.Types hiding

55−import Network.HTTP.Types hiding (Header, ResponseHeaders)

63+ (Header, ResponseHeaders)

56−import qualified Network.HTTP.Media as NHM

57−import Network.Socket (SockAddr)

64+import Network.Socket

65+ (SockAddr)

58−import Network.Wai (Application, Request,

66+import Network.Wai

59− httpVersion, isSecure,

67+ (Application, Request, httpVersion, isSecure, lazyRequestBody,

60− lazyRequestBody,

61− rawQueryString, remoteHost,

62− requestHeaders, requestMethod,

68+ rawQueryString, remoteHost, requestHeaders, requestMethod,

63− responseLBS, responseStream,

69+ responseLBS, responseStream, vault)

64− vault)

65−import Prelude ()

70+import Prelude ()

66import Prelude.Compat

71import Prelude.Compat

67−import Web.HttpApiData (FromHttpApiData, parseHeader,

68− parseQueryParam,

69− parseUrlPieceMaybe,

70− parseUrlPieces)

71−import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture',

72+import Servant.API

72− CaptureAll, Verb, EmptyAPI,

73+ ((:<|>) (..), (:>), Accept (..), BasicAuth,

73− ReflectMethod(reflectMethod),

74+ BoundaryStrategy (..), Capture', CaptureAll, Description,

74− IsSecure(..), Header', QueryFlag,

75+ EmptyAPI, FramingRender (..), Header', If, IsSecure (..),

75− QueryParam', QueryParams, Raw,

76+ QueryFlag, QueryParam', QueryParams, Raw,

76− RemoteHost, ReqBody', Vault,

77+ ReflectMethod (reflectMethod), RemoteHost, ReqBody',

77− WithNamedContext,

78+ SBool (..), SBoolI (..), Stream, StreamGenerator (..),

78− Description, Summary,

79− Accept(..),

80− FramingRender(..), Stream,

81− StreamGenerator(..), ToStreamGenerator(..),

79+ Summary, ToStreamGenerator (..), Vault, Verb,

82− BoundaryStrategy(..),

80+ WithNamedContext)

83− If, SBool (..), SBoolI (..))

84−import Servant.API.Modifiers (unfoldRequestArgument, RequestArgument, FoldRequired, FoldLenient)

85−import Servant.API.ContentTypes (AcceptHeader (..),

81+import Servant.API.ContentTypes

86− AllCTRender (..),

87− AllCTUnrender (..),

82+ (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),

88− AllMime,

89− MimeRender(..),

90− canHandleAcceptH)

83+ AllMime, MimeRender (..), canHandleAcceptH)

84+import Servant.API.Modifiers

85+ (FoldLenient, FoldRequired, RequestArgument,

86+ unfoldRequestArgument)

87+import Servant.API.ResponseHeaders

91−import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

88+ (DynHeaders (..), GetHeaders, Headers, getHeaders,

92− getResponse, DynHeaders,

89+ getResponse)

93− DynResponse, withDynHeaders)

90+import Web.HttpApiData

91+ (FromHttpApiData, parseHeader, parseQueryParam,

92+ parseUrlPieceMaybe, parseUrlPieces)

95−import Servant.Server.Internal.Context

96import Servant.Server.Internal.BasicAuth

94import Servant.Server.Internal.BasicAuth

95+import Servant.Server.Internal.Context

97import Servant.Server.Internal.Handler

96import Servant.Server.Internal.Handler

98import Servant.Server.Internal.Router

97import Servant.Server.Internal.Router

99import Servant.Server.Internal.RoutingApplication

98import Servant.Server.Internal.RoutingApplication

100import Servant.Server.Internal.ServantErr

99import Servant.Server.Internal.ServantErr

101

100

102#ifdef HAS_TYPE_ERROR

101#ifdef HAS_TYPE_ERROR

103−import GHC.TypeLits (TypeError, ErrorMessage (..))

102+import GHC.TypeLits

103+ (ErrorMessage (..), TypeError)

104#endif

105

106class HasServer api context where

@@ -286,7 +286,7 @@ instance OVERLAPPING_

286 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status

287 ) => HasServer (Verb method status ctypes (DynHeaders a)) context where

288

289− type ServerT (Verb method status ctypes (DynHeaders a)) m = m (DynResponse a)

289+ type ServerT (Verb method status ctypes (DynHeaders a)) m = m (DynHeaders a)

290 hoistServerWithContext _ _ nt s = nt s

291

292 route Proxy _ = methodRouter (\x -> (Map.toList (dynHeaders x), dynResponse x))

@@ -771,7 +771,7 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

771-- ...Maybe you haven't applied enough arguments to

772-- ...Capture' '[] "foo"

773-- ...

774−--

774+--

775instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context

776 where

777 type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)

servant/src/Servant/API.hs+2−3

@@ -109,11 +109,10 @@ import Servant.API.RemoteHost

109import Servant.API.ReqBody

110 (ReqBody, ReqBody')

111import Servant.API.ResponseHeaders

112− (AddHeader, BuildHeadersTo (buildHeadersTo),

112+ (AddHeader, BuildHeadersTo (buildHeadersTo), DynHeaders (..),

113− DynHeaders(..), DynResponse(..), withDynHeaders,

114 GetHeaders (getHeaders), HList (..), Headers (..),

113 GetHeaders (getHeaders), HList (..), Headers (..),

115 ResponseHeader (..), addHeader, getHeadersHList, getResponse,

114 ResponseHeader (..), addHeader, getHeadersHList, getResponse,

116− noHeader)

115+ noHeader, withDynHeaders)

117import Servant.API.Stream

116import Servant.API.Stream

118 (BoundaryStrategy (..), BuildFromStream (..),

117 (BoundaryStrategy (..), BuildFromStream (..),

119 ByteStringParser (..), FramingRender (..),

118 ByteStringParser (..), FramingRender (..),

servant/src/Servant/API/ResponseHeaders.hs+4−7

@@ -36,7 +36,6 @@ module Servant.API.ResponseHeaders

37 , -- * "Dynamic" response headers

38 DynHeaders(..)

39− , DynResponse(..)

40 , withDynHeaders

39 , withDynHeaders

41 ) where

40 ) where

@@ -177,22 +176,20 @@ noHeader = addOptionalHeader MissingHeader

177

176

178-- | Combinator to use when you want your endpoint to return a response

177-- | Combinator to use when you want your endpoint to return a response

179-- along with some response headers, dynamically,

178-- along with some response headers, dynamically,

180−-- by simply building a value of type 'DynResponse a', which is just a

179+-- by simply building a value of type 'DynHeaders a', which is just a

181-- response of type @a@ along with a map from header names to header values.

180-- response of type @a@ along with a map from header names to header values.

182--

181--

183-- For all other interpretations than the server one, this combinator basically

182-- For all other interpretations than the server one, this combinator basically

184-- has no effect and behaves just as if you were using @a@ directly.

183-- has no effect and behaves just as if you were using @a@ directly.

185−data DynHeaders a

184+data DynHeaders a = DynHeaders

186−

187−data DynResponse a = DynResponse

188 { dynResponse :: a

185 { dynResponse :: a

189 , dynHeaders :: Map HTTP.HeaderName ByteString

186 , dynHeaders :: Map HTTP.HeaderName ByteString

190 } deriving (Typeable, Eq, Show, Functor)

187 } deriving (Typeable, Eq, Show, Functor)

191

188

192-- | Build a \"response with headers\", where the headers are

189-- | Build a \"response with headers\", where the headers are

193-- provided at runtime as a 'Map' from header name to header value.

190-- provided at runtime as a 'Map' from header name to header value.

194−withDynHeaders :: a -> Map HTTP.HeaderName ByteString -> DynResponse a

191+withDynHeaders :: a -> Map HTTP.HeaderName ByteString -> DynHeaders a

195−withDynHeaders = DynResponse

192+withDynHeaders = DynHeaders

196

193

197-- $setup

194-- $setup

198-- >>> import Servant.API

195-- >>> import Servant.API