First hack at fixing #509.
This commit is contained in:
parent
63d8f6c0f3
commit
e9622401f9
3 changed files with 32 additions and 4 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue