From e7c90849171a5bf32cb635e6bee451dd9ef95386 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Sun, 27 Dec 2015 17:54:29 +0100 Subject: [PATCH] less OverlappingInstances noise --- servant-blaze/include/overlapping-compat.h | 8 ++ servant-blaze/servant-blaze.cabal | 1 + servant-blaze/src/Servant/HTML/Blaze.hs | 16 +--- servant-cassava/include/overlapping-compat.h | 8 ++ servant-cassava/servant-cassava.cabal | 1 + servant-client/include/overlapping-compat.h | 8 ++ servant-client/servant-client.cabal | 1 + servant-client/src/Servant/Client.hs | 80 ++++--------------- servant-client/test/Servant/ClientSpec.hs | 24 ++---- servant-docs/include/overlapping-compat.h | 8 ++ servant-docs/servant-docs.cabal | 1 + servant-docs/src/Servant/Docs/Internal.hs | 50 +++--------- servant-examples/include/overlapping-compat.h | 8 ++ servant-foreign/include/overlapping-compat.h | 8 ++ servant-foreign/servant-foreign.cabal | 1 + servant-jquery/include/overlapping-compat.h | 8 ++ servant-js/include/overlapping-compat.h | 8 ++ servant-js/servant-js.cabal | 1 + servant-lucid/include/overlapping-compat.h | 8 ++ servant-lucid/servant-lucid.cabal | 1 + servant-lucid/src/Servant/HTML/Lucid.hs | 15 +--- servant-mock/include/overlapping-compat.h | 8 ++ servant-mock/servant-mock.cabal | 1 + servant-property/include/overlapping-compat.h | 8 ++ servant-server/include/overlapping-compat.h | 8 ++ servant-server/servant-server.cabal | 2 + servant-server/src/Servant/Server/Internal.hs | 80 ++++--------------- servant-session/include/overlapping-compat.h | 8 ++ servant/include/overlapping-compat.h | 8 ++ servant/servant.cabal | 2 + servant/src/Servant/API/ResponseHeaders.hs | 65 ++++----------- 31 files changed, 197 insertions(+), 257 deletions(-) create mode 100644 servant-blaze/include/overlapping-compat.h create mode 100644 servant-cassava/include/overlapping-compat.h create mode 100644 servant-client/include/overlapping-compat.h create mode 100644 servant-docs/include/overlapping-compat.h create mode 100644 servant-examples/include/overlapping-compat.h create mode 100644 servant-foreign/include/overlapping-compat.h create mode 100644 servant-jquery/include/overlapping-compat.h create mode 100644 servant-js/include/overlapping-compat.h create mode 100644 servant-lucid/include/overlapping-compat.h create mode 100644 servant-mock/include/overlapping-compat.h create mode 100644 servant-property/include/overlapping-compat.h create mode 100644 servant-server/include/overlapping-compat.h create mode 100644 servant-session/include/overlapping-compat.h create mode 100644 servant/include/overlapping-compat.h diff --git a/servant-blaze/include/overlapping-compat.h b/servant-blaze/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-blaze/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-blaze/servant-blaze.cabal b/servant-blaze/servant-blaze.cabal index 08b27e24..a82076f6 100644 --- a/servant-blaze/servant-blaze.cabal +++ b/servant-blaze/servant-blaze.cabal @@ -30,3 +30,4 @@ library , blaze-html hs-source-dirs: src default-language: Haskell2010 + include-dirs: include diff --git a/servant-blaze/src/Servant/HTML/Blaze.hs b/servant-blaze/src/Servant/HTML/Blaze.hs index 7870022d..822a7ae9 100644 --- a/servant-blaze/src/Servant/HTML/Blaze.hs +++ b/servant-blaze/src/Servant/HTML/Blaze.hs @@ -3,10 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif +#include "overlapping-compat.h" -- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s -- `ToMarkup` class and `Html` datatype. -- You should only need to import this module for it's instances and the @@ -29,17 +27,9 @@ data HTML deriving Typeable instance Accept HTML where contentType _ = "text" M.// "html" M./: ("charset", "utf-8") -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif - ToMarkup a => MimeRender HTML a where +instance OVERLAPPABLE_ ToMarkup a => MimeRender HTML a where mimeRender _ = renderHtml . toHtml -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - MimeRender HTML Html where +instance OVERLAPPING_ MimeRender HTML Html where mimeRender _ = renderHtml diff --git a/servant-cassava/include/overlapping-compat.h b/servant-cassava/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-cassava/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-cassava/servant-cassava.cabal b/servant-cassava/servant-cassava.cabal index 4d74612a..db18986c 100644 --- a/servant-cassava/servant-cassava.cabal +++ b/servant-cassava/servant-cassava.cabal @@ -27,3 +27,4 @@ library , vector hs-source-dirs: src default-language: Haskell2010 + include-dirs: include diff --git a/servant-client/include/overlapping-compat.h b/servant-client/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-client/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 7fe69521..1ddf8bf4 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -49,6 +49,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + include-dirs: include test-suite spec type: exitcode-stdio-1.0 diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 987a2bd4..408850ca 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -8,9 +8,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif + +#include "overlapping-compat.h" -- | This module provides 'client' which can automatically generate -- querying functions for each endpoint just from the type representing your -- API. @@ -123,19 +122,13 @@ instance (KnownSymbol capture, ToHttpApiData 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where type Client (Delete cts' a) = ExceptT ServantError IO a clientWithRoute Proxy req baseurl manager = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasClient (Delete cts ()) where type Client (Delete cts ()) = ExceptT ServantError IO () clientWithRoute Proxy req baseurl manager = @@ -143,10 +136,7 @@ instance -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the -- corresponding headers. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts) ) => HasClient (Delete cts' (Headers ls a)) where type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a) @@ -160,19 +150,13 @@ instance -- 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where type Client (Get (ct ': cts) result) = ExceptT ServantError IO result clientWithRoute Proxy req baseurl manager = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasClient (Get (ct ': cts) ()) where type Client (Get (ct ': cts) ()) = ExceptT ServantError IO () clientWithRoute Proxy req baseurl manager = @@ -180,10 +164,7 @@ instance -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the -- corresponding headers. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( MimeUnrender ct a, BuildHeadersTo ls ) => HasClient (Get (ct ': cts) (Headers ls a)) where type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a) @@ -240,19 +221,13 @@ instance (KnownSymbol sym, ToHttpApiData 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where type Client (Post (ct ': cts) a) = ExceptT ServantError IO a clientWithRoute Proxy req baseurl manager = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasClient (Post (ct ': cts) ()) where type Client (Post (ct ': cts) ()) = ExceptT ServantError IO () clientWithRoute Proxy req baseurl manager = @@ -260,10 +235,7 @@ instance -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the -- corresponding headers. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( MimeUnrender ct a, BuildHeadersTo ls ) => HasClient (Post (ct ': cts) (Headers ls a)) where type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a) @@ -277,19 +249,13 @@ instance -- 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where type Client (Put (ct ': cts) a) = ExceptT ServantError IO a clientWithRoute Proxy req baseurl manager = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasClient (Put (ct ': cts) ()) where type Client (Put (ct ': cts) ()) = ExceptT ServantError IO () clientWithRoute Proxy req baseurl manager = @@ -297,10 +263,7 @@ instance -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the -- corresponding headers. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( MimeUnrender ct a, BuildHeadersTo ls ) => HasClient (Put (ct ': cts) (Headers ls a)) where type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a) @@ -314,19 +277,13 @@ instance -- 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a clientWithRoute Proxy req baseurl manager = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasClient (Patch (ct ': cts) ()) where type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO () clientWithRoute Proxy req baseurl manager = @@ -334,10 +291,7 @@ instance -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the -- corresponding headers. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( MimeUnrender ct a, BuildHeadersTo ls ) => HasClient (Patch (ct ': cts) (Headers ls a)) where type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index fc3cdcfb..b1980d1a 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -6,9 +6,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} @@ -20,6 +17,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} +#include "overlapping-compat.h" module Servant.ClientSpec where #if !MIN_VERSION_base(4,8,0) @@ -323,33 +321,21 @@ pathGen = fmap NonEmpty path class GetNth (n :: Nat) a b | n a -> b where getNth :: Proxy n -> a -> b -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ GetNth 0 (x :<|> y) x where getNth _ (x :<|> _) = x -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x class GetLast a b | a -> b where getLast :: a -> b -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ (GetLast b c) => GetLast (a :<|> b) c where getLast (_ :<|> b) = getLast b -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ GetLast a a where getLast a = a diff --git a/servant-docs/include/overlapping-compat.h b/servant-docs/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-docs/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index b88bc612..7bd34a7a 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -49,6 +49,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + include-dirs: include executable greet-docs main-is: greet.hs diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 33cb86a0..c1d26142 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -16,9 +16,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif + +#include "overlapping-compat.h" module Servant.Docs.Internal where import Control.Applicative @@ -661,10 +660,7 @@ markdown api = unlines $ -- | The generated docs for @a ':<|>' b@ just appends the docs -- for @a@ with the docs for @b@. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (HasDocs layout1, HasDocs layout2) => HasDocs (layout1 :<|> layout2) where @@ -692,10 +688,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout) symP = Proxy :: Proxy sym -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLe #-} -#endif +instance OVERLAPPABLE_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Delete cts a) where docsFor Proxy (endpoint, action) DocOptions{..} = @@ -707,10 +700,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Delete cts (Headers ls a)) where @@ -725,10 +715,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLe #-} -#endif +instance OVERLAPPABLE_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Get cts a) where docsFor Proxy (endpoint, action) DocOptions{..} = @@ -740,10 +727,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Get cts (Headers ls a)) where @@ -767,10 +751,7 @@ instance (KnownSymbol sym, HasDocs sublayout) action' = over headers (|> headername) action headername = pack $ symbolVal (Proxy :: Proxy sym) -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Post cts a) where docsFor Proxy (endpoint, action) DocOptions{..} = @@ -783,10 +764,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Post cts (Headers ls a)) where @@ -802,10 +780,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Put cts a) where docsFor Proxy (endpoint, action) DocOptions{..} = @@ -818,10 +793,7 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( ToSample a, IsNonEmpty cts, AllMimeRender cts a, AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Put cts (Headers ls a)) where diff --git a/servant-examples/include/overlapping-compat.h b/servant-examples/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-examples/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-foreign/include/overlapping-compat.h b/servant-foreign/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-foreign/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 0ec296ae..d565b636 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -33,6 +33,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + include-dirs: include test-suite spec diff --git a/servant-jquery/include/overlapping-compat.h b/servant-jquery/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-jquery/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-js/include/overlapping-compat.h b/servant-js/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-js/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-js/servant-js.cabal b/servant-js/servant-js.cabal index 53a74e9d..a47ecd34 100644 --- a/servant-js/servant-js.cabal +++ b/servant-js/servant-js.cabal @@ -49,6 +49,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + include-dirs: include executable counter main-is: counter.hs diff --git a/servant-lucid/include/overlapping-compat.h b/servant-lucid/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-lucid/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-lucid/servant-lucid.cabal b/servant-lucid/servant-lucid.cabal index 77cf3ee1..e4438f42 100644 --- a/servant-lucid/servant-lucid.cabal +++ b/servant-lucid/servant-lucid.cabal @@ -30,3 +30,4 @@ library , servant == 0.5.* hs-source-dirs: src default-language: Haskell2010 + include-dirs: include diff --git a/servant-lucid/src/Servant/HTML/Lucid.hs b/servant-lucid/src/Servant/HTML/Lucid.hs index f222c6ac..ec62a21c 100644 --- a/servant-lucid/src/Servant/HTML/Lucid.hs +++ b/servant-lucid/src/Servant/HTML/Lucid.hs @@ -3,9 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif + +#include "overlapping-compat.h" -- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s -- `ToHtml` class and `Html` datatype. @@ -28,16 +27,10 @@ data HTML deriving Typeable instance Accept HTML where contentType _ = "text" M.// "html" M./: ("charset", "utf-8") -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ToHtml a => MimeRender HTML a where mimeRender _ = renderBS . toHtml -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ MimeRender HTML (Html a) where mimeRender _ = renderBS diff --git a/servant-mock/include/overlapping-compat.h b/servant-mock/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-mock/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-mock/servant-mock.cabal b/servant-mock/servant-mock.cabal index 0bb605db..66f41f22 100644 --- a/servant-mock/servant-mock.cabal +++ b/servant-mock/servant-mock.cabal @@ -34,6 +34,7 @@ library wai >= 3.0 && <3.1 hs-source-dirs: src default-language: Haskell2010 + include-dirs: include executable mock-app main-is: main.hs diff --git a/servant-property/include/overlapping-compat.h b/servant-property/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-property/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-server/include/overlapping-compat.h b/servant-server/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-server/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 7e36387e..a2e1463b 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -69,6 +69,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + include-dirs: include executable greet main-is: greet.hs @@ -134,3 +135,4 @@ test-suite doctests buildable: True default-language: Haskell2010 ghc-options: -threaded + include-dirs: include diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 4200d052..48aed938 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -8,9 +8,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif + +#include "overlapping-compat.h" module Servant.Server.Internal ( module Servant.Server.Internal @@ -206,10 +205,7 @@ methodRouterEmpty method action = LeafRouter route' -- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to -- painlessly error out if the conditions for a successful deletion -- are not met. -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ( AllCTRender ctypes a ) => HasServer (Delete ctypes a) where @@ -217,10 +213,7 @@ instance route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200 -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasServer (Delete ctypes ()) where type ServerT (Delete ctypes ()) m = m () @@ -228,10 +221,7 @@ instance route Proxy = methodRouterEmpty methodDelete -- Add response headers -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( GetHeaders (Headers h v), AllCTRender ctypes v ) => HasServer (Delete ctypes (Headers h v)) where @@ -252,10 +242,7 @@ instance -- (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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ( AllCTRender ctypes a ) => HasServer (Get ctypes a) where type ServerT (Get ctypes a) m = m a @@ -263,10 +250,7 @@ instance route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200 -- '()' ==> 204 No Content -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasServer (Get ctypes ()) where type ServerT (Get ctypes ()) m = m () @@ -274,10 +258,7 @@ instance route Proxy = methodRouterEmpty methodGet -- Add response headers -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( GetHeaders (Headers h v), AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where @@ -329,10 +310,7 @@ instance (KnownSymbol sym, FromHttpApiData 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ( AllCTRender ctypes a ) => HasServer (Post ctypes a) where @@ -340,10 +318,7 @@ instance route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201 -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasServer (Post ctypes ()) where type ServerT (Post ctypes ()) m = m () @@ -351,10 +326,7 @@ instance route Proxy = methodRouterEmpty methodPost -- Add response headers -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( GetHeaders (Headers h v), AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where @@ -375,20 +347,14 @@ instance -- (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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ( AllCTRender ctypes a) => HasServer (Put ctypes a) where type ServerT (Put ctypes a) m = m a route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200 -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasServer (Put ctypes ()) where type ServerT (Put ctypes ()) m = m () @@ -396,10 +362,7 @@ instance route Proxy = methodRouterEmpty methodPut -- Add response headers -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( GetHeaders (Headers h v), AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where @@ -418,20 +381,14 @@ instance -- 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 -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif +instance OVERLAPPABLE_ ( AllCTRender ctypes a) => HasServer (Patch ctypes a) where type ServerT (Patch ctypes a) m = m a route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200 -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ HasServer (Patch ctypes ()) where type ServerT (Patch ctypes ()) m = m () @@ -439,10 +396,7 @@ instance route Proxy = methodRouterEmpty methodPatch -- Add response headers -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif +instance OVERLAPPING_ ( GetHeaders (Headers h v), AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where diff --git a/servant-session/include/overlapping-compat.h b/servant-session/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant-session/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant/include/overlapping-compat.h b/servant/include/overlapping-compat.h new file mode 100644 index 00000000..eef9d4ea --- /dev/null +++ b/servant/include/overlapping-compat.h @@ -0,0 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 710 +#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} +#define OVERLAPPING_ {-# OVERLAPPING #-} +#else +{-# LANGUAGE OverlappingInstances #-} +#define OVERLAPPABLE_ +#define OVERLAPPING_ +#endif diff --git a/servant/servant.cabal b/servant/servant.cabal index f717eab3..99455ab9 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -81,6 +81,7 @@ library , TypeSynonymInstances , UndecidableInstances ghc-options: -Wall + include-dirs: include test-suite spec type: exitcode-stdio-1.0 @@ -118,3 +119,4 @@ test-suite doctests buildable: True default-language: Haskell2010 ghc-options: -threaded + include-dirs: include diff --git a/servant/src/Servant/API/ResponseHeaders.hs b/servant/src/Servant/API/ResponseHeaders.hs index 1fcbd035..dc73a8e0 100644 --- a/servant/src/Servant/API/ResponseHeaders.hs +++ b/servant/src/Servant/API/ResponseHeaders.hs @@ -12,11 +12,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif {-# OPTIONS_HADDOCK not-home #-} +#include "overlapping-compat.h" -- | This module provides facilities for adding headers to a response. -- -- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int @@ -68,19 +66,12 @@ class BuildHeadersTo hs where -- the values are interspersed with commas before deserialization (see -- ) -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - BuildHeadersTo '[] where +instance OVERLAPPING_ BuildHeadersTo '[] where buildHeadersTo _ = HNil -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif - ( FromByteString v, BuildHeadersTo xs, KnownSymbol h, Contains h xs ~ 'False - ) => BuildHeadersTo ((Header h v) ': xs) where +instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h + , Contains h xs ~ 'False) + => BuildHeadersTo ((Header h v) ': xs) where buildHeadersTo headers = let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers @@ -96,38 +87,22 @@ instance class GetHeaders ls where getHeaders :: ls -> [HTTP.Header] -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - GetHeaders (HList '[]) where +instance OVERLAPPING_ GetHeaders (HList '[]) where getHeaders _ = [] -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif - ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) - ) => GetHeaders (HList (Header h x ': xs)) where +instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)) + => GetHeaders (HList (Header h x ': xs)) where getHeaders hdrs = case hdrs of Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest MissingHeader `HCons` rest -> getHeaders rest where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h) -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - GetHeaders (Headers '[] a) where +instance OVERLAPPING_ GetHeaders (Headers '[] a) where getHeaders _ = [] -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif - ( KnownSymbol h, GetHeaders (HList rest), ToByteString v - ) => GetHeaders (Headers (Header h v ': rest) a) where +instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v) + => GetHeaders (Headers (Header h v ': rest) a) where getHeaders hs = getHeaders $ getHeadersHList hs -- * Adding @@ -138,21 +113,13 @@ class AddHeader h v orig new addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False - ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where +instance OVERLAPPING_ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False) + => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads) -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 +instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v + , new ~ (Headers '[Header h v] a)) + => AddHeader h v a new where addHeader a resp = Headers resp (HCons (Header a) HNil) type family Contains x xs where