Add details about AddHeaders instances (#1490)

* 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

1
.gitignore vendored
View file

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

View file

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