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

Temporary fix for Header. (#843)

Browse source 
servant-foreign: make foreign client Header arguments have the representation of 'Maybe' in those languages
This commit is contained in:
Dimitri Sabadie 2017-11-27 00:23:55 +01:00 committed by Alp Mestanogullari
parent 6321859b63
commit c1371dd84d
2 changed files with 6 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
servant-foreign/src/Servant/Foreign/Internal.hs
View file

@ -225,7 +225,7 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
method = reflectMethod (Proxy :: Proxy method)
methodLC = toLower $ decodeUtf8 method
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
instance (KnownSymbol sym, HasForeignType lang ftype (Maybe a), HasForeign lang ftype api)
=> HasForeign lang ftype (Header sym a :> api) where
type Foreign ftype (Header sym a :> api) = Foreign ftype api
@ -235,7 +235,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype ap
hname = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _argName = PathSegment hname
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (Maybe a)) }
subP = Proxy :: Proxy api
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)

5
servant-foreign/test/Servant/ForeignSpec.hs
View file

@ -51,6 +51,9 @@ instance OVERLAPPING_ HasForeignType LangX String String where
instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where
typeFor lang ftype _ = "maybe " <> typeFor lang ftype (Proxy :: Proxy a)
type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
@ -75,7 +78,7 @@ listFromAPISpec = describe "listFromAPI" $ do
[ Segment $ Static "test" ]
[ QueryArg (Arg "flag" "boolX") Flag ]
, _reqMethod = "GET"
, _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
, _reqHeaders = [HeaderArg $ Arg "header" "maybe listX of stringX"]
, _reqBody = Nothing
, _reqReturnType = Just "intX"
, _reqFuncName = FunctionName ["get", "test"]