From f82ca76f7d301c8752662baeb09fbc73ed3ff3a2 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Mon, 20 Apr 2015 19:52:29 +0200 Subject: [PATCH] 7.10 changes --- .travis.yml | 16 ++- scripts/shell.nix | 17 ++-- scripts/test-all.sh | 13 +-- servant-client/src/Servant/Client.hs | 97 +++++++++++++------ servant-client/src/Servant/Common/Req.hs | 5 +- servant-client/test/Servant/ClientSpec.hs | 2 +- .../test/Servant/Common/BaseUrlSpec.hs | 3 + servant-docs/src/Servant/Docs/Internal.hs | 3 + servant-jquery/src/Servant/JQuery/Internal.hs | 19 ++-- servant-server/src/Servant/Server/Internal.hs | 97 ++++++++++++++++--- servant/servant.cabal | 3 +- servant/src/Servant/API/Alternative.hs | 3 + servant/src/Servant/API/ContentTypes.hs | 3 + servant/src/Servant/API/ResponseHeaders.hs | 17 +++- servant/src/Servant/Common/Text.hs | 9 +- servant/src/Servant/Utils/Links.hs | 22 +++-- servant/test/Servant/API/ContentTypesSpec.hs | 3 + servant/test/Servant/Common/TextSpec.hs | 7 +- 18 files changed, 251 insertions(+), 88 deletions(-) diff --git a/.travis.yml b/.travis.yml index a961f380..1f0629f8 100644 --- a/.travis.yml +++ b/.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 diff --git a/scripts/shell.nix b/scripts/shell.nix index cbce6750..ba9e0cb9 100644 --- a/scripts/shell.nix +++ b/scripts/shell.nix @@ -2,12 +2,17 @@ # Also a good way of running the tests for all packages with (import {}).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 ; [ diff --git a/scripts/test-all.sh b/scripts/test-all.sh index 5d4f7945..61eef116 100755 --- a/scripts/test-all.sh +++ b/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 } diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index c50b5471..8a187b0a 100644 --- a/servant-client/src/Servant/Client.hs +++ b/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 diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 60c53eb8..12dd88d9 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/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) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index ff043ab1..469f2f50 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/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] diff --git a/servant-client/test/Servant/Common/BaseUrlSpec.hs b/servant-client/test/Servant/Common/BaseUrlSpec.hs index 5eef61dc..2a1ea751 100644 --- a/servant-client/test/Servant/Common/BaseUrlSpec.hs +++ b/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 diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 408e1cdb..4422f710 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/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 diff --git a/servant-jquery/src/Servant/JQuery/Internal.hs b/servant-jquery/src/Servant/JQuery/Internal.hs index b5bca7cb..7cfb6b89 100644 --- a/servant-jquery/src/Servant/JQuery/Internal.hs +++ b/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 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 6c509fe8..30805668 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/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 diff --git a/servant/servant.cabal b/servant/servant.cabal index ce86bcf8..d5c42042 100644 --- a/servant/servant.cabal +++ b/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 diff --git a/servant/src/Servant/API/Alternative.hs b/servant/src/Servant/API/Alternative.hs index 9483f174..03d9dcc0 100644 --- a/servant/src/Servant/API/Alternative.hs +++ b/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. -- diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs index da40228c..45b7391c 100644 --- a/servant/src/Servant/API/ContentTypes.hs +++ b/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, diff --git a/servant/src/Servant/API/ResponseHeaders.hs b/servant/src/Servant/API/ResponseHeaders.hs index 807a7f25..3503dd46 100644 --- a/servant/src/Servant/API/ResponseHeaders.hs +++ b/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)] diff --git a/servant/src/Servant/Common/Text.hs b/servant/src/Servant/Common/Text.hs index f8c4e26e..6e4a4690 100644 --- a/servant/src/Servant/Common/Text.hs +++ b/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: diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index be79d1cc..6d8d7f93 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/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) diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs index 8bfd92a2..272bde85 100644 --- a/servant/test/Servant/API/ContentTypesSpec.hs +++ b/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) diff --git a/servant/test/Servant/Common/TextSpec.hs b/servant/test/Servant/Common/TextSpec.hs index 7612d12c..144cd405 100644 --- a/servant/test/Servant/Common/TextSpec.hs +++ b/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