From e9622401f92712e36d4721ddc4487a06df2a0c38 Mon Sep 17 00:00:00 2001 From: tmbull Date: Mon, 9 Oct 2017 11:52:41 -0500 Subject: [PATCH] First hack at fixing #509. --- servant-foreign/servant-foreign.cabal | 1 + .../src/Servant/Foreign/Internal.hs | 9 +++++-- servant-foreign/test/Servant/ForeignSpec.hs | 26 +++++++++++++++++-- 3 files changed, 32 insertions(+), 4 deletions(-) diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 35b41a53..586c0a98 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -31,6 +31,7 @@ library , Servant.Foreign.Internal , Servant.Foreign.Inflections build-depends: base == 4.* + , http-media == 0.7.* , lens == 4.* , servant == 0.11.* , text >= 1.2 && < 1.3 diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index b0a3410f..ceb3a05d 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -18,8 +18,10 @@ import Data.Text import Data.Text.Encoding (decodeUtf8) import GHC.TypeLits import qualified Network.HTTP.Types as HTTP +import Network.HTTP.Media.MediaType import Prelude hiding (concat) import Servant.API +import Servant.API.ContentTypes (AllMime, allMime) import Servant.API.TypeLevel @@ -125,6 +127,7 @@ data Req f = Req , _reqBody :: Maybe f , _reqReturnType :: Maybe f , _reqFuncName :: FunctionName + , _reqReturnContentTypes :: [MediaType] } deriving instance Eq f => Eq (Req f) @@ -133,7 +136,7 @@ deriving instance Show f => Show (Req f) makeLenses ''Req defReq :: Req ftype -defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) +defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) [] -- | 'HasForeignType' maps Haskell types with types in the target -- language of your backend. For example, let's say you're @@ -224,7 +227,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype { _argName = PathSegment str , _argType = ftype } -instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) +instance (AllMime list, HasForeignType lang ftype a, ReflectMethod method) => HasForeign lang ftype (Verb method status list a) where type Foreign ftype (Verb method status list a) = Req ftype @@ -232,10 +235,12 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) req & reqFuncName . _FunctionName %~ (methodLC :) & reqMethod .~ method & reqReturnType .~ Just retType + & reqReturnContentTypes .~ cTypes where retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) method = reflectMethod (Proxy :: Proxy method) methodLC = toLower $ decodeUtf8 method + cTypes = allMime (Proxy :: Proxy list) instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api) => HasForeign lang ftype (Header sym a :> api) where diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index 3bc572a5..25c2d053 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -3,6 +3,7 @@ module Servant.ForeignSpec where +import Data.List.NonEmpty (toList) import Data.Monoid ((<>)) import Data.Proxy import Servant.Foreign @@ -57,6 +58,7 @@ type TestApi :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int] + :<|> "test" :> "text" :> Get '[PlainText] String :<|> "test" :> EmptyAPI testApi :: [Req String] @@ -65,9 +67,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P listFromAPISpec :: Spec listFromAPISpec = describe "listFromAPI" $ do it "generates 5 endpoints for TestApi" $ do - length testApi `shouldBe` 5 + length testApi `shouldBe` 6 - let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi + let [getReq, postReq, putReq, deleteReq, captureAllReq, getTextReq] = testApi it "collects all info for get request" $ do shouldBe getReq $ defReq @@ -79,6 +81,7 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqBody = Nothing , _reqReturnType = Just "intX" , _reqFuncName = FunctionName ["get", "test"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) } it "collects all info for post request" $ do @@ -91,6 +94,7 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqBody = Just "listX of stringX" , _reqReturnType = Just "voidX" , _reqFuncName = FunctionName ["post", "test"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) } it "collects all info for put request" $ do @@ -104,6 +108,7 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqBody = Just "stringX" , _reqReturnType = Just "voidX" , _reqFuncName = FunctionName ["put", "test"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) } it "collects all info for delete request" $ do @@ -117,6 +122,7 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqBody = Nothing , _reqReturnType = Just "voidX" , _reqFuncName = FunctionName ["delete", "test", "by", "id"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) } it "collects all info for capture all request" $ do @@ -130,4 +136,20 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqBody = Nothing , _reqReturnType = Just "listX of intX" , _reqFuncName = FunctionName ["get", "test", "by", "ids"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) } + + it "collects all info for plaintext request" $ do + shouldBe getTextReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" + , Segment $ Static "text" ] + [] + , _reqMethod = "GET" + , _reqHeaders = [] + , _reqBody = Nothing + , _reqReturnType = Just "stringX" + , _reqFuncName = FunctionName ["get", "test", "text"] + , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy PlainText) + } +