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.Inflections
|
||||
build-depends: base == 4.*
|
||||
, http-media == 0.7.*
|
||||
, lens == 4.*
|
||||
, servant == 0.11.*
|
||||
, text >= 1.2 && < 1.3
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in a new issue