eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add details about AddHeaders instances (#1490)

Browse source 
* Add details about the instances of AddHeader

Also:

* Cleanup of extensions and imports
This commit is contained in:
Théophile Choutri 2021-11-30 23:52:06 +01:00 committed by GitHub
parent 9a3979926d
commit a975cfc361
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 7 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -31,6 +31,7 @@ doc/venv
doc/tutorial/static/api.js doc/tutorial/static/api.js
doc/tutorial/static/jq.js doc/tutorial/static/jq.js
shell.nix shell.nix
.hspec-failures
# nix # nix
result* result*

17
servant/src/Servant/API/ResponseHeaders.hs
View file

@ -3,10 +3,8 @@
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
@ -51,9 +49,6 @@ import Web.HttpApiData
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
import Servant.API.ContentTypes
(JSON, PlainText, FormUrlEncoded, OctetStream,
MimeRender(..))
import Servant.API.Header import Servant.API.Header
(Header) (Header)
@ -117,7 +112,7 @@ instance {-# OVERLAPPABLE #-} ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbo
`HCons` buildHeadersTo headers `HCons` buildHeadersTo headers
Right h -> Header h `HCons` buildHeadersTo headers Right h -> Header h `HCons` buildHeadersTo headers
-- * Getting -- * Getting headers
class GetHeaders ls where class GetHeaders ls where
getHeaders :: ls -> [HTTP.Header] getHeaders :: ls -> [HTTP.Header]
@ -158,20 +153,20 @@ instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)
where where
getHeaders' hs = getHeadersFromHList $ getHeadersHList hs getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
-- * Adding -- * Adding headers
-- We need all these fundeps to save type inference -- We need all these fundeps to save type inference
class AddHeader h v orig new class AddHeader h v orig new
| h v orig -> new, new -> h, new -> v, new -> orig where | h v orig -> new, new -> h, new -> v, new -> orig where
addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
-- In this instance, we add a Header on top of something that is already decorated with some headers
instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v ) instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
=> AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads) addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)
instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v -- In this instance, 'a' parameter is decorated with a Header.
, new ~ (Headers '[Header h v] a) ) instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header h v] a)
=> AddHeader h v a new where => AddHeader h v a new where
addOptionalHeader hdr resp = Headers resp (HCons hdr HNil) addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)