diff --git a/.gitignore b/.gitignore index 6cec8e9d..3b2084ae 100644 --- a/.gitignore +++ b/.gitignore @@ -31,6 +31,7 @@ doc/venv doc/tutorial/static/api.js doc/tutorial/static/jq.js shell.nix +.hspec-failures # nix result* diff --git a/servant/src/Servant/API/ResponseHeaders.hs b/servant/src/Servant/API/ResponseHeaders.hs index 0ec60e22..de60ef3b 100644 --- a/servant/src/Servant/API/ResponseHeaders.hs +++ b/servant/src/Servant/API/ResponseHeaders.hs @@ -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)