Merge pull request #585 from axman6/axman6/get-headers-581

Replace use of ToByteString with HttpApiData for GetHeaders
This commit is contained in:
Julian Arni 2016-09-06 20:59:46 -03:00 committed by GitHub
commit 29af0bbdf9
9 changed files with 20 additions and 25 deletions

View file

@ -36,7 +36,6 @@ library
, aeson , aeson
, aeson-pretty , aeson-pretty
, bytestring , bytestring
, bytestring-conversion
, case-insensitive , case-insensitive
, hashable , hashable
, http-media >= 0.6 , http-media >= 0.6
@ -61,7 +60,6 @@ executable greet-docs
build-depends: build-depends:
base base
, aeson , aeson
, bytestring-conversion
, lens , lens
, servant , servant
, servant-docs , servant-docs

View file

@ -25,7 +25,6 @@ import Control.Arrow (second)
import Control.Lens (makeLenses, mapped, over, traversed, view, (%~), import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),
(&), (.~), (<>~), (^.), (|>)) (&), (.~), (<>~), (^.), (|>))
import qualified Control.Monad.Omega as Omega import qualified Control.Monad.Omega as Omega
import Data.ByteString.Conversion (ToByteString, toByteString)
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Char8 as BSC
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
@ -461,12 +460,12 @@ class AllHeaderSamples ls where
instance AllHeaderSamples '[] where instance AllHeaderSamples '[] where
allHeaderToSample _ = [] allHeaderToSample _ = []
instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h) instance (ToHttpApiData l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
=> AllHeaderSamples (Header h l ': ls) where => AllHeaderSamples (Header h l ': ls) where
allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) : allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) :
allHeaderToSample (Proxy :: Proxy ls) allHeaderToSample (Proxy :: Proxy ls)
where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h) where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)
mkHeader (Just x) = (headerName, cs $ toByteString x) mkHeader (Just x) = (headerName, cs $ toHeader x)
mkHeader Nothing = (headerName, "<no header sample provided>") mkHeader Nothing = (headerName, "<no header sample provided>")
-- | Synthesise a sample value of a type, encoded in the specified media types. -- | Synthesise a sample value of a type, encoded in the specified media types.

View file

@ -69,5 +69,4 @@ test-suite spec
servant-server, servant-server,
servant-mock, servant-mock,
aeson, aeson,
bytestring-conversion,
wai wai

View file

@ -8,9 +8,7 @@
module Servant.MockSpec where module Servant.MockSpec where
import Data.Aeson as Aeson import Data.Aeson as Aeson
import Data.ByteString.Conversion.To
import Data.Proxy import Data.Proxy
import Data.String
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant.API import Servant.API
@ -40,8 +38,11 @@ data TestHeader
| ArbitraryHeader | ArbitraryHeader
deriving (Show) deriving (Show)
instance ToByteString TestHeader where instance ToHttpApiData TestHeader where
builder = fromString . show toHeader = toHeader . show
toUrlPiece = toUrlPiece . show
toQueryParam = toQueryParam . show
instance Arbitrary TestHeader where instance Arbitrary TestHeader where
arbitrary = return ArbitraryHeader arbitrary = return ArbitraryHeader

View file

@ -114,7 +114,6 @@ test-suite spec
, aeson , aeson
, base64-bytestring , base64-bytestring
, bytestring , bytestring
, bytestring-conversion
, directory , directory
, exceptions , exceptions
, hspec == 2.* , hspec == 2.*

View file

@ -17,7 +17,6 @@ import Control.Monad (forM_, when, unless)
import Control.Monad.Trans.Except (throwE) import Control.Monad.Trans.Except (throwE)
import Data.Aeson (FromJSON, ToJSON, decode', encode) import Data.Aeson (FromJSON, ToJSON, decode', encode)
import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Base64 as Base64
import Data.ByteString.Conversion ()
import Data.Char (toUpper) import Data.Char (toUpper)
import Data.Monoid import Data.Monoid
import Data.Proxy (Proxy (Proxy)) import Data.Proxy (Proxy (Proxy))

View file

@ -2,6 +2,7 @@
---- ----
* Add `CaptureAll` combinator. Captures all of the remaining segments in a URL. * Add `CaptureAll` combinator. Captures all of the remaining segments in a URL.
* BACKWARDS INCOMPATIBLE replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`
0.8 0.8
--- ---

View file

@ -54,7 +54,6 @@ library
, aeson >= 0.7 && < 1.1 , aeson >= 0.7 && < 1.1
, attoparsec >= 0.12 && < 0.14 , attoparsec >= 0.12 && < 0.14
, bytestring >= 0.10 && < 0.11 , bytestring >= 0.10 && < 0.11
, bytestring-conversion >= 0.3 && < 0.4
, case-insensitive >= 1.2 && < 1.3 , case-insensitive >= 1.2 && < 1.3
, http-api-data >= 0.1 && < 0.3 , http-api-data >= 0.1 && < 0.3
, http-media >= 0.4 && < 0.7 , http-media >= 0.4 && < 0.7

View file

@ -31,8 +31,8 @@ module Servant.API.ResponseHeaders
) where ) where
import Data.ByteString.Char8 as BS (pack, unlines, init) import Data.ByteString.Char8 as BS (pack, unlines, init)
import Data.ByteString.Conversion (ToByteString, toByteString', import Web.HttpApiData (ToHttpApiData, toHeader,
FromByteString, fromByteString) FromHttpApiData, parseHeader)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Proxy import Data.Proxy
import GHC.TypeLits (KnownSymbol, symbolVal) import GHC.TypeLits (KnownSymbol, symbolVal)
@ -68,17 +68,17 @@ class BuildHeadersTo hs where
instance OVERLAPPING_ BuildHeadersTo '[] where instance OVERLAPPING_ BuildHeadersTo '[] where
buildHeadersTo _ = HNil buildHeadersTo _ = HNil
instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h ) instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
=> BuildHeadersTo ((Header h v) ': xs) where => BuildHeadersTo ((Header h v) ': xs) where
buildHeadersTo headers = buildHeadersTo headers =
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
in case matching of in case matching of
[] -> MissingHeader `HCons` buildHeadersTo headers [] -> MissingHeader `HCons` buildHeadersTo headers
xs -> case fromByteString (BS.init $ BS.unlines xs) of xs -> case parseHeader (BS.init $ BS.unlines xs) of
Nothing -> UndecodableHeader (BS.init $ BS.unlines xs) Left _err -> UndecodableHeader (BS.init $ BS.unlines xs)
`HCons` buildHeadersTo headers `HCons` buildHeadersTo headers
Just h -> Header h `HCons` buildHeadersTo headers Right h -> Header h `HCons` buildHeadersTo headers
-- * Getting -- * Getting
@ -88,18 +88,18 @@ class GetHeaders ls where
instance OVERLAPPING_ GetHeaders (HList '[]) where instance OVERLAPPING_ GetHeaders (HList '[]) where
getHeaders _ = [] getHeaders _ = []
instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) ) instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )
=> GetHeaders (HList (Header h x ': xs)) where => GetHeaders (HList (Header h x ': xs)) where
getHeaders hdrs = case hdrs of getHeaders hdrs = case hdrs of
Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest
UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest
MissingHeader `HCons` rest -> getHeaders rest MissingHeader `HCons` rest -> getHeaders rest
where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h) where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
instance OVERLAPPING_ GetHeaders (Headers '[] a) where instance OVERLAPPING_ GetHeaders (Headers '[] a) where
getHeaders _ = [] getHeaders _ = []
instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v ) instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )
=> GetHeaders (Headers (Header h v ': rest) a) where => GetHeaders (Headers (Header h v ': rest) a) where
getHeaders hs = getHeaders $ getHeadersHList hs getHeaders hs = getHeaders $ getHeadersHList hs
@ -111,11 +111,11 @@ class AddHeader h v orig new
addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
instance OVERLAPPING_ ( KnownSymbol h, ToByteString 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
addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads) addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
, new ~ (Headers '[Header h v] a) ) , new ~ (Headers '[Header h v] a) )
=> AddHeader h v a new where => AddHeader h v a new where
addHeader a resp = Headers resp (HCons (Header a) HNil) addHeader a resp = Headers resp (HCons (Header a) HNil)