a975cfc · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Add details about AddHeaders instances (#1490)

a975cfcThéophile Choutri5 years ago

.gitignore+1

compare with master

unifiedsplit

@@ -31,6 +31,7 @@ doc/venv

31doc/tutorial/static/api.js

32doc/tutorial/static/jq.js

33shell.nix

34+.hspec-failures

35# nix

36# nix

36result*

37result*

servant/src/Servant/API/ResponseHeaders.hs+6−11

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

3{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE GADTs #-}

6{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE KindSignatures #-}

7+{-# LANGUAGE FunctionalDependencies #-}

9−{-# LANGUAGE MultiParamTypeClasses #-}

10{-# LANGUAGE PolyKinds #-}

8{-# LANGUAGE PolyKinds #-}

11{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE TypeFamilies #-}

@@ -51,9 +49,6 @@ import Web.HttpApiData

52import Prelude ()

50import Prelude ()

53import Prelude.Compat

51import Prelude.Compat

54−import Servant.API.ContentTypes

55− (JSON, PlainText, FormUrlEncoded, OctetStream,

56− MimeRender(..))

57import Servant.API.Header

52import Servant.API.Header

58 (Header)

53 (Header)

@@ -117,7 +112,7 @@ instance {-# OVERLAPPABLE #-} ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbo

117 `HCons` buildHeadersTo headers

112 `HCons` buildHeadersTo headers

118 Right h -> Header h `HCons` buildHeadersTo headers

113 Right h -> Header h `HCons` buildHeadersTo headers

119

114

120−-- * Getting

115+-- * Getting headers

121

116

122class GetHeaders ls where

117class GetHeaders ls where

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

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

@@ -158,20 +153,20 @@ instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)

158 where

153 where

159 getHeaders' hs = getHeadersFromHList $ getHeadersHList hs

154 getHeaders' hs = getHeadersFromHList $ getHeadersHList hs

160

155

161−-- * Adding

156+-- * Adding headers

162

157

163-- We need all these fundeps to save type inference

158-- We need all these fundeps to save type inference

164class AddHeader h v orig new

159class AddHeader h v orig new

165 | h v orig -> new, new -> h, new -> v, new -> orig where

160 | h v orig -> new, new -> h, new -> v, new -> orig where

166 addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times

161 addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times

167

162

168−

163+-- In this instance, we add a Header on top of something that is already decorated with some headers

169instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )

164instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )

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

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

171 addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)

166 addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)

172

167

168+-- In this instance, 'a' parameter is decorated with a Header.

173−instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v

169+instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header h v] a)

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

175 => AddHeader h v a new where

170 => AddHeader h v a new where

176 addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)

171 addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)

177

172