diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index 193b4e60..9805285f 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -41,8 +41,7 @@ module Servant.Docs , ToCapture(..) , -- * ADTs to represent an 'API' - Method(..) - , Endpoint, path, method, defEndpoint + Endpoint, path, method, defEndpoint , API, apiIntros, apiEndpoints, emptyAPI , DocCapture(..), capSymbol, capDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 17e0b10c..0c3e30ac 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -36,7 +36,7 @@ import Data.Monoid import Data.Ord (comparing) import Data.Proxy (Proxy(Proxy)) import Data.String.Conversions (cs) -import Data.Text (Text, pack, unpack) +import Data.Text (Text, unpack) import GHC.Exts (Constraint) import GHC.Generics import GHC.TypeLits @@ -49,21 +49,6 @@ import qualified Data.Text as T import qualified Network.HTTP.Media as M import qualified Network.HTTP.Types as HTTP --- | Supported HTTP request methods -data Method = DocDELETE -- ^ the DELETE method - | DocGET -- ^ the GET method - | DocPOST -- ^ the POST method - | DocPUT -- ^ the PUT method - deriving (Eq, Ord, Generic) - -instance Show Method where - show DocGET = "GET" - show DocPOST = "POST" - show DocDELETE = "DELETE" - show DocPUT = "PUT" - -instance Hashable Method - -- | An 'Endpoint' type that holds the 'path' and the 'method'. -- -- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint' @@ -75,12 +60,12 @@ instance Hashable Method -- GET / -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo --- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST' +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost' -- POST /foo -- @ data Endpoint = Endpoint - { _path :: [String] -- type collected - , _method :: Method -- type collected + { _path :: [String] -- type collected + , _method :: HTTP.Method -- type collected } deriving (Eq, Ord, Generic) instance Show Endpoint where @@ -94,7 +79,7 @@ showPath :: [String] -> String showPath [] = "/" showPath ps = concatMap ('/' :) ps --- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET' +-- | An 'Endpoint' whose path is `"/"` and whose method is @GET@ -- -- Here's how you can modify it: -- @@ -103,11 +88,11 @@ showPath ps = concatMap ('/' :) ps -- GET / -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo --- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST' +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost' -- POST /foo -- @ defEndpoint :: Endpoint -defEndpoint = Endpoint [] DocGET +defEndpoint = Endpoint [] HTTP.methodGet instance Hashable Endpoint @@ -689,124 +674,37 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout) instance OVERLAPPABLE_ - (ToSample a, AllMimeRender (ct ': cts) a) - => HasDocs (Delete (ct ': cts) a) where + (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status + , ReflectMethod method) + => HasDocs (Verb method status (ct ': cts) a) where docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' - where endpoint' = endpoint & method .~ DocDELETE + where endpoint' = endpoint & method .~ method' action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ allMime t + & response.respStatus .~ status t = Proxy :: Proxy (ct ': cts) + method' = reflectMethod (Proxy :: Proxy method) + status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a instance OVERLAPPING_ - (ToSample a, AllMimeRender (ct ': cts) a - , AllHeaderSamples ls , GetHeaders (HList ls) ) - => HasDocs (Delete (ct ': cts) (Headers ls a)) where + (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status + , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls)) + => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' - where hdrs = allHeaderToSample (Proxy :: Proxy ls) - endpoint' = endpoint & method .~ DocDELETE + where endpoint' = endpoint & method .~ method' action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ allMime t + & response.respStatus .~ status & response.respHeaders .~ hdrs t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance OVERLAPPABLE_ - (ToSample a, AllMimeRender (ct ': cts) a) - => HasDocs (Get (ct ': cts) a) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where endpoint' = endpoint & method .~ DocGET - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance OVERLAPPING_ - (ToSample a, AllMimeRender (ct ': cts) a - , AllHeaderSamples ls , GetHeaders (HList ls) ) - => HasDocs (Get (ct ': cts) (Headers ls a)) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where hdrs = allHeaderToSample (Proxy :: Proxy ls) - endpoint' = endpoint & method .~ DocGET - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - & response.respHeaders .~ hdrs - t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance (KnownSymbol sym, HasDocs sublayout) - => HasDocs (Header sym a :> sublayout) where - docsFor Proxy (endpoint, action) = - docsFor sublayoutP (endpoint, action') - - where sublayoutP = Proxy :: Proxy sublayout - action' = over headers (|> headername) action - headername = pack $ symbolVal (Proxy :: Proxy sym) - -instance OVERLAPPABLE_ - (ToSample a, AllMimeRender (ct ': cts) a) - => HasDocs (Post (ct ': cts) a) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - & response.respStatus .~ 201 - t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance OVERLAPPING_ - (ToSample a, AllMimeRender (ct ': cts) a - , AllHeaderSamples ls , GetHeaders (HList ls) ) - => HasDocs (Post (ct ': cts) (Headers ls a)) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where hdrs = allHeaderToSample (Proxy :: Proxy ls) - endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - & response.respStatus .~ 201 - & response.respHeaders .~ hdrs - t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance OVERLAPPABLE_ - (ToSample a, AllMimeRender (ct ': cts) a) - => HasDocs (Put (ct ': cts) a) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - & response.respStatus .~ 200 - t = Proxy :: Proxy (ct ': cts) - p = Proxy :: Proxy a - -instance OVERLAPPING_ - ( ToSample a, AllMimeRender (ct ': cts) a, - AllHeaderSamples ls , GetHeaders (HList ls) ) - => HasDocs (Put (ct ': cts) (Headers ls a)) where - docsFor Proxy (endpoint, action) DocOptions{..} = - single endpoint' action' - - where hdrs = allHeaderToSample (Proxy :: Proxy ls) - endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) - & response.respTypes .~ allMime t - & response.respStatus .~ 200 - & response.respHeaders .~ hdrs - t = Proxy :: Proxy (ct ': cts) + hdrs = allHeaderToSample (Proxy :: Proxy ls) + method' = reflectMethod (Proxy :: Proxy method) + status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 5375b0c3..d37f78c9 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -71,7 +71,6 @@ spec = describe "Servant.Docs" $ do it "mentions status codes" $ do md `shouldContain` "Status code 200" - md `shouldContain` "Status code 201" it "mentions methods" $ do md `shouldContain` "POST"