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

Remove dependency on bytestring-conversion

Browse source
This commit is contained in:
Alex Mason 2016-09-02 23:14:45 +10:00
parent a1b23018f9
commit 9b5a564f3c
2 changed files with 6 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant/servant.cabal
View file

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

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

@ -31,9 +31,8 @@ module Servant.API.ResponseHeaders
) where
import Data.ByteString.Char8 as BS (pack, unlines, init)
import Data.ByteString.Conversion (--ToByteString, toByteString',
FromByteString, fromByteString)
import Web.HttpApiData (ToHttpApiData,toHeader)
import Web.HttpApiData (ToHttpApiData,toHeader
,FromHttpApiData,parseHeader)
import qualified Data.CaseInsensitive as CI
import Data.Proxy
import GHC.TypeLits (KnownSymbol, symbolVal)
@ -69,17 +68,17 @@ class BuildHeadersTo hs where
instance OVERLAPPING_ BuildHeadersTo '[] where
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 headers =
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
in case matching of
[] -> MissingHeader `HCons` buildHeadersTo headers
xs -> case fromByteString (BS.init $ BS.unlines xs) of
Nothing -> UndecodableHeader (BS.init $ BS.unlines xs)
xs -> case parseHeader (BS.init $ BS.unlines xs) of
Left _err -> UndecodableHeader (BS.init $ BS.unlines xs)
`HCons` buildHeadersTo headers
Just h -> Header h `HCons` buildHeadersTo headers
Right h -> Header h `HCons` buildHeadersTo headers
-- * Getting