git.iko.soy/typeable/servant
on master help sign in
less OverlappingInstances noise
commit79d4f944a4f34bb5e80cd460d976373354404195 authorJulian K. Arni <jkarni@gmail.com> dateSun 27 Dec 2015, 17:54 (11 years ago) parent41d5a5d
33 files changed+199−259
compare with master
unifiedsplit
servant-blaze/include/overlapping-compat.h+8 servant-blaze/servant-blaze.cabal+1 servant-blaze/src/Servant/HTML/Blaze.hs+3−13 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+17−63 servant-client/test/Servant/ClientSpec.hs+5−19 servant-docs/include/overlapping-compat.h+8 servant-docs/servant-docs.cabal+1 servant-docs/src/Servant/Docs/Internal.hs+11−39 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+4−11 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+17−63 servant-server/test/Doctests.hs+1−1 servant-session/include/overlapping-compat.h+8 servant/include/overlapping-compat.h+8 servant/servant.cabal+2 servant/src/Servant/API/ResponseHeaders.hs+16−49 servant/test/Doctests.hs+1−1
servant-blaze/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-blaze/servant-blaze.cabal+1
@@ -30,3 +30,4 @@ library
3030 , blaze-html
3131 hs-source-dirs: src
3232 default-language: Haskell2010
33+ include-dirs: include
servant-blaze/src/Servant/HTML/Blaze.hs+3−13
@@ -3,10 +3,8 @@
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE MultiParamTypeClasses #-}
55{-# LANGUAGE OverloadedStrings #-}
6−#if !MIN_VERSION_base(4,8,0)
7−{-# LANGUAGE OverlappingInstances #-}
8−#endif
96
7+#include "overlapping-compat.h"
108-- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s
119-- `ToMarkup` class and `Html` datatype.
1210-- You should only need to import this module for it's instances and the
@@ -29,17 +27,9 @@ data HTML deriving Typeable
2927instance Accept HTML where
3028 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
3129
32−instance
33−#if MIN_VERSION_base(4,8,0)
34− {-# OVERLAPPABLE #-}
35−#endif
36− ToMarkup a => MimeRender HTML a where
30+instance OVERLAPPABLE_ ToMarkup a => MimeRender HTML a where
3731 mimeRender _ = renderHtml . toHtml
3832
39−instance
40−#if MIN_VERSION_base(4,8,0)
41− {-# OVERLAPPING #-}
42−#endif
43− MimeRender HTML Html where
33+instance OVERLAPPING_ MimeRender HTML Html where
4434 mimeRender _ = renderHtml
4535
servant-cassava/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-cassava/servant-cassava.cabal+1
@@ -27,3 +27,4 @@ library
2727 , vector
2828 hs-source-dirs: src
2929 default-language: Haskell2010
30+ include-dirs: include
servant-client/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-client/servant-client.cabal+1
@@ -49,6 +49,7 @@ library
4949 hs-source-dirs: src
5050 default-language: Haskell2010
5151 ghc-options: -Wall
52+ include-dirs: include
5253
5354test-suite spec
5455 type: exitcode-stdio-1.0
servant-client/src/Servant/Client.hs+17−63
@@ -8,9 +8,8 @@
88{-# LANGUAGE TypeFamilies #-}
99{-# LANGUAGE TypeOperators #-}
1010{-# LANGUAGE UndecidableInstances #-}
11−#if !MIN_VERSION_base(4,8,0)
12−{-# LANGUAGE OverlappingInstances #-}
13−#endif
11+
12+#include "overlapping-compat.h"
1413-- | This module provides 'client' which can automatically generate
1514-- querying functions for each endpoint just from the type representing your
1615-- API.
@@ -123,19 +122,13 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
123122-- side querying function that is created when calling 'client'
124123-- will just require an argument that specifies the scheme, host
125124-- and port to send the request to.
126−instance
127−#if MIN_VERSION_base(4,8,0)
128− {-# OVERLAPPABLE #-}
129−#endif
125+instance OVERLAPPABLE_
130126 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
131127 type Client (Delete cts' a) = ExceptT ServantError IO a
132128 clientWithRoute Proxy req baseurl manager =
133129 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager
134130
135−instance
136−#if MIN_VERSION_base(4,8,0)
137− {-# OVERLAPPING #-}
138−#endif
131+instance OVERLAPPING_
139132 HasClient (Delete cts ()) where
140133 type Client (Delete cts ()) = ExceptT ServantError IO ()
141134 clientWithRoute Proxy req baseurl manager =
@@ -143,10 +136,7 @@ instance
143136
144137-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
145138-- corresponding headers.
146−instance
147−#if MIN_VERSION_base(4,8,0)
148− {-# OVERLAPPING #-}
149−#endif
139+instance OVERLAPPING_
150140 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
151141 ) => HasClient (Delete cts' (Headers ls a)) where
152142 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
@@ -160,19 +150,13 @@ instance
160150-- side querying function that is created when calling 'client'
161151-- will just require an argument that specifies the scheme, host
162152-- and port to send the request to.
163−instance
164−#if MIN_VERSION_base(4,8,0)
165− {-# OVERLAPPABLE #-}
166−#endif
153+instance OVERLAPPABLE_
167154 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
168155 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
169156 clientWithRoute Proxy req baseurl manager =
170157 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager
171158
172−instance
173−#if MIN_VERSION_base(4,8,0)
174− {-# OVERLAPPING #-}
175−#endif
159+instance OVERLAPPING_
176160 HasClient (Get (ct ': cts) ()) where
177161 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
178162 clientWithRoute Proxy req baseurl manager =
@@ -180,10 +164,7 @@ instance
180164
181165-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
182166-- corresponding headers.
183−instance
184−#if MIN_VERSION_base(4,8,0)
185− {-# OVERLAPPING #-}
186−#endif
167+instance OVERLAPPING_
187168 ( MimeUnrender ct a, BuildHeadersTo ls
188169 ) => HasClient (Get (ct ': cts) (Headers ls a)) where
189170 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)
240221-- side querying function that is created when calling 'client'
241222-- will just require an argument that specifies the scheme, host
242223-- and port to send the request to.
243−instance
244−#if MIN_VERSION_base(4,8,0)
245− {-# OVERLAPPABLE #-}
246−#endif
224+instance OVERLAPPABLE_
247225 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
248226 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a
249227 clientWithRoute Proxy req baseurl manager =
250228 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager
251229
252−instance
253−#if MIN_VERSION_base(4,8,0)
254− {-# OVERLAPPING #-}
255−#endif
230+instance OVERLAPPING_
256231 HasClient (Post (ct ': cts) ()) where
257232 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
258233 clientWithRoute Proxy req baseurl manager =
@@ -260,10 +235,7 @@ instance
260235
261236-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
262237-- corresponding headers.
263−instance
264−#if MIN_VERSION_base(4,8,0)
265− {-# OVERLAPPING #-}
266−#endif
238+instance OVERLAPPING_
267239 ( MimeUnrender ct a, BuildHeadersTo ls
268240 ) => HasClient (Post (ct ': cts) (Headers ls a)) where
269241 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
@@ -277,19 +249,13 @@ instance
277249-- side querying function that is created when calling 'client'
278250-- will just require an argument that specifies the scheme, host
279251-- and port to send the request to.
280−instance
281−#if MIN_VERSION_base(4,8,0)
282− {-# OVERLAPPABLE #-}
283−#endif
252+instance OVERLAPPABLE_
284253 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
285254 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a
286255 clientWithRoute Proxy req baseurl manager =
287256 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager
288257
289−instance
290−#if MIN_VERSION_base(4,8,0)
291− {-# OVERLAPPING #-}
292−#endif
258+instance OVERLAPPING_
293259 HasClient (Put (ct ': cts) ()) where
294260 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
295261 clientWithRoute Proxy req baseurl manager =
@@ -297,10 +263,7 @@ instance
297263
298264-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
299265-- corresponding headers.
300−instance
301−#if MIN_VERSION_base(4,8,0)
302− {-# OVERLAPPING #-}
303−#endif
266+instance OVERLAPPING_
304267 ( MimeUnrender ct a, BuildHeadersTo ls
305268 ) => HasClient (Put (ct ': cts) (Headers ls a)) where
306269 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
@@ -314,19 +277,13 @@ instance
314277-- side querying function that is created when calling 'client'
315278-- will just require an argument that specifies the scheme, host
316279-- and port to send the request to.
317−instance
318−#if MIN_VERSION_base(4,8,0)
319− {-# OVERLAPPABLE #-}
320−#endif
280+instance OVERLAPPABLE_
321281 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
322282 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a
323283 clientWithRoute Proxy req baseurl manager =
324284 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager
325285
326−instance
327−#if MIN_VERSION_base(4,8,0)
328− {-# OVERLAPPING #-}
329−#endif
286+instance OVERLAPPING_
330287 HasClient (Patch (ct ': cts) ()) where
331288 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
332289 clientWithRoute Proxy req baseurl manager =
@@ -334,10 +291,7 @@ instance
334291
335292-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
336293-- corresponding headers.
337−instance
338−#if MIN_VERSION_base(4,8,0)
339− {-# OVERLAPPING #-}
340−#endif
294+instance OVERLAPPING_
341295 ( MimeUnrender ct a, BuildHeadersTo ls
342296 ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
343297 type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
servant-client/test/Servant/ClientSpec.hs+5−19
@@ -6,9 +6,6 @@
66{-# LANGUAGE FunctionalDependencies #-}
77{-# LANGUAGE GADTs #-}
88{-# LANGUAGE MultiParamTypeClasses #-}
9−#if !MIN_VERSION_base(4,8,0)
10−{-# LANGUAGE OverlappingInstances #-}
11−#endif
129{-# LANGUAGE OverloadedStrings #-}
1310{-# LANGUAGE PolyKinds #-}
1411{-# LANGUAGE RecordWildCards #-}
@@ -20,6 +17,7 @@
2017{-# OPTIONS_GHC -fno-warn-orphans #-}
2118{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
2219
20+#include "overlapping-compat.h"
2321module Servant.ClientSpec where
2422
2523#if !MIN_VERSION_base(4,8,0)
@@ -323,33 +321,21 @@ pathGen = fmap NonEmpty path
323321class GetNth (n :: Nat) a b | n a -> b where
324322 getNth :: Proxy n -> a -> b
325323
326−instance
327−#if MIN_VERSION_base(4,8,0)
328− {-# OVERLAPPING #-}
329−#endif
324+instance OVERLAPPING_
330325 GetNth 0 (x :<|> y) x where
331326 getNth _ (x :<|> _) = x
332327
333−instance
334−#if MIN_VERSION_base(4,8,0)
335− {-# OVERLAPPING #-}
336−#endif
328+instance OVERLAPPING_
337329 (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
338330 getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
339331
340332class GetLast a b | a -> b where
341333 getLast :: a -> b
342334
343−instance
344−#if MIN_VERSION_base(4,8,0)
345− {-# OVERLAPPING #-}
346−#endif
335+instance OVERLAPPING_
347336 (GetLast b c) => GetLast (a :<|> b) c where
348337 getLast (_ :<|> b) = getLast b
349338
350−instance
351−#if MIN_VERSION_base(4,8,0)
352− {-# OVERLAPPING #-}
353−#endif
339+instance OVERLAPPING_
354340 GetLast a a where
355341 getLast a = a
servant-docs/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-docs/servant-docs.cabal+1
@@ -49,6 +49,7 @@ library
4949 hs-source-dirs: src
5050 default-language: Haskell2010
5151 ghc-options: -Wall
52+ include-dirs: include
5253
5354executable greet-docs
5455 main-is: greet.hs
servant-docs/src/Servant/Docs/Internal.hs+11−39
@@ -16,9 +16,8 @@
1616{-# LANGUAGE TypeFamilies #-}
1717{-# LANGUAGE TypeOperators #-}
1818{-# LANGUAGE UndecidableInstances #-}
19−#if !MIN_VERSION_base(4,8,0)
20−{-# LANGUAGE OverlappingInstances #-}
21−#endif
19+
20+#include "overlapping-compat.h"
2221module Servant.Docs.Internal where
2322
2423import Control.Applicative
@@ -661,10 +660,7 @@ markdown api = unlines $
661660
662661-- | The generated docs for @a ':<|>' b@ just appends the docs
663662-- for @a@ with the docs for @b@.
664−instance
665−#if MIN_VERSION_base(4,8,0)
666− {-# OVERLAPPABLE #-}
667−#endif
663+instance OVERLAPPABLE_
668664 (HasDocs layout1, HasDocs layout2)
669665 => HasDocs (layout1 :<|> layout2) where
670666
@@ -692,10 +688,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
692688 symP = Proxy :: Proxy sym
693689
694690
695−instance
696−#if MIN_VERSION_base(4,8,0)
697− {-# OVERLAPPABLe #-}
698−#endif
691+instance OVERLAPPABLE_
699692 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
700693 => HasDocs (Delete cts a) where
701694 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -707,10 +700,7 @@ instance
707700 t = Proxy :: Proxy cts
708701 p = Proxy :: Proxy a
709702
710−instance
711−#if MIN_VERSION_base(4,8,0)
712− {-# OVERLAPPING #-}
713−#endif
703+instance OVERLAPPING_
714704 (ToSample a, IsNonEmpty cts, AllMimeRender cts a
715705 , AllHeaderSamples ls , GetHeaders (HList ls) )
716706 => HasDocs (Delete cts (Headers ls a)) where
@@ -725,10 +715,7 @@ instance
725715 t = Proxy :: Proxy cts
726716 p = Proxy :: Proxy a
727717
728−instance
729−#if MIN_VERSION_base(4,8,0)
730− {-# OVERLAPPABLe #-}
731−#endif
718+instance OVERLAPPABLE_
732719 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
733720 => HasDocs (Get cts a) where
734721 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -740,10 +727,7 @@ instance
740727 t = Proxy :: Proxy cts
741728 p = Proxy :: Proxy a
742729
743−instance
744−#if MIN_VERSION_base(4,8,0)
745− {-# OVERLAPPING #-}
746−#endif
730+instance OVERLAPPING_
747731 (ToSample a, IsNonEmpty cts, AllMimeRender cts a
748732 , AllHeaderSamples ls , GetHeaders (HList ls) )
749733 => HasDocs (Get cts (Headers ls a)) where
@@ -767,10 +751,7 @@ instance (KnownSymbol sym, HasDocs sublayout)
767751 action' = over headers (|> headername) action
768752 headername = pack $ symbolVal (Proxy :: Proxy sym)
769753
770−instance
771−#if MIN_VERSION_base(4,8,0)
772− {-# OVERLAPPABLE #-}
773−#endif
754+instance OVERLAPPABLE_
774755 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
775756 => HasDocs (Post cts a) where
776757 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -783,10 +764,7 @@ instance
783764 t = Proxy :: Proxy cts
784765 p = Proxy :: Proxy a
785766
786−instance
787−#if MIN_VERSION_base(4,8,0)
788− {-# OVERLAPPING #-}
789−#endif
767+instance OVERLAPPING_
790768 (ToSample a, IsNonEmpty cts, AllMimeRender cts a
791769 , AllHeaderSamples ls , GetHeaders (HList ls) )
792770 => HasDocs (Post cts (Headers ls a)) where
@@ -802,10 +780,7 @@ instance
802780 t = Proxy :: Proxy cts
803781 p = Proxy :: Proxy a
804782
805−instance
806−#if MIN_VERSION_base(4,8,0)
807− {-# OVERLAPPABLE #-}
808−#endif
783+instance OVERLAPPABLE_
809784 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
810785 => HasDocs (Put cts a) where
811786 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -818,10 +793,7 @@ instance
818793 t = Proxy :: Proxy cts
819794 p = Proxy :: Proxy a
820795
821−instance
822−#if MIN_VERSION_base(4,8,0)
823− {-# OVERLAPPING #-}
824−#endif
796+instance OVERLAPPING_
825797 ( ToSample a, IsNonEmpty cts, AllMimeRender cts a,
826798 AllHeaderSamples ls , GetHeaders (HList ls) )
827799 => HasDocs (Put cts (Headers ls a)) where
servant-examples/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-foreign/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-foreign/servant-foreign.cabal+1
@@ -33,6 +33,7 @@ library
3333 hs-source-dirs: src
3434 default-language: Haskell2010
3535 ghc-options: -Wall
36+ include-dirs: include
3637
3738
3839test-suite spec
servant-jquery/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-js/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-js/servant-js.cabal+1
@@ -49,6 +49,7 @@ library
4949 hs-source-dirs: src
5050 default-language: Haskell2010
5151 ghc-options: -Wall
52+ include-dirs: include
5253
5354executable counter
5455 main-is: counter.hs
servant-lucid/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-lucid/servant-lucid.cabal+1
@@ -30,3 +30,4 @@ library
3030 , servant == 0.5.*
3131 hs-source-dirs: src
3232 default-language: Haskell2010
33+ include-dirs: include
servant-lucid/src/Servant/HTML/Lucid.hs+4−11
@@ -3,9 +3,8 @@
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE MultiParamTypeClasses #-}
55{-# LANGUAGE OverloadedStrings #-}
6−#if !MIN_VERSION_base(4,8,0)
7−{-# LANGUAGE OverlappingInstances #-}
8−#endif
6+
7+#include "overlapping-compat.h"
98
109-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s
1110-- `ToHtml` class and `Html` datatype.
@@ -28,16 +27,10 @@ data HTML deriving Typeable
2827instance Accept HTML where
2928 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
3029
31−instance
32−#if MIN_VERSION_base(4,8,0)
33− {-# OVERLAPPABLE #-}
34−#endif
30+instance OVERLAPPABLE_
3531 ToHtml a => MimeRender HTML a where
3632 mimeRender _ = renderBS . toHtml
3733
38−instance
39−#if MIN_VERSION_base(4,8,0)
40− {-# OVERLAPPING #-}
41−#endif
34+instance OVERLAPPING_
4235 MimeRender HTML (Html a) where
4336 mimeRender _ = renderBS
servant-mock/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-mock/servant-mock.cabal+1
@@ -34,6 +34,7 @@ library
3434 wai >= 3.0 && <3.3
3535 hs-source-dirs: src
3636 default-language: Haskell2010
37+ include-dirs: include
3738
3839executable mock-app
3940 main-is: main.hs
servant-property/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-server/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-server/servant-server.cabal+2
@@ -69,6 +69,7 @@ library
6969 hs-source-dirs: src
7070 default-language: Haskell2010
7171 ghc-options: -Wall
72+ include-dirs: include
7273
7374executable greet
7475 main-is: greet.hs
@@ -134,3 +135,4 @@ test-suite doctests
134135 buildable: True
135136 default-language: Haskell2010
136137 ghc-options: -threaded
138+ include-dirs: include
servant-server/src/Servant/Server/Internal.hs+17−63
@@ -8,9 +8,8 @@
88{-# LANGUAGE ScopedTypeVariables #-}
99{-# LANGUAGE TypeFamilies #-}
1010{-# LANGUAGE TypeOperators #-}
11−#if !MIN_VERSION_base(4,8,0)
12−{-# LANGUAGE OverlappingInstances #-}
13−#endif
11+
12+#include "overlapping-compat.h"
1413
1514module Servant.Server.Internal
1615 ( module Servant.Server.Internal
@@ -206,10 +205,7 @@ methodRouterEmpty method action = LeafRouter route'
206205-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to
207206-- painlessly error out if the conditions for a successful deletion
208207-- are not met.
209−instance
210−#if MIN_VERSION_base(4,8,0)
211− {-# OVERLAPPABLE #-}
212−#endif
208+instance OVERLAPPABLE_
213209 ( AllCTRender ctypes a
214210 ) => HasServer (Delete ctypes a) where
215211
@@ -217,10 +213,7 @@ instance
217213
218214 route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200
219215
220−instance
221−#if MIN_VERSION_base(4,8,0)
222− {-# OVERLAPPING #-}
223−#endif
216+instance OVERLAPPING_
224217 HasServer (Delete ctypes ()) where
225218
226219 type ServerT (Delete ctypes ()) m = m ()
@@ -228,10 +221,7 @@ instance
228221 route Proxy = methodRouterEmpty methodDelete
229222
230223-- Add response headers
231−instance
232−#if MIN_VERSION_base(4,8,0)
233− {-# OVERLAPPING #-}
234−#endif
224+instance OVERLAPPING_
235225 ( GetHeaders (Headers h v), AllCTRender ctypes v
236226 ) => HasServer (Delete ctypes (Headers h v)) where
237227
@@ -252,10 +242,7 @@ instance
252242-- (returning a status code of 200). If there was no @Accept@ header or it
253243-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
254244-- list.
255−instance
256−#if MIN_VERSION_base(4,8,0)
257− {-# OVERLAPPABLE #-}
258−#endif
245+instance OVERLAPPABLE_
259246 ( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
260247
261248 type ServerT (Get ctypes a) m = m a
@@ -263,10 +250,7 @@ instance
263250 route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200
264251
265252-- '()' ==> 204 No Content
266−instance
267−#if MIN_VERSION_base(4,8,0)
268− {-# OVERLAPPING #-}
269−#endif
253+instance OVERLAPPING_
270254 HasServer (Get ctypes ()) where
271255
272256 type ServerT (Get ctypes ()) m = m ()
@@ -274,10 +258,7 @@ instance
274258 route Proxy = methodRouterEmpty methodGet
275259
276260-- Add response headers
277−instance
278−#if MIN_VERSION_base(4,8,0)
279− {-# OVERLAPPING #-}
280−#endif
261+instance OVERLAPPING_
281262 ( GetHeaders (Headers h v), AllCTRender ctypes v
282263 ) => HasServer (Get ctypes (Headers h v)) where
283264
@@ -329,10 +310,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
329310-- (returning a status code of 201). If there was no @Accept@ header or it
330311-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
331312-- list.
332−instance
333−#if MIN_VERSION_base(4,8,0)
334− {-# OVERLAPPABLE #-}
335−#endif
313+instance OVERLAPPABLE_
336314 ( AllCTRender ctypes a
337315 ) => HasServer (Post ctypes a) where
338316
@@ -340,10 +318,7 @@ instance
340318
341319 route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201
342320
343−instance
344−#if MIN_VERSION_base(4,8,0)
345− {-# OVERLAPPING #-}
346−#endif
321+instance OVERLAPPING_
347322 HasServer (Post ctypes ()) where
348323
349324 type ServerT (Post ctypes ()) m = m ()
@@ -351,10 +326,7 @@ instance
351326 route Proxy = methodRouterEmpty methodPost
352327
353328-- Add response headers
354−instance
355−#if MIN_VERSION_base(4,8,0)
356− {-# OVERLAPPING #-}
357−#endif
329+instance OVERLAPPING_
358330 ( GetHeaders (Headers h v), AllCTRender ctypes v
359331 ) => HasServer (Post ctypes (Headers h v)) where
360332
@@ -375,20 +347,14 @@ instance
375347-- (returning a status code of 200). If there was no @Accept@ header or it
376348-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
377349-- list.
378−instance
379−#if MIN_VERSION_base(4,8,0)
380− {-# OVERLAPPABLE #-}
381−#endif
350+instance OVERLAPPABLE_
382351 ( AllCTRender ctypes a) => HasServer (Put ctypes a) where
383352
384353 type ServerT (Put ctypes a) m = m a
385354
386355 route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200
387356
388−instance
389−#if MIN_VERSION_base(4,8,0)
390− {-# OVERLAPPING #-}
391−#endif
357+instance OVERLAPPING_
392358 HasServer (Put ctypes ()) where
393359
394360 type ServerT (Put ctypes ()) m = m ()
@@ -396,10 +362,7 @@ instance
396362 route Proxy = methodRouterEmpty methodPut
397363
398364-- Add response headers
399−instance
400−#if MIN_VERSION_base(4,8,0)
401− {-# OVERLAPPING #-}
402−#endif
365+instance OVERLAPPING_
403366 ( GetHeaders (Headers h v), AllCTRender ctypes v
404367 ) => HasServer (Put ctypes (Headers h v)) where
405368
@@ -418,20 +381,14 @@ instance
418381-- If successfully returning a value, we just require that its type has
419382-- a 'ToJSON' instance and servant takes care of encoding it for you,
420383-- yielding status code 200 along the way.
421−instance
422−#if MIN_VERSION_base(4,8,0)
423− {-# OVERLAPPABLE #-}
424−#endif
384+instance OVERLAPPABLE_
425385 ( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
426386
427387 type ServerT (Patch ctypes a) m = m a
428388
429389 route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200
430390
431−instance
432−#if MIN_VERSION_base(4,8,0)
433− {-# OVERLAPPING #-}
434−#endif
391+instance OVERLAPPING_
435392 HasServer (Patch ctypes ()) where
436393
437394 type ServerT (Patch ctypes ()) m = m ()
@@ -439,10 +396,7 @@ instance
439396 route Proxy = methodRouterEmpty methodPatch
440397
441398-- Add response headers
442−instance
443−#if MIN_VERSION_base(4,8,0)
444− {-# OVERLAPPING #-}
445−#endif
399+instance OVERLAPPING_
446400 ( GetHeaders (Headers h v), AllCTRender ctypes v
447401 ) => HasServer (Patch ctypes (Headers h v)) where
448402
servant-server/test/Doctests.hs+1−1
@@ -10,7 +10,7 @@ main :: IO ()
1010main = do
1111 files <- find always (extension ==? ".hs") "src"
1212 mCabalMacrosFile <- getCabalMacrosFile
13− doctest $ "-isrc" :
13+ doctest $ "-isrc" : "-Iinclude" :
1414 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
1515 "-XOverloadedStrings" :
1616 "-XFlexibleInstances" :
servant-session/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant/servant.cabal+2
@@ -81,6 +81,7 @@ library
8181 , TypeSynonymInstances
8282 , UndecidableInstances
8383 ghc-options: -Wall
84+ include-dirs: include
8485
8586test-suite spec
8687 type: exitcode-stdio-1.0
@@ -118,3 +119,4 @@ test-suite doctests
118119 buildable: True
119120 default-language: Haskell2010
120121 ghc-options: -threaded
122+ include-dirs: include
servant/src/Servant/API/ResponseHeaders.hs+16−49
@@ -12,11 +12,9 @@
1212{-# LANGUAGE TypeFamilies #-}
1313{-# LANGUAGE TypeOperators #-}
1414{-# LANGUAGE UndecidableInstances #-}
15−#if !MIN_VERSION_base(4,8,0)
16−{-# LANGUAGE OverlappingInstances #-}
17−#endif
1815{-# OPTIONS_HADDOCK not-home #-}
1916
17+#include "overlapping-compat.h"
2018-- | This module provides facilities for adding headers to a response.
2119--
2220-- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int
@@ -68,19 +66,12 @@ class BuildHeadersTo hs where
6866 -- the values are interspersed with commas before deserialization (see
6967 -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>)
7068
71−instance
72−#if MIN_VERSION_base(4,8,0)
73− {-# OVERLAPPING #-}
74−#endif
75− BuildHeadersTo '[] where
69+instance OVERLAPPING_ BuildHeadersTo '[] where
7670 buildHeadersTo _ = HNil
7771
78−instance
79−#if MIN_VERSION_base(4,8,0)
80− {-# OVERLAPPABLE #-}
81−#endif
82− ( FromByteString v, BuildHeadersTo xs, KnownSymbol h, Contains h xs ~ 'False
83− ) => BuildHeadersTo ((Header h v) ': xs) where
72+instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h
73+ , Contains h xs ~ 'False)
74+ => BuildHeadersTo ((Header h v) ': xs) where
8475 buildHeadersTo headers =
8576 let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
8677 matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
@@ -96,38 +87,22 @@ instance
9687class GetHeaders ls where
9788 getHeaders :: ls -> [HTTP.Header]
9889
99−instance
100−#if MIN_VERSION_base(4,8,0)
101− {-# OVERLAPPING #-}
102−#endif
103− GetHeaders (HList '[]) where
90+instance OVERLAPPING_ GetHeaders (HList '[]) where
10491 getHeaders _ = []
10592
106−instance
107−#if MIN_VERSION_base(4,8,0)
108− {-# OVERLAPPABLE #-}
109−#endif
110− ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)
111− ) => GetHeaders (HList (Header h x ': xs)) where
93+instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs))
94+ => GetHeaders (HList (Header h x ': xs)) where
11295 getHeaders hdrs = case hdrs of
11396 Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest
11497 UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest
11598 MissingHeader `HCons` rest -> getHeaders rest
11699 where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
117100
118−instance
119−#if MIN_VERSION_base(4,8,0)
120− {-# OVERLAPPING #-}
121−#endif
122− GetHeaders (Headers '[] a) where
101+instance OVERLAPPING_ GetHeaders (Headers '[] a) where
123102 getHeaders _ = []
124103
125−instance
126−#if MIN_VERSION_base(4,8,0)
127− {-# OVERLAPPABLE #-}
128−#endif
129− ( KnownSymbol h, GetHeaders (HList rest), ToByteString v
130− ) => GetHeaders (Headers (Header h v ': rest) a) where
104+instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v)
105+ => GetHeaders (Headers (Header h v ': rest) a) where
131106 getHeaders hs = getHeaders $ getHeadersHList hs
132107
133108-- * Adding
@@ -138,21 +113,13 @@ class AddHeader h v orig new
138113 addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
139114
140115
141−instance
142−#if MIN_VERSION_base(4,8,0)
143− {-# OVERLAPPING #-}
144−#endif
145− ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False
146− ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
116+instance OVERLAPPING_ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False)
117+ => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
147118 addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
148119
149−instance
150−#if MIN_VERSION_base(4,8,0)
151− {-# OVERLAPPABLE #-}
152−#endif
153− ( KnownSymbol h, ToByteString v
154− , new ~ (Headers '[Header h v] a)
155− ) => AddHeader h v a new where
120+instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v
121+ , new ~ (Headers '[Header h v] a))
122+ => AddHeader h v a new where
156123 addHeader a resp = Headers resp (HCons (Header a) HNil)
157124
158125type family Contains x xs where
servant/test/Doctests.hs+1−1
@@ -11,7 +11,7 @@ main = do
1111 files <- find always (extension ==? ".hs") "src"
1212 tfiles <- find always (extension ==? ".hs") "test/Servant"
1313 mCabalMacrosFile <- getCabalMacrosFile
14− doctest $ "-isrc" :
14+ doctest $ "-isrc" : "-Iinclude" :
1515 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
1616 "-XOverloadedStrings" :
1717 "-XFlexibleInstances" :