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

Making the diff smaller and fix the tests.

Browse source
This commit is contained in:
Erik Aker 2021-11-17 18:30:22 -08:00
parent c64bbb96b0
commit 55a85e17d0
3 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -1074,13 +1074,14 @@ instance (ToForm a, ToSample a, HasDocs api)
instance (ToFragment (Fragment a), HasDocs api) instance (ToFragment (Fragment a), HasDocs api)
=> HasDocs (Fragment a :> api) where => HasDocs (Fragment a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor subApiP (endpoint, action') docsFor subApiP (endpoint, action')
where subApiP = Proxy :: Proxy api where subApiP = Proxy :: Proxy api
fragmentP = Proxy :: Proxy (Fragment a) fragmentP = Proxy :: Proxy (Fragment a)
action' = set fragment (Just (toFragment fragmentP)) action action' = set fragment (Just (toFragment fragmentP)) action
instance HasDocs Raw where instance HasDocs Raw where
docsFor _proxy (endpoint, action) _ = docsFor _proxy (endpoint, action) _ =
single endpoint action single endpoint action

15
servant-docs/test/Servant/DocsSpec.hs
View file

@ -82,7 +82,7 @@ spec = describe "Servant.Docs" $ do
(defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]]) (defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]])
<> <>
extraInfo extraInfo
(Proxy :: Proxy ("postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1)) (Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1))
(defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]]) (defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]])
md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1)) md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))
tests1 md tests1 md
@ -126,10 +126,10 @@ spec = describe "Servant.Docs" $ do
md `shouldContain` "## GET" md `shouldContain` "## GET"
it "should mention the endpoints" $ do it "should mention the endpoints" $ do
md `shouldContain` "## POST /postJson" md `shouldContain` "## POST /"
md `shouldContain` "## GET /qparam" md `shouldContain` "## GET /qparam"
md `shouldContain` "## GET /qparamform" md `shouldContain` "## GET /qparamform"
md `shouldContain` "## PUT /header" md `shouldContain` "## PUT /"
it "mentions headers" $ do it "mentions headers" $ do
md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header." md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."
@ -145,7 +145,7 @@ spec = describe "Servant.Docs" $ do
md `shouldContain` "### GET Parameters:" md `shouldContain` "### GET Parameters:"
md `shouldContain` "- query" md `shouldContain` "- query"
it "mentions optional query-param-form params from QueryParamForm" $ it "mentions optional query-param-form params from QueryParamForm" $
md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*" md `shouldContain` "**Values**: *dt1field2=13&dt1field1=field%201*"
it "does not generate any docs mentioning the 'empty-api' path" $ it "does not generate any docs mentioning the 'empty-api' path" $
md `shouldNotContain` "empty-api" md `shouldNotContain` "empty-api"
@ -178,11 +178,12 @@ instance MimeRender PlainText Int where
mimeRender _ = cs . show mimeRender _ = cs . show
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int) type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
:<|> "postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI
:<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1 :<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1
:<|> "qparamform" :> QueryParamForm Datatype1 :> Get '[JSON] Datatype1 :<|> "qparamform" :> QueryParamForm Datatype1 :> Get '[JSON] Datatype1
:<|> "header" :> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI
type TestApi2 = "duplicate-endpoint" :> Get '[JSON] Datatype1 type TestApi2 = "duplicate-endpoint" :> Get '[JSON] Datatype1
:<|> "duplicate-endpoint" :> Get '[PlainText] Int :<|> "duplicate-endpoint" :> Get '[PlainText] Int

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

@ -127,8 +127,10 @@ listFromAPISpec = describe "listFromAPI" $ do
{ _reqUrl = Url { _reqUrl = Url
[ Segment $ Static "test" ] [ Segment $ Static "test" ]
[ QueryArg (Arg "" "maybe contactFormX") Form ] [ QueryArg (Arg "" "maybe contactFormX") Form ]
Nothing
, _reqMethod = "POST" , _reqMethod = "POST"
, _reqHeaders = [] , _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = Just "voidX" , _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["post", "test"] , _reqFuncName = FunctionName ["post", "test"]
} }