First hack at fixing #509.

This commit is contained in:
tmbull 2017-10-09 11:52:41 -05:00
parent 63d8f6c0f3
commit e9622401f9
3 changed files with 32 additions and 4 deletions

View file

@ -31,6 +31,7 @@ library
, Servant.Foreign.Internal , Servant.Foreign.Internal
, Servant.Foreign.Inflections , Servant.Foreign.Inflections
build-depends: base == 4.* build-depends: base == 4.*
, http-media == 0.7.*
, lens == 4.* , lens == 4.*
, servant == 0.11.* , servant == 0.11.*
, text >= 1.2 && < 1.3 , text >= 1.2 && < 1.3

View file

@ -18,8 +18,10 @@ import Data.Text
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8)
import GHC.TypeLits import GHC.TypeLits
import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as HTTP
import Network.HTTP.Media.MediaType
import Prelude hiding (concat) import Prelude hiding (concat)
import Servant.API import Servant.API
import Servant.API.ContentTypes (AllMime, allMime)
import Servant.API.TypeLevel import Servant.API.TypeLevel
@ -125,6 +127,7 @@ data Req f = Req
, _reqBody :: Maybe f , _reqBody :: Maybe f
, _reqReturnType :: Maybe f , _reqReturnType :: Maybe f
, _reqFuncName :: FunctionName , _reqFuncName :: FunctionName
, _reqReturnContentTypes :: [MediaType]
} }
deriving instance Eq f => Eq (Req f) deriving instance Eq f => Eq (Req f)
@ -133,7 +136,7 @@ deriving instance Show f => Show (Req f)
makeLenses ''Req makeLenses ''Req
defReq :: Req ftype 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 -- | 'HasForeignType' maps Haskell types with types in the target
-- language of your backend. For example, let's say you're -- 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 { _argName = PathSegment str
, _argType = ftype } , _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 => HasForeign lang ftype (Verb method status list a) where
type Foreign ftype (Verb method status list a) = Req ftype 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 :) req & reqFuncName . _FunctionName %~ (methodLC :)
& reqMethod .~ method & reqMethod .~ method
& reqReturnType .~ Just retType & reqReturnType .~ Just retType
& reqReturnContentTypes .~ cTypes
where where
retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
method = reflectMethod (Proxy :: Proxy method) method = reflectMethod (Proxy :: Proxy method)
methodLC = toLower $ decodeUtf8 method methodLC = toLower $ decodeUtf8 method
cTypes = allMime (Proxy :: Proxy list)
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api) instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
=> HasForeign lang ftype (Header sym a :> api) where => HasForeign lang ftype (Header sym a :> api) where

View file

@ -3,6 +3,7 @@
module Servant.ForeignSpec where module Servant.ForeignSpec where
import Data.List.NonEmpty (toList)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Proxy import Data.Proxy
import Servant.Foreign import Servant.Foreign
@ -57,6 +58,7 @@ type TestApi
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int] :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
:<|> "test" :> "text" :> Get '[PlainText] String
:<|> "test" :> EmptyAPI :<|> "test" :> EmptyAPI
testApi :: [Req String] testApi :: [Req String]
@ -65,9 +67,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P
listFromAPISpec :: Spec listFromAPISpec :: Spec
listFromAPISpec = describe "listFromAPI" $ do listFromAPISpec = describe "listFromAPI" $ do
it "generates 5 endpoints for TestApi" $ 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 it "collects all info for get request" $ do
shouldBe getReq $ defReq shouldBe getReq $ defReq
@ -79,6 +81,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqBody = Nothing , _reqBody = Nothing
, _reqReturnType = Just "intX" , _reqReturnType = Just "intX"
, _reqFuncName = FunctionName ["get", "test"] , _reqFuncName = FunctionName ["get", "test"]
, _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON)
} }
it "collects all info for post request" $ do it "collects all info for post request" $ do
@ -91,6 +94,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqBody = Just "listX of stringX" , _reqBody = Just "listX of stringX"
, _reqReturnType = Just "voidX" , _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["post", "test"] , _reqFuncName = FunctionName ["post", "test"]
, _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON)
} }
it "collects all info for put request" $ do it "collects all info for put request" $ do
@ -104,6 +108,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqBody = Just "stringX" , _reqBody = Just "stringX"
, _reqReturnType = Just "voidX" , _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["put", "test"] , _reqFuncName = FunctionName ["put", "test"]
, _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON)
} }
it "collects all info for delete request" $ do it "collects all info for delete request" $ do
@ -117,6 +122,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqBody = Nothing , _reqBody = Nothing
, _reqReturnType = Just "voidX" , _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["delete", "test", "by", "id"] , _reqFuncName = FunctionName ["delete", "test", "by", "id"]
, _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON)
} }
it "collects all info for capture all request" $ do it "collects all info for capture all request" $ do
@ -130,4 +136,20 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqBody = Nothing , _reqBody = Nothing
, _reqReturnType = Just "listX of intX" , _reqReturnType = Just "listX of intX"
, _reqFuncName = FunctionName ["get", "test", "by", "ids"] , _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)
}