Browse Source

7.10 changes

tags/v0.4
Julian K. Arni 7 years ago
parent
commit
f82ca76f7d
  1. 16
      .travis.yml
  2. 17
      scripts/shell.nix
  3. 13
      scripts/test-all.sh
  4. 97
      servant-client/src/Servant/Client.hs
  5. 5
      servant-client/src/Servant/Common/Req.hs
  6. 2
      servant-client/test/Servant/ClientSpec.hs
  7. 3
      servant-client/test/Servant/Common/BaseUrlSpec.hs
  8. 3
      servant-docs/src/Servant/Docs/Internal.hs
  9. 19
      servant-jquery/src/Servant/JQuery/Internal.hs
  10. 97
      servant-server/src/Servant/Server/Internal.hs
  11. 3
      servant/servant.cabal
  12. 3
      servant/src/Servant/API/Alternative.hs
  13. 3
      servant/src/Servant/API/ContentTypes.hs
  14. 17
      servant/src/Servant/API/ResponseHeaders.hs
  15. 9
      servant/src/Servant/Common/Text.hs
  16. 22
      servant/src/Servant/Utils/Links.hs
  17. 3
      servant/test/Servant/API/ContentTypesSpec.hs
  18. 7
      servant/test/Servant/Common/TextSpec.hs

16
.travis.yml

@ -1,11 +1,19 @@
language: haskell
ghc:
- 7.8
env:
- CABALVER=1.18 GHCVER=7.8.4
- CABALVER=1.22 GHCVER=7.10.1
before_install:
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
- travis_retry sudo apt-get update
- travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- travis_retry cabal update
install:
- ghc --version
- cabal --version
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- cabal --version
script:
- ./scripts/test-all.sh

17
scripts/shell.nix

@ -2,12 +2,17 @@
# Also a good way of running the tests for all packages
with (import <nixpkgs> {}).pkgs;
let modifiedHaskellPackages = haskellngPackages.override {
overrides = self: super: {
servant = self.callPackage ../servant {};
servant-server = self.callPackage ../servant-server {};
servant-client = self.callPackage ../servant-client {};
servant-jquery = self.callPackage ../servant-jquery {};
servant-docs = self.callPackage ../servant-docs {};
overrides = with haskell-ng.lib ; self: super: {
servant = appendConfigureFlag ( self.callPackage ../servant {} )
"--ghc-options=-Werror";
servant-server = appendConfigureFlag (self.callPackage
../servant-server {}) "--ghc-options=-Werror";
servant-client = appendConfigureFlag (self.callPackage
../servant-client {}) "--ghc-options=-Werror";
servant-jquery = appendConfigureFlag (self.callPackage
../servant-jquery {}) "--ghc-options=-Werror";
servant-docs = appendConfigureFlag (self.callPackage ../servant-docs
{}) "--ghc-options=-Werror";
};
};
in modifiedHaskellPackages.ghcWithPackages ( p : with p ; [

13
scripts/test-all.sh

@ -17,15 +17,16 @@ set -o errexit
DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )
GHC_FLAGS="-Werror"
SOURCES_TXT="$( dirname $DIR)/sources.txt"
CABAL=${CABAL:-cabal}
declare -a SOURCES
readarray -t SOURCES < "$SOURCES_TXT"
prepare_sandbox () {
cabal sandbox init
$CABAL sandbox init
for s in ${SOURCES[@]} ; do
(cd "$s" && cabal sandbox init --sandbox=../ && cabal sandbox add-source .)
(cd "$s" && $CABAL sandbox init --sandbox=../ && $CABAL sandbox add-source .)
done
}
@ -33,10 +34,10 @@ test_each () {
for s in ${SOURCES[@]} ; do
echo "Testing $s..."
cd "$s"
cabal install --only-dependencies --enable-tests
cabal configure --enable-tests --ghc-options="$GHC_FLAGS"
cabal build
cabal test
$CABAL install --only-dependencies --enable-tests
$CABAL configure --enable-tests --ghc-options="$GHC_FLAGS"
$CABAL build
$CABAL test
cd ..
done
}

97
servant-client/src/Servant/Client.hs

@ -1,12 +1,15 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
#endif
-- | This module provides 'client' which can automatically generate
-- querying functions for each endpoint just from the type representing your
-- API.
@ -18,21 +21,21 @@ module Servant.Client
, module Servant.Common.BaseUrl
) where
import Control.Monad
import Control.Monad.Trans.Either
import Data.ByteString.Lazy (ByteString)
import Data.List
import Data.Proxy
import Data.String.Conversions
import Data.Text (unpack)
import GHC.TypeLits
import Network.HTTP.Client (Response)
import Network.HTTP.Media
import qualified Network.HTTP.Types as H
import Servant.API
import Servant.API.ContentTypes
import Servant.Common.BaseUrl
import Servant.Common.Req
import Control.Monad
import Control.Monad.Trans.Either
import Data.ByteString.Lazy (ByteString)
import Data.List
import Data.Proxy
import Data.String.Conversions
import Data.Text (unpack)
import GHC.TypeLits
import Network.HTTP.Client (Response)
import Network.HTTP.Media
import qualified Network.HTTP.Types as H
import Servant.API
import Servant.API.ContentTypes
import Servant.Common.BaseUrl
import Servant.Common.Req
-- * Accessing APIs as a Client
@ -123,14 +126,22 @@ instance HasClient Delete where
-- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host
-- and port to send the request to.
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host
-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Get (ct ': cts) ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Get (ct ': cts) ()) where
type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
performRequestNoBody H.methodGet req [204] host
@ -176,7 +187,11 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host
-- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req uri =
@ -184,7 +199,11 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Post (ct ': cts) ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Post (ct ': cts) ()) where
type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPost req [204] host
@ -193,7 +212,11 @@ instance HasClient (Post (ct ': cts) ()) where
-- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host
-- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host =
@ -201,7 +224,11 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Put (ct ': cts) ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Put (ct ': cts) ()) where
type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPut req [204] host
@ -210,7 +237,11 @@ instance HasClient (Put (ct ': cts) ()) where
-- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host
-- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host =
@ -218,7 +249,11 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Patch (ct ': cts) ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Patch (ct ': cts) ()) where
type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPatch req [204] host

5
servant-client/src/Servant/Common/Req.hs

@ -1,8 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Servant.Common.Req where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Exception
import Control.Monad
import Control.Monad.Catch (MonadThrow)

2
servant-client/test/Servant/ClientSpec.hs

@ -340,6 +340,6 @@ pathGen :: Gen (NonEmptyList Char)
pathGen = fmap NonEmpty path
where
path = listOf1 $ elements $
filter (not . (`elem` "?%[]/#;")) $
filter (not . (`elem` ("?%[]/#;" :: String))) $
filter isPrint $
map chr [0..127]

3
servant-client/test/Servant/Common/BaseUrlSpec.hs

@ -1,7 +1,10 @@
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Common.BaseUrlSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.DeepSeq
import Test.Hspec
import Test.QuickCheck

3
servant-docs/src/Servant/Docs/Internal.hs

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
@ -13,7 +14,9 @@
{-# LANGUAGE UndecidableInstances #-}
module Servant.Docs.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Lens
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Hashable

19
servant-jquery/src/Servant/JQuery/Internal.hs

@ -1,15 +1,18 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.JQuery.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Lens
import Data.Char (toLower)
import qualified Data.CharSet as Set

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

@ -1,12 +1,15 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
module Servant.Server.Internal where
import Control.Applicative ((<$>))
@ -280,8 +283,11 @@ instance HasServer Delete where
-- (returning a status code of 200). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the
-- list.
instance ( AllCTRender ctypes a
) => HasServer (Get ctypes a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
type ServerT' (Get ctypes a) m = m a
@ -302,8 +308,14 @@ instance ( AllCTRender ctypes a
| otherwise = respond $ failWith NotFound
-- '()' ==> 204 No Content
instance HasServer (Get ctypes ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Get ctypes ()) where
type ServerT' (Get ctypes ()) m = m ()
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodGet = do
e <- runEitherT action
@ -316,8 +328,14 @@ instance HasServer (Get ctypes ()) where
| otherwise = respond $ failWith NotFound
-- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where
type ServerT' (Get ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodGet = do
e <- runEitherT action
@ -380,7 +398,11 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- (returning a status code of 201). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the
-- list.
instance ( AllCTRender ctypes a
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a
) => HasServer (Post ctypes a) where
type ServerT' (Post ctypes a) m = m a
@ -401,8 +423,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound
instance HasServer (Post ctypes ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Post ctypes ()) where
type ServerT' (Post ctypes ()) m = m ()
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPost = do
e <- runEitherT action
@ -415,8 +443,14 @@ instance HasServer (Post ctypes ()) where
| otherwise = respond $ failWith NotFound
-- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
type ServerT' (Post ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPost = do
e <- runEitherT action
@ -447,8 +481,11 @@ instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
-- (returning a status code of 200). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the
-- list.
instance ( AllCTRender ctypes a
) => HasServer (Put ctypes a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a) => HasServer (Put ctypes a) where
type ServerT' (Put ctypes a) m = m a
@ -468,8 +505,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound
instance HasServer (Put ctypes ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Put ctypes ()) where
type ServerT' (Put ctypes ()) m = m ()
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPut = do
e <- runEitherT action
@ -482,8 +525,14 @@ instance HasServer (Put ctypes ()) where
| otherwise = respond $ failWith NotFound
-- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
type ServerT' (Put ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPut = do
e <- runEitherT action
@ -512,8 +561,12 @@ instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
-- If successfully returning a value, we just require that its type has
-- a 'ToJSON' instance and servant takes care of encoding it for you,
-- yielding status code 200 along the way.
instance ( AllCTRender ctypes a
) => HasServer (Patch ctypes a) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
type ServerT' (Patch ctypes a) m = m a
route Proxy action request respond
@ -532,8 +585,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound
instance HasServer (Patch ctypes ()) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Patch ctypes ()) where
type ServerT' (Patch ctypes ()) m = m ()
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPatch = do
e <- runEitherT action
@ -546,8 +605,14 @@ instance HasServer (Patch ctypes ()) where
| otherwise = respond $ failWith NotFound
-- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where
type ServerT' (Patch ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPatch = do
e <- runEitherT action

3
servant/servant.cabal

@ -59,7 +59,8 @@ library
, network-uri >= 2.6
hs-source-dirs: src
default-language: Haskell2010
other-extensions: ConstraintKinds
other-extensions: CPP
, ConstraintKinds
, DataKinds
, DeriveDataTypeable
, FlexibleInstances

3
servant/src/Servant/API/Alternative.hs

@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeOperators #-}
module Servant.API.Alternative ((:<|>)(..)) where
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif
import Data.Typeable (Typeable)
-- | Union of two APIs, first takes precedence in case of overlap.
--

3
servant/src/Servant/API/ContentTypes.hs

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
@ -63,7 +64,9 @@ module Servant.API.ContentTypes
, eitherDecodeLenient
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*))
#endif
import Control.Arrow (left)
import Control.Monad
import Data.Aeson (FromJSON, ToJSON, Value,

17
servant/src/Servant/API/ResponseHeaders.hs

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
@ -6,11 +7,13 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
-- | This module provides facilities for adding headers to a response.
--
@ -50,13 +53,21 @@ class AddHeader h v orig new
| h v orig -> new, new -> h, new -> v, new -> orig where
addHeader :: v -> orig -> new
instance ( KnownSymbol h, ToByteString v
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( KnownSymbol h, ToByteString v
) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
addHeader a (Headers resp heads) = Headers resp ((headerName, toByteString' a) : heads)
where
headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
instance ( KnownSymbol h, ToByteString v
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( KnownSymbol h, ToByteString v
, new ~ (Headers '[Header h v] a)
) => AddHeader h v a new where
addHeader a resp = Headers resp [(headerName, toByteString' a)]

9
servant/src/Servant/Common/Text.hs

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
@ -6,12 +7,18 @@ module Servant.Common.Text
, ToText(..)
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Data.Int (Int16, Int32, Int64, Int8)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text.Read (Reader, decimal, rational, signed)
import Data.Word (Word, Word16, Word32, Word64, Word8)
import Data.Word (Word16, Word32, Word64, Word8
#if !MIN_VERSION_base(4,8,0)
, Word
#endif
)
-- | For getting values from url captures and query string parameters
-- Instances should obey:

22
servant/src/Servant/Utils/Links.hs

@ -1,13 +1,13 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Type safe generation of internal links.
--
@ -104,7 +104,11 @@ module Servant.Utils.Links (
import Data.List
import Data.Proxy ( Proxy(..) )
import Data.Text (Text, unpack)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid ( Monoid(..), (<>) )
#else
import Data.Monoid ( (<>) )
#endif
import Network.URI ( URI(..), escapeURIString, isUnreserved )
import GHC.TypeLits ( KnownSymbol, symbolVal )
import GHC.Exts(Constraint)

3
servant/test/Servant/API/ContentTypesSpec.hs

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@ -5,7 +6,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.API.ContentTypesSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Arrow
import Data.Aeson
import Data.Aeson.Parser (jstring)

7
servant/test/Servant/Common/TextSpec.hs

@ -1,8 +1,13 @@
{-# LANGUAGE CPP #-}
module Servant.Common.TextSpec where
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Text (Text)
import Data.Word (Word, Word16, Word32, Word64, Word8)
import Data.Word (Word16, Word32, Word64, Word8
#if !MIN_VERSION_base(4,8,0)
, Word
#endif
)
import Servant.Common.Text
import Test.Hspec
import Test.QuickCheck

Loading…
Cancel
Save