79d4f94 · typeable/servant

servant-blaze/include/overlapping-compat.hnew file+8

compare with master

unifiedsplit

@@ -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

30 , blaze-html

31 hs-source-dirs: src

32 default-language: Haskell2010

33+ include-dirs: include

servant-blaze/src/Servant/HTML/Blaze.hs+3−13

@@ -3,10 +3,8 @@

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE OverloadedStrings #-}

6−#if !MIN_VERSION_base(4,8,0)

7−{-# LANGUAGE OverlappingInstances #-}

8−#endif

9

6

7+#include "overlapping-compat.h"

10-- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s

8-- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s

11-- `ToMarkup` class and `Html` datatype.

9-- `ToMarkup` class and `Html` datatype.

12-- You should only need to import this module for it's instances and the

10-- You should only need to import this module for it's instances and the

@@ -29,17 +27,9 @@ data HTML deriving Typeable

29instance Accept HTML where

27instance Accept HTML where

30 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")

28 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")

31

29

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

37 mimeRender _ = renderHtml . toHtml

31 mimeRender _ = renderHtml . toHtml

38

32

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

44 mimeRender _ = renderHtml

34 mimeRender _ = renderHtml

45

35

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

27 , vector

28 hs-source-dirs: src

29 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

49 hs-source-dirs: src

50 default-language: Haskell2010

51 ghc-options: -Wall

52+ include-dirs: include

52

53

53test-suite spec

54test-suite spec

54 type: exitcode-stdio-1.0

55 type: exitcode-stdio-1.0

servant-client/src/Servant/Client.hs+17−63

@@ -8,9 +8,8 @@

8{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE UndecidableInstances #-}

11−#if !MIN_VERSION_base(4,8,0)

11+

12−{-# LANGUAGE OverlappingInstances #-}

12+#include "overlapping-compat.h"

13−#endif

14-- | This module provides 'client' which can automatically generate

13-- | This module provides 'client' which can automatically generate

15-- querying functions for each endpoint just from the type representing your

14-- querying functions for each endpoint just from the type representing your

16-- API.

15-- API.

@@ -123,19 +122,13 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)

123-- side querying function that is created when calling 'client'

122-- side querying function that is created when calling 'client'

124-- will just require an argument that specifies the scheme, host

123-- will just require an argument that specifies the scheme, host

125-- and port to send the request to.

124-- and port to send the request to.

126−instance

125+instance OVERLAPPABLE_

127−#if MIN_VERSION_base(4,8,0)

128− {-# OVERLAPPABLE #-}

129−#endif

130 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where

126 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where

131 type Client (Delete cts' a) = ExceptT ServantError IO a

127 type Client (Delete cts' a) = ExceptT ServantError IO a

132 clientWithRoute Proxy req baseurl manager =

128 clientWithRoute Proxy req baseurl manager =

133 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager

129 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager

134

130

135−instance

131+instance OVERLAPPING_

136−#if MIN_VERSION_base(4,8,0)

137− {-# OVERLAPPING #-}

138−#endif

139 HasClient (Delete cts ()) where

132 HasClient (Delete cts ()) where

140 type Client (Delete cts ()) = ExceptT ServantError IO ()

133 type Client (Delete cts ()) = ExceptT ServantError IO ()

141 clientWithRoute Proxy req baseurl manager =

134 clientWithRoute Proxy req baseurl manager =

@@ -143,10 +136,7 @@ instance

143

136

144-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the

137-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the

145-- corresponding headers.

138-- corresponding headers.

146−instance

139+instance OVERLAPPING_

147−#if MIN_VERSION_base(4,8,0)

148− {-# OVERLAPPING #-}

149−#endif

150 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

140 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

151 ) => HasClient (Delete cts' (Headers ls a)) where

141 ) => HasClient (Delete cts' (Headers ls a)) where

152 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

142 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

@@ -160,19 +150,13 @@ instance

160-- side querying function that is created when calling 'client'

150-- side querying function that is created when calling 'client'

161-- will just require an argument that specifies the scheme, host

151-- will just require an argument that specifies the scheme, host

162-- and port to send the request to.

152-- and port to send the request to.

163−instance

153+instance OVERLAPPABLE_

164−#if MIN_VERSION_base(4,8,0)

165− {-# OVERLAPPABLE #-}

166−#endif

167 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

154 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

168 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result

155 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result

169 clientWithRoute Proxy req baseurl manager =

156 clientWithRoute Proxy req baseurl manager =

170 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager

157 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager

171

158

172−instance

159+instance OVERLAPPING_

173−#if MIN_VERSION_base(4,8,0)

174− {-# OVERLAPPING #-}

175−#endif

176 HasClient (Get (ct ': cts) ()) where

160 HasClient (Get (ct ': cts) ()) where

177 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()

161 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()

178 clientWithRoute Proxy req baseurl manager =

162 clientWithRoute Proxy req baseurl manager =

@@ -180,10 +164,7 @@ instance

180

164

181-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the

165-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the

182-- corresponding headers.

166-- corresponding headers.

183−instance

167+instance OVERLAPPING_

184−#if MIN_VERSION_base(4,8,0)

185− {-# OVERLAPPING #-}

186−#endif

187 ( MimeUnrender ct a, BuildHeadersTo ls

168 ( MimeUnrender ct a, BuildHeadersTo ls

188 ) => HasClient (Get (ct ': cts) (Headers ls a)) where

169 ) => HasClient (Get (ct ': cts) (Headers ls a)) where

189 type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

170 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)

240-- side querying function that is created when calling 'client'

221-- side querying function that is created when calling 'client'

241-- will just require an argument that specifies the scheme, host

222-- will just require an argument that specifies the scheme, host

242-- and port to send the request to.

223-- and port to send the request to.

243−instance

224+instance OVERLAPPABLE_

244−#if MIN_VERSION_base(4,8,0)

245− {-# OVERLAPPABLE #-}

246−#endif

247 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

225 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

248 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a

226 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a

249 clientWithRoute Proxy req baseurl manager =

227 clientWithRoute Proxy req baseurl manager =

250 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager

228 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager

251

229

252−instance

230+instance OVERLAPPING_

253−#if MIN_VERSION_base(4,8,0)

254− {-# OVERLAPPING #-}

255−#endif

256 HasClient (Post (ct ': cts) ()) where

231 HasClient (Post (ct ': cts) ()) where

257 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()

232 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()

258 clientWithRoute Proxy req baseurl manager =

233 clientWithRoute Proxy req baseurl manager =

@@ -260,10 +235,7 @@ instance

260

235

261-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the

236-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the

262-- corresponding headers.

237-- corresponding headers.

263−instance

238+instance OVERLAPPING_

264−#if MIN_VERSION_base(4,8,0)

265− {-# OVERLAPPING #-}

266−#endif

267 ( MimeUnrender ct a, BuildHeadersTo ls

239 ( MimeUnrender ct a, BuildHeadersTo ls

268 ) => HasClient (Post (ct ': cts) (Headers ls a)) where

240 ) => HasClient (Post (ct ': cts) (Headers ls a)) where

269 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

241 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

@@ -277,19 +249,13 @@ instance

277-- side querying function that is created when calling 'client'

249-- side querying function that is created when calling 'client'

278-- will just require an argument that specifies the scheme, host

250-- will just require an argument that specifies the scheme, host

279-- and port to send the request to.

251-- and port to send the request to.

280−instance

252+instance OVERLAPPABLE_

281−#if MIN_VERSION_base(4,8,0)

282− {-# OVERLAPPABLE #-}

283−#endif

284 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

253 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

285 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a

254 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a

286 clientWithRoute Proxy req baseurl manager =

255 clientWithRoute Proxy req baseurl manager =

287 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager

256 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager

288

257

289−instance

258+instance OVERLAPPING_

290−#if MIN_VERSION_base(4,8,0)

291− {-# OVERLAPPING #-}

292−#endif

293 HasClient (Put (ct ': cts) ()) where

259 HasClient (Put (ct ': cts) ()) where

294 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()

260 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()

295 clientWithRoute Proxy req baseurl manager =

261 clientWithRoute Proxy req baseurl manager =

@@ -297,10 +263,7 @@ instance

297

263

298-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the

264-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the

299-- corresponding headers.

265-- corresponding headers.

300−instance

266+instance OVERLAPPING_

301−#if MIN_VERSION_base(4,8,0)

302− {-# OVERLAPPING #-}

303−#endif

304 ( MimeUnrender ct a, BuildHeadersTo ls

267 ( MimeUnrender ct a, BuildHeadersTo ls

305 ) => HasClient (Put (ct ': cts) (Headers ls a)) where

268 ) => HasClient (Put (ct ': cts) (Headers ls a)) where

306 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

269 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

@@ -314,19 +277,13 @@ instance

314-- side querying function that is created when calling 'client'

277-- side querying function that is created when calling 'client'

315-- will just require an argument that specifies the scheme, host

278-- will just require an argument that specifies the scheme, host

316-- and port to send the request to.

279-- and port to send the request to.

317−instance

280+instance OVERLAPPABLE_

318−#if MIN_VERSION_base(4,8,0)

319− {-# OVERLAPPABLE #-}

320−#endif

321 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

281 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

322 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a

282 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a

323 clientWithRoute Proxy req baseurl manager =

283 clientWithRoute Proxy req baseurl manager =

324 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager

284 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager

325

285

326−instance

286+instance OVERLAPPING_

327−#if MIN_VERSION_base(4,8,0)

328− {-# OVERLAPPING #-}

329−#endif

330 HasClient (Patch (ct ': cts) ()) where

287 HasClient (Patch (ct ': cts) ()) where

331 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()

288 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()

332 clientWithRoute Proxy req baseurl manager =

289 clientWithRoute Proxy req baseurl manager =

@@ -334,10 +291,7 @@ instance

334

291

335-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the

292-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the

336-- corresponding headers.

293-- corresponding headers.

337−instance

294+instance OVERLAPPING_

338−#if MIN_VERSION_base(4,8,0)

339− {-# OVERLAPPING #-}

340−#endif

341 ( MimeUnrender ct a, BuildHeadersTo ls

295 ( MimeUnrender ct a, BuildHeadersTo ls

342 ) => HasClient (Patch (ct ': cts) (Headers ls a)) where

296 ) => HasClient (Patch (ct ': cts) (Headers ls a)) where

343 type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

297 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 @@

6{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE GADTs #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

9−#if !MIN_VERSION_base(4,8,0)

10−{-# LANGUAGE OverlappingInstances #-}

11−#endif

12{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE OverloadedStrings #-}

13{-# LANGUAGE PolyKinds #-}

10{-# LANGUAGE PolyKinds #-}

14{-# LANGUAGE RecordWildCards #-}

11{-# LANGUAGE RecordWildCards #-}

@@ -20,6 +17,7 @@

20{-# OPTIONS_GHC -fno-warn-orphans #-}

17{-# OPTIONS_GHC -fno-warn-orphans #-}

21{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

18{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

22

19

20+#include "overlapping-compat.h"

23module Servant.ClientSpec where

21module Servant.ClientSpec where

24

22

25#if !MIN_VERSION_base(4,8,0)

23#if !MIN_VERSION_base(4,8,0)

@@ -323,33 +321,21 @@ pathGen = fmap NonEmpty path

323class GetNth (n :: Nat) a b | n a -> b where

321class GetNth (n :: Nat) a b | n a -> b where

324 getNth :: Proxy n -> a -> b

322 getNth :: Proxy n -> a -> b

325

323

326−instance

324+instance OVERLAPPING_

327−#if MIN_VERSION_base(4,8,0)

328− {-# OVERLAPPING #-}

329−#endif

330 GetNth 0 (x :<|> y) x where

325 GetNth 0 (x :<|> y) x where

331 getNth _ (x :<|> _) = x

326 getNth _ (x :<|> _) = x

332

327

333−instance

328+instance OVERLAPPING_

334−#if MIN_VERSION_base(4,8,0)

335− {-# OVERLAPPING #-}

336−#endif

337 (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where

329 (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where

338 getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x

330 getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x

339

331

340class GetLast a b | a -> b where

332class GetLast a b | a -> b where

341 getLast :: a -> b

333 getLast :: a -> b

342

334

343−instance

335+instance OVERLAPPING_

344−#if MIN_VERSION_base(4,8,0)

345− {-# OVERLAPPING #-}

346−#endif

347 (GetLast b c) => GetLast (a :<|> b) c where

336 (GetLast b c) => GetLast (a :<|> b) c where

348 getLast (_ :<|> b) = getLast b

337 getLast (_ :<|> b) = getLast b

349

338

350−instance

339+instance OVERLAPPING_

351−#if MIN_VERSION_base(4,8,0)

352− {-# OVERLAPPING #-}

353−#endif

354 GetLast a a where

340 GetLast a a where

355 getLast a = a

341 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

49 hs-source-dirs: src

50 default-language: Haskell2010

51 ghc-options: -Wall

52+ include-dirs: include

52

53

53executable greet-docs

54executable greet-docs

54 main-is: greet.hs

55 main-is: greet.hs

servant-docs/src/Servant/Docs/Internal.hs+11−39

@@ -16,9 +16,8 @@

16{-# LANGUAGE TypeFamilies #-}

17{-# LANGUAGE TypeOperators #-}

18{-# LANGUAGE UndecidableInstances #-}

19−#if !MIN_VERSION_base(4,8,0)

19+

20−{-# LANGUAGE OverlappingInstances #-}

20+#include "overlapping-compat.h"

21−#endif

22module Servant.Docs.Internal where

21module Servant.Docs.Internal where

23

22

24import Control.Applicative

23import Control.Applicative

@@ -661,10 +660,7 @@ markdown api = unlines $

661

660

662-- | The generated docs for @a ':<|>' b@ just appends the docs

661-- | The generated docs for @a ':<|>' b@ just appends the docs

663-- for @a@ with the docs for @b@.

662-- for @a@ with the docs for @b@.

664−instance

663+instance OVERLAPPABLE_

665−#if MIN_VERSION_base(4,8,0)

666− {-# OVERLAPPABLE #-}

667−#endif

668 (HasDocs layout1, HasDocs layout2)

664 (HasDocs layout1, HasDocs layout2)

669 => HasDocs (layout1 :<|> layout2) where

665 => HasDocs (layout1 :<|> layout2) where

670

666

@@ -692,10 +688,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)

692 symP = Proxy :: Proxy sym

688 symP = Proxy :: Proxy sym

693

689

694

690

695−instance

691+instance OVERLAPPABLE_

696−#if MIN_VERSION_base(4,8,0)

697− {-# OVERLAPPABLe #-}

698−#endif

699 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

692 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

700 => HasDocs (Delete cts a) where

693 => HasDocs (Delete cts a) where

701 docsFor Proxy (endpoint, action) DocOptions{..} =

694 docsFor Proxy (endpoint, action) DocOptions{..} =

@@ -707,10 +700,7 @@ instance

707 t = Proxy :: Proxy cts

700 t = Proxy :: Proxy cts

708 p = Proxy :: Proxy a

701 p = Proxy :: Proxy a

709

702

710−instance

703+instance OVERLAPPING_

711−#if MIN_VERSION_base(4,8,0)

712− {-# OVERLAPPING #-}

713−#endif

714 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

704 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

715 , AllHeaderSamples ls , GetHeaders (HList ls) )

705 , AllHeaderSamples ls , GetHeaders (HList ls) )

716 => HasDocs (Delete cts (Headers ls a)) where

706 => HasDocs (Delete cts (Headers ls a)) where

@@ -725,10 +715,7 @@ instance

725 t = Proxy :: Proxy cts

715 t = Proxy :: Proxy cts

726 p = Proxy :: Proxy a

716 p = Proxy :: Proxy a

727

717

728−instance

718+instance OVERLAPPABLE_

729−#if MIN_VERSION_base(4,8,0)

730− {-# OVERLAPPABLe #-}

731−#endif

732 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

719 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

733 => HasDocs (Get cts a) where

720 => HasDocs (Get cts a) where

734 docsFor Proxy (endpoint, action) DocOptions{..} =

721 docsFor Proxy (endpoint, action) DocOptions{..} =

@@ -740,10 +727,7 @@ instance

740 t = Proxy :: Proxy cts

727 t = Proxy :: Proxy cts

741 p = Proxy :: Proxy a

728 p = Proxy :: Proxy a

742

729

743−instance

730+instance OVERLAPPING_

744−#if MIN_VERSION_base(4,8,0)

745− {-# OVERLAPPING #-}

746−#endif

747 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

731 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

748 , AllHeaderSamples ls , GetHeaders (HList ls) )

732 , AllHeaderSamples ls , GetHeaders (HList ls) )

749 => HasDocs (Get cts (Headers ls a)) where

733 => HasDocs (Get cts (Headers ls a)) where

@@ -767,10 +751,7 @@ instance (KnownSymbol sym, HasDocs sublayout)

767 action' = over headers (|> headername) action

751 action' = over headers (|> headername) action

768 headername = pack $ symbolVal (Proxy :: Proxy sym)

752 headername = pack $ symbolVal (Proxy :: Proxy sym)

769

753

770−instance

754+instance OVERLAPPABLE_

771−#if MIN_VERSION_base(4,8,0)

772− {-# OVERLAPPABLE #-}

773−#endif

774 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

755 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

775 => HasDocs (Post cts a) where

756 => HasDocs (Post cts a) where

776 docsFor Proxy (endpoint, action) DocOptions{..} =

757 docsFor Proxy (endpoint, action) DocOptions{..} =

@@ -783,10 +764,7 @@ instance

783 t = Proxy :: Proxy cts

764 t = Proxy :: Proxy cts

784 p = Proxy :: Proxy a

765 p = Proxy :: Proxy a

785

766

786−instance

767+instance OVERLAPPING_

787−#if MIN_VERSION_base(4,8,0)

788− {-# OVERLAPPING #-}

789−#endif

790 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

768 (ToSample a, IsNonEmpty cts, AllMimeRender cts a

791 , AllHeaderSamples ls , GetHeaders (HList ls) )

769 , AllHeaderSamples ls , GetHeaders (HList ls) )

792 => HasDocs (Post cts (Headers ls a)) where

770 => HasDocs (Post cts (Headers ls a)) where

@@ -802,10 +780,7 @@ instance

802 t = Proxy :: Proxy cts

780 t = Proxy :: Proxy cts

803 p = Proxy :: Proxy a

781 p = Proxy :: Proxy a

804

782

805−instance

783+instance OVERLAPPABLE_

806−#if MIN_VERSION_base(4,8,0)

807− {-# OVERLAPPABLE #-}

808−#endif

809 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

784 (ToSample a, IsNonEmpty cts, AllMimeRender cts a)

810 => HasDocs (Put cts a) where

785 => HasDocs (Put cts a) where

811 docsFor Proxy (endpoint, action) DocOptions{..} =

786 docsFor Proxy (endpoint, action) DocOptions{..} =

@@ -818,10 +793,7 @@ instance

818 t = Proxy :: Proxy cts

793 t = Proxy :: Proxy cts

819 p = Proxy :: Proxy a

794 p = Proxy :: Proxy a

820

795

821−instance

796+instance OVERLAPPING_

822−#if MIN_VERSION_base(4,8,0)

823− {-# OVERLAPPING #-}

824−#endif

825 ( ToSample a, IsNonEmpty cts, AllMimeRender cts a,

797 ( ToSample a, IsNonEmpty cts, AllMimeRender cts a,

826 AllHeaderSamples ls , GetHeaders (HList ls) )

798 AllHeaderSamples ls , GetHeaders (HList ls) )

827 => HasDocs (Put cts (Headers ls a)) where

799 => 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

33 hs-source-dirs: src

34 default-language: Haskell2010

35 ghc-options: -Wall

36+ include-dirs: include

36

37

38

38test-suite spec

39test-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

49 hs-source-dirs: src

50 default-language: Haskell2010

51 ghc-options: -Wall

52+ include-dirs: include

52

53

53executable counter

54executable counter

54 main-is: counter.hs

55 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

30 , servant == 0.5.*

31 hs-source-dirs: src

32 default-language: Haskell2010

33+ include-dirs: include

servant-lucid/src/Servant/HTML/Lucid.hs+4−11

@@ -3,9 +3,8 @@

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE OverloadedStrings #-}

6−#if !MIN_VERSION_base(4,8,0)

6+

7−{-# LANGUAGE OverlappingInstances #-}

7+#include "overlapping-compat.h"

8−#endif

9

8

10-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s

9-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s

11-- `ToHtml` class and `Html` datatype.

10-- `ToHtml` class and `Html` datatype.

@@ -28,16 +27,10 @@ data HTML deriving Typeable

28instance Accept HTML where

27instance Accept HTML where

29 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")

28 contentType _ = "text" M.// "html" M./: ("charset", "utf-8")

30

29

31−instance

30+instance OVERLAPPABLE_

32−#if MIN_VERSION_base(4,8,0)

33− {-# OVERLAPPABLE #-}

34−#endif

35 ToHtml a => MimeRender HTML a where

31 ToHtml a => MimeRender HTML a where

36 mimeRender _ = renderBS . toHtml

32 mimeRender _ = renderBS . toHtml

37

33

38−instance

34+instance OVERLAPPING_

39−#if MIN_VERSION_base(4,8,0)

40− {-# OVERLAPPING #-}

41−#endif

42 MimeRender HTML (Html a) where

35 MimeRender HTML (Html a) where

43 mimeRender _ = renderBS

36 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

34 wai >= 3.0 && <3.3

35 hs-source-dirs: src

36 default-language: Haskell2010

37+ include-dirs: include

37

38

38executable mock-app

39executable mock-app

39 main-is: main.hs

40 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

69 hs-source-dirs: src

70 default-language: Haskell2010

71 ghc-options: -Wall

72+ include-dirs: include

72

73

73executable greet

74executable greet

74 main-is: greet.hs

75 main-is: greet.hs

@@ -134,3 +135,4 @@ test-suite doctests

134 buildable: True

135 buildable: True

135 default-language: Haskell2010

136 default-language: Haskell2010

136 ghc-options: -threaded

137 ghc-options: -threaded

138+ include-dirs: include

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

@@ -8,9 +8,8 @@

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE TypeOperators #-}

11−#if !MIN_VERSION_base(4,8,0)

11+

12−{-# LANGUAGE OverlappingInstances #-}

12+#include "overlapping-compat.h"

13−#endif

14

13

15module Servant.Server.Internal

14module Servant.Server.Internal

16 ( module Servant.Server.Internal

15 ( module Servant.Server.Internal

@@ -206,10 +205,7 @@ methodRouterEmpty method action = LeafRouter route'

206-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to

205-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to

207-- painlessly error out if the conditions for a successful deletion

206-- painlessly error out if the conditions for a successful deletion

208-- are not met.

207-- are not met.

209−instance

208+instance OVERLAPPABLE_

210−#if MIN_VERSION_base(4,8,0)

211− {-# OVERLAPPABLE #-}

212−#endif

213 ( AllCTRender ctypes a

209 ( AllCTRender ctypes a

214 ) => HasServer (Delete ctypes a) where

210 ) => HasServer (Delete ctypes a) where

215

211

@@ -217,10 +213,7 @@ instance

217

213

218 route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200

214 route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200

219

215

220−instance

216+instance OVERLAPPING_

221−#if MIN_VERSION_base(4,8,0)

222− {-# OVERLAPPING #-}

223−#endif

224 HasServer (Delete ctypes ()) where

217 HasServer (Delete ctypes ()) where

225

218

226 type ServerT (Delete ctypes ()) m = m ()

219 type ServerT (Delete ctypes ()) m = m ()

@@ -228,10 +221,7 @@ instance

228 route Proxy = methodRouterEmpty methodDelete

221 route Proxy = methodRouterEmpty methodDelete

229

222

230-- Add response headers

223-- Add response headers

231−instance

224+instance OVERLAPPING_

232−#if MIN_VERSION_base(4,8,0)

233− {-# OVERLAPPING #-}

234−#endif

235 ( GetHeaders (Headers h v), AllCTRender ctypes v

225 ( GetHeaders (Headers h v), AllCTRender ctypes v

236 ) => HasServer (Delete ctypes (Headers h v)) where

226 ) => HasServer (Delete ctypes (Headers h v)) where

237

227

@@ -252,10 +242,7 @@ instance

252-- (returning a status code of 200). If there was no @Accept@ header or it

242-- (returning a status code of 200). If there was no @Accept@ header or it

253-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

243-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

254-- list.

244-- list.

255−instance

245+instance OVERLAPPABLE_

256−#if MIN_VERSION_base(4,8,0)

257− {-# OVERLAPPABLE #-}

258−#endif

259 ( AllCTRender ctypes a ) => HasServer (Get ctypes a) where

246 ( AllCTRender ctypes a ) => HasServer (Get ctypes a) where

260

247

261 type ServerT (Get ctypes a) m = m a

248 type ServerT (Get ctypes a) m = m a

@@ -263,10 +250,7 @@ instance

263 route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200

250 route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200

264

251

265-- '()' ==> 204 No Content

252-- '()' ==> 204 No Content

266−instance

253+instance OVERLAPPING_

267−#if MIN_VERSION_base(4,8,0)

268− {-# OVERLAPPING #-}

269−#endif

270 HasServer (Get ctypes ()) where

254 HasServer (Get ctypes ()) where

271

255

272 type ServerT (Get ctypes ()) m = m ()

256 type ServerT (Get ctypes ()) m = m ()

@@ -274,10 +258,7 @@ instance

274 route Proxy = methodRouterEmpty methodGet

258 route Proxy = methodRouterEmpty methodGet

275

259

276-- Add response headers

260-- Add response headers

277−instance

261+instance OVERLAPPING_

278−#if MIN_VERSION_base(4,8,0)

279− {-# OVERLAPPING #-}

280−#endif

281 ( GetHeaders (Headers h v), AllCTRender ctypes v

262 ( GetHeaders (Headers h v), AllCTRender ctypes v

282 ) => HasServer (Get ctypes (Headers h v)) where

263 ) => HasServer (Get ctypes (Headers h v)) where

283

264

@@ -329,10 +310,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)

329-- (returning a status code of 201). If there was no @Accept@ header or it

310-- (returning a status code of 201). If there was no @Accept@ header or it

330-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

311-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

331-- list.

312-- list.

332−instance

313+instance OVERLAPPABLE_

333−#if MIN_VERSION_base(4,8,0)

334− {-# OVERLAPPABLE #-}

335−#endif

336 ( AllCTRender ctypes a

314 ( AllCTRender ctypes a

337 ) => HasServer (Post ctypes a) where

315 ) => HasServer (Post ctypes a) where

338

316

@@ -340,10 +318,7 @@ instance

340

318

341 route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201

319 route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201

342

320

343−instance

321+instance OVERLAPPING_

344−#if MIN_VERSION_base(4,8,0)

345− {-# OVERLAPPING #-}

346−#endif

347 HasServer (Post ctypes ()) where

322 HasServer (Post ctypes ()) where

348

323

349 type ServerT (Post ctypes ()) m = m ()

324 type ServerT (Post ctypes ()) m = m ()

@@ -351,10 +326,7 @@ instance

351 route Proxy = methodRouterEmpty methodPost

326 route Proxy = methodRouterEmpty methodPost

352

327

353-- Add response headers

328-- Add response headers

354−instance

329+instance OVERLAPPING_

355−#if MIN_VERSION_base(4,8,0)

356− {-# OVERLAPPING #-}

357−#endif

358 ( GetHeaders (Headers h v), AllCTRender ctypes v

330 ( GetHeaders (Headers h v), AllCTRender ctypes v

359 ) => HasServer (Post ctypes (Headers h v)) where

331 ) => HasServer (Post ctypes (Headers h v)) where

360

332

@@ -375,20 +347,14 @@ instance

375-- (returning a status code of 200). If there was no @Accept@ header or it

347-- (returning a status code of 200). If there was no @Accept@ header or it

376-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

348-- was @*\/\*@, we return encode using the first @Content-Type@ type on the

377-- list.

349-- list.

378−instance

350+instance OVERLAPPABLE_

379−#if MIN_VERSION_base(4,8,0)

380− {-# OVERLAPPABLE #-}

381−#endif

382 ( AllCTRender ctypes a) => HasServer (Put ctypes a) where

351 ( AllCTRender ctypes a) => HasServer (Put ctypes a) where

383

352

384 type ServerT (Put ctypes a) m = m a

353 type ServerT (Put ctypes a) m = m a

385

354

386 route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200

355 route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200

387

356

388−instance

357+instance OVERLAPPING_

389−#if MIN_VERSION_base(4,8,0)

390− {-# OVERLAPPING #-}

391−#endif

392 HasServer (Put ctypes ()) where

358 HasServer (Put ctypes ()) where

393

359

394 type ServerT (Put ctypes ()) m = m ()

360 type ServerT (Put ctypes ()) m = m ()

@@ -396,10 +362,7 @@ instance

396 route Proxy = methodRouterEmpty methodPut

362 route Proxy = methodRouterEmpty methodPut

397

363

398-- Add response headers

364-- Add response headers

399−instance

365+instance OVERLAPPING_

400−#if MIN_VERSION_base(4,8,0)

401− {-# OVERLAPPING #-}

402−#endif

403 ( GetHeaders (Headers h v), AllCTRender ctypes v

366 ( GetHeaders (Headers h v), AllCTRender ctypes v

404 ) => HasServer (Put ctypes (Headers h v)) where

367 ) => HasServer (Put ctypes (Headers h v)) where

405

368

@@ -418,20 +381,14 @@ instance

418-- If successfully returning a value, we just require that its type has

381-- If successfully returning a value, we just require that its type has

419-- a 'ToJSON' instance and servant takes care of encoding it for you,

382-- a 'ToJSON' instance and servant takes care of encoding it for you,

420-- yielding status code 200 along the way.

383-- yielding status code 200 along the way.

421−instance

384+instance OVERLAPPABLE_

422−#if MIN_VERSION_base(4,8,0)

423− {-# OVERLAPPABLE #-}

424−#endif

425 ( AllCTRender ctypes a) => HasServer (Patch ctypes a) where

385 ( AllCTRender ctypes a) => HasServer (Patch ctypes a) where

426

386

427 type ServerT (Patch ctypes a) m = m a

387 type ServerT (Patch ctypes a) m = m a

428

388

429 route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200

389 route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200

430

390

431−instance

391+instance OVERLAPPING_

432−#if MIN_VERSION_base(4,8,0)

433− {-# OVERLAPPING #-}

434−#endif

435 HasServer (Patch ctypes ()) where

392 HasServer (Patch ctypes ()) where

436

393

437 type ServerT (Patch ctypes ()) m = m ()

394 type ServerT (Patch ctypes ()) m = m ()

@@ -439,10 +396,7 @@ instance

439 route Proxy = methodRouterEmpty methodPatch

396 route Proxy = methodRouterEmpty methodPatch

440

397

441-- Add response headers

398-- Add response headers

442−instance

399+instance OVERLAPPING_

443−#if MIN_VERSION_base(4,8,0)

444− {-# OVERLAPPING #-}

445−#endif

446 ( GetHeaders (Headers h v), AllCTRender ctypes v

400 ( GetHeaders (Headers h v), AllCTRender ctypes v

447 ) => HasServer (Patch ctypes (Headers h v)) where

401 ) => HasServer (Patch ctypes (Headers h v)) where

448

402

servant-server/test/Doctests.hs+1−1

@@ -10,7 +10,7 @@ main :: IO ()

10main = do

11 files <- find always (extension ==? ".hs") "src"

12 mCabalMacrosFile <- getCabalMacrosFile

13− doctest $ "-isrc" :

13+ doctest $ "-isrc" : "-Iinclude" :

14 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++

15 "-XOverloadedStrings" :

16 "-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

81 , TypeSynonymInstances

82 , UndecidableInstances

83 ghc-options: -Wall

84+ include-dirs: include

84

85

85test-suite spec

86test-suite spec

86 type: exitcode-stdio-1.0

87 type: exitcode-stdio-1.0

@@ -118,3 +119,4 @@ test-suite doctests

118 buildable: True

119 buildable: True

119 default-language: Haskell2010

120 default-language: Haskell2010

120 ghc-options: -threaded

121 ghc-options: -threaded

122+ include-dirs: include

servant/src/Servant/API/ResponseHeaders.hs+16−49

@@ -12,11 +12,9 @@

12{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE UndecidableInstances #-}

15−#if !MIN_VERSION_base(4,8,0)

16−{-# LANGUAGE OverlappingInstances #-}

17−#endif

18{-# OPTIONS_HADDOCK not-home #-}

15{-# OPTIONS_HADDOCK not-home #-}

19

16

17+#include "overlapping-compat.h"

20-- | This module provides facilities for adding headers to a response.

18-- | This module provides facilities for adding headers to a response.

21--

19--

22-- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int

20-- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int

@@ -68,19 +66,12 @@ class BuildHeadersTo hs where

68 -- the values are interspersed with commas before deserialization (see

66 -- the values are interspersed with commas before deserialization (see

69 -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>)

67 -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>)

70

68

71−instance

72−#if MIN_VERSION_base(4,8,0)

73− {-# OVERLAPPING #-}

74−#endif

75− BuildHeadersTo '[] where

69+instance OVERLAPPING_ BuildHeadersTo '[] where

76 buildHeadersTo _ = HNil

70 buildHeadersTo _ = HNil

77

71

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

72+instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h

73+ , Contains h xs ~ 'False)

83− ) => BuildHeadersTo ((Header h v) ': xs) where

74+ => BuildHeadersTo ((Header h v) ': xs) where

84 buildHeadersTo headers =

75 buildHeadersTo headers =

85 let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

76 let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

86 matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers

77 matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers

@@ -96,38 +87,22 @@ instance

96class GetHeaders ls where

87class GetHeaders ls where

97 getHeaders :: ls -> [HTTP.Header]

88 getHeaders :: ls -> [HTTP.Header]

98

89

99−instance

100−#if MIN_VERSION_base(4,8,0)

101− {-# OVERLAPPING #-}

102−#endif

103− GetHeaders (HList '[]) where

90+instance OVERLAPPING_ GetHeaders (HList '[]) where

104 getHeaders _ = []

91 getHeaders _ = []

105

92

106−instance

107−#if MIN_VERSION_base(4,8,0)

108− {-# OVERLAPPABLE #-}

109−#endif

110− ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)

93+instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs))

111− ) => GetHeaders (HList (Header h x ': xs)) where

94+ => GetHeaders (HList (Header h x ': xs)) where

112 getHeaders hdrs = case hdrs of

95 getHeaders hdrs = case hdrs of

113 Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest

96 Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest

114 UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest

97 UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest

115 MissingHeader `HCons` rest -> getHeaders rest

98 MissingHeader `HCons` rest -> getHeaders rest

116 where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

99 where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

117

100

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

123 getHeaders _ = []

102 getHeaders _ = []

124

103

125−instance

126−#if MIN_VERSION_base(4,8,0)

127− {-# OVERLAPPABLE #-}

128−#endif

129− ( KnownSymbol h, GetHeaders (HList rest), ToByteString v

104+instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v)

130− ) => GetHeaders (Headers (Header h v ': rest) a) where

105+ => GetHeaders (Headers (Header h v ': rest) a) where

131 getHeaders hs = getHeaders $ getHeadersHList hs

106 getHeaders hs = getHeaders $ getHeadersHList hs

132

107

133-- * Adding

108-- * Adding

@@ -138,21 +113,13 @@ class AddHeader h v orig new

138 addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times

113 addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times

139

114

140

115

141−instance

142−#if MIN_VERSION_base(4,8,0)

143− {-# OVERLAPPING #-}

144−#endif

145− ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False

116+instance OVERLAPPING_ ( 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

117+ => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where

147 addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)

118 addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)

148

119

149−instance

150−#if MIN_VERSION_base(4,8,0)

151− {-# OVERLAPPABLE #-}

152−#endif

153− ( KnownSymbol h, ToByteString v

120+instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v

154− , new ~ (Headers '[Header h v] a)

121+ , new ~ (Headers '[Header h v] a))

155− ) => AddHeader h v a new where

122+ => AddHeader h v a new where

156 addHeader a resp = Headers resp (HCons (Header a) HNil)

123 addHeader a resp = Headers resp (HCons (Header a) HNil)

157

124

158type family Contains x xs where

125type family Contains x xs where

servant/test/Doctests.hs+1−1

@@ -11,7 +11,7 @@ main = do

11 files <- find always (extension ==? ".hs") "src"

12 tfiles <- find always (extension ==? ".hs") "test/Servant"

13 mCabalMacrosFile <- getCabalMacrosFile

14− doctest $ "-isrc" :

14+ doctest $ "-isrc" : "-Iinclude" :

15 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++

16 "-XOverloadedStrings" :

17 "-XFlexibleInstances" :