From 17569a31b630a5d6928a492c11416606bd939f1b Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Wed, 31 Dec 2014 17:18:23 -0800 Subject: [PATCH 01/10] Add .gitignore file which ignore sandbox files --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..cef41940 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.cabal-sandbox +cabal.sandbox.config +dist From 42fc048dfc57c2a1d41be84dcb1c50e100a63e8a Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Wed, 31 Dec 2014 17:19:35 -0800 Subject: [PATCH 02/10] Add missing slash character in generated docs. --- src/Servant/Docs.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index a3bcf5ee..3c132ee7 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -175,7 +175,7 @@ instance Show Endpoint where -- POST /foo -- @ defEndpoint :: Endpoint -defEndpoint = Endpoint "/" DocGET +defEndpoint = Endpoint "" DocGET instance Hashable Endpoint @@ -577,7 +577,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh docsFor sublayoutP (endpoint', action) where sublayoutP = Proxy :: Proxy sublayout - endpoint' = endpoint & path <>~ symbolVal pa + endpoint' = endpoint & path <>~ '/' : symbolVal pa pa = Proxy :: Proxy path {- From 43f9aa78c0f650cfeba2d54e987bd2d1635f003d Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Fri, 2 Jan 2015 10:06:34 -0800 Subject: [PATCH 03/10] Represent path as [String] --- src/Servant/Docs.hs | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index 3c132ee7..606ac9da 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -148,19 +148,26 @@ instance Hashable Method -- @ -- λ> 'defEndpoint' -- GET / --- λ> 'defEndpoint' & 'path' '<>~' "foo" +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo --- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST' +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST' -- POST /foo -- @ data Endpoint = Endpoint - { _path :: String -- type collected - , _method :: Method -- type collected + { _path :: [String] -- type collected + , _method :: Method -- type collected } deriving (Eq, Generic) instance Show Endpoint where show (Endpoint p m) = - show m ++ " " ++ p + show m ++ " " ++ showPath p + +-- | +-- Render a path as a '/'-delimited string +-- +showPath :: [String] -> String +showPath [] = "/" +showPath ps = concatMap ('/' :) ps -- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET' -- @@ -169,13 +176,13 @@ instance Show Endpoint where -- @ -- λ> 'defEndpoint' -- GET / --- λ> 'defEndpoint' & 'path' '<>~' "foo" +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo --- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST' +-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST' -- POST /foo -- @ defEndpoint :: Endpoint -defEndpoint = Endpoint "" DocGET +defEndpoint = Endpoint [] DocGET instance Hashable Endpoint @@ -376,7 +383,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList responseStr (action ^. response) ++ [] - where str = show (endpoint^.method) ++ " " ++ endpoint^.path + where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path) len = length str capturesStr :: [DocCapture] -> [String] @@ -472,7 +479,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout) captureP = Proxy :: Proxy (Capture sym a) action' = over captures (|> toCapture captureP) action - endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint + endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint symP = Proxy :: Proxy sym @@ -577,7 +584,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh docsFor sublayoutP (endpoint', action) where sublayoutP = Proxy :: Proxy sublayout - endpoint' = endpoint & path <>~ '/' : symbolVal pa + endpoint' = endpoint & path <>~ [symbolVal pa] pa = Proxy :: Proxy path {- From e333ed5ff607b4db61e038978a5db6f777850505 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Sat, 3 Jan 2015 16:11:09 +0000 Subject: [PATCH 04/10] Expose "headers" lens All other lenses for `Action` are exposed. Without it, it is impossible to access the headers field. --- src/Servant/Docs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index 606ac9da..a88fbd77 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -99,7 +99,7 @@ module Servant.Docs , DocCapture(..), capSymbol, capDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind , Response, respStatus, respBody, defResponse - , Action, captures, params, rqbody, response, defAction + , Action, captures, headers, params, rqbody, response, defAction , single , -- * Useful modules when defining your doc printers From 0edde415bdae7afcb4a43e799d77ecdbcc5e81dd Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 16:38:50 +0100 Subject: [PATCH 05/10] first shot (doesn't build though) at multiple responses in the docs --- src/Servant/Docs.hs | 58 ++++++++++++++++++++++++++++++--------------- 1 file changed, 39 insertions(+), 19 deletions(-) diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index a88fbd77..26f794c5 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -1,10 +1,12 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} ------------------------------------------------------------------------------- -- | This module lets you get API docs for free. It lets generate @@ -83,12 +85,10 @@ module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, markdown - {- , -- * Serving the documentation - serveDocumentation -} - , -- * Classes you need to implement for your types ToSample(..) , sampleByteString + , sampleByteStrings , ToParam(..) , ToCapture(..) @@ -114,6 +114,7 @@ import Data.ByteString.Lazy.Char8 (ByteString) import Data.Hashable import Data.HashMap.Strict (HashMap) import Data.List +import Data.Maybe (listToMaybe) import Data.Monoid import Data.Proxy import Data.Text (Text, pack, unpack) @@ -123,6 +124,7 @@ import GHC.TypeLits import Servant.API import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T -- | Supported HTTP request methods data Method = DocDELETE -- ^ the DELETE method @@ -233,12 +235,12 @@ data ParamKind = Normal | List | Flag -- Can be tweaked with two lenses. -- -- > λ> defResponse --- > Response {_respStatus = 200, _respBody = Nothing} --- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]" --- > Response {_respStatus = 204, _respBody = Just "[]"} +-- > Response {_respStatus = 200, _respBody = []} +-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")] +-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]} data Response = Response { _respStatus :: Int - , _respBody :: Maybe ByteString + , _respBody :: [(Text, ByteString)] } deriving (Eq, Show) -- | Default response: status code 200, no response body. @@ -250,7 +252,7 @@ data Response = Response -- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]" -- > Response {_respStatus = 204, _respBody = Just "[]"} defResponse :: Response -defResponse = Response 200 Nothing +defResponse = Response 200 [] -- | A datatype that represents everything that can happen -- at an endpoint, with its lenses: @@ -334,15 +336,29 @@ class HasDocs layout where -- > toSample = Just g -- > -- > where g = Greet "Hello, haskeller!" +-- +-- You can also instantiate this class using 'toSamples' instead of +-- 'toSample': it lets you specify different responses along with +-- some context (as 'Text') that explains when you're supposed to +-- get the corresponding response. class ToJSON a => ToSample a where + {-# MINIMAL (toSample | toSamples) #-} toSample :: Maybe a + toSample = fmap snd $ listToMaybe samples + where samples = toSamples :: [(Text, a)] -instance ToSample () where - toSample = Just () + toSamples :: [(Text, a)] + toSamples = maybe [] (return . ("",)) s + where s = toSample :: Maybe a -sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString +sampleByteString :: ToSample a => Proxy a -> Maybe ByteString sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a) +sampleByteStrings :: ToSample a => Proxy a -> [(Text, ByteString)] +sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty + + where samples = toSamples :: [(Text, a)] + -- | The class that helps us automatically get documentation -- for GET parameters. -- @@ -448,9 +464,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList "**Response**: " : "" : (" - Status code " ++ show (resp ^. respStatus)) : - (resp ^. respBody & - maybe [" - No response body\n"] - (\b -> " - Response body as below." : jsonStr b)) + bodies + + where bodies = case resp ^. respBody of + [] -> [" - No response body\n"] + [("", r)] -> " - Response body as below." : jsonStr r + xs -> + concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs -- * Instances @@ -489,7 +509,7 @@ instance HasDocs Delete where where endpoint' = endpoint & method .~ DocDELETE - action' = action & response.respBody .~ Nothing + action' = action & response.respBody .~ [] & response.respStatus .~ 204 instance ToSample a => HasDocs (Get a) where @@ -497,7 +517,7 @@ instance ToSample a => HasDocs (Get a) where single endpoint' action' where endpoint' = endpoint & method .~ DocGET - action' = action & response.respBody .~ sampleByteString p + action' = action & response.respBody .~ sampleByteStrings p p = Proxy :: Proxy a instance (KnownSymbol sym, HasDocs sublayout) @@ -515,7 +535,7 @@ instance ToSample a => HasDocs (Post a) where where endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ sampleByteString p + action' = action & response.respBody .~ sampleByteStrings p & response.respStatus .~ 201 p = Proxy :: Proxy a @@ -526,7 +546,7 @@ instance ToSample a => HasDocs (Put a) where where endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ sampleByteString p + action' = action & response.respBody .~ sampleByteStrings p & response.respStatus .~ 200 p = Proxy :: Proxy a From 71142b08d4f78d6ed2dfb335f7fa3c0312595743 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 16:44:23 +0100 Subject: [PATCH 06/10] fix build error --- src/Servant/Docs.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index 26f794c5..c1f4aa92 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -351,10 +351,10 @@ class ToJSON a => ToSample a where toSamples = maybe [] (return . ("",)) s where s = toSample :: Maybe a -sampleByteString :: ToSample a => Proxy a -> Maybe ByteString +sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a) -sampleByteStrings :: ToSample a => Proxy a -> [(Text, ByteString)] +sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)] sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty where samples = toSamples :: [(Text, a)] From 07472ccb7aec9e33e0927c8d9506b9d1f7a568b6 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 16:53:02 +0100 Subject: [PATCH 07/10] update the example to show off multiple-responses --- example/greet.hs | 5 +++++ example/greet.md | 39 +++++++++++++++++++++++++++------------ 2 files changed, 32 insertions(+), 12 deletions(-) diff --git a/example/greet.hs b/example/greet.hs index 868a55ac..38a29292 100644 --- a/example/greet.hs +++ b/example/greet.hs @@ -39,6 +39,11 @@ instance ToParam (QueryParam "capital" Bool) where instance ToSample Greet where toSample = Just $ Greet "Hello, haskeller!" + toSamples = + [ ("If you use ?capital=true", Greet "HELLO, HASKELLER") + , ("If you use ?capital=false", Greet "Hello, haskeller") + ] + -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON diff --git a/example/greet.md b/example/greet.md index 2191063c..284c7eeb 100644 --- a/example/greet.md +++ b/example/greet.md @@ -1,8 +1,7 @@ - POST /greet ----------- -**Request Body**: +**Request Body**: ``` javascript { @@ -10,50 +9,66 @@ POST /greet } ``` -**Response**: +**Response**: - Status code 201 - - Response body as below. + - If you use ?capital=true ``` javascript { - "msg": "Hello, haskeller!" + "msg": "HELLO, HASKELLER" +} +``` + + - If you use ?capital=false + +``` javascript +{ + "msg": "Hello, haskeller" } ``` GET /hello/:name ---------------- -**Captures**: +**Captures**: - *name*: name of the person to greet -**GET Parameters**: +**GET Parameters**: - capital - **Values**: *true, false* - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false. -**Response**: +**Response**: - Status code 200 - - Response body as below. + - If you use ?capital=true ``` javascript { - "msg": "Hello, haskeller!" + "msg": "HELLO, HASKELLER" +} +``` + + - If you use ?capital=false + +``` javascript +{ + "msg": "Hello, haskeller" } ``` DELETE /greet/:greetid ---------------------- -**Captures**: +**Captures**: - *greetid*: identifier of the greet msg to remove -**Response**: +**Response**: - Status code 204 - No response body From 923a75afefb4c2316780d2bd73c526c4431e4b3b Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 17:17:57 +0100 Subject: [PATCH 08/10] add a changelog --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 CHANGELOG.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 00000000..ecf16c01 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +0.3 +--- + +* Add the ability to display multiple responses, with some accompanying `Text` to describe the context in which we get the corresponding JSON. +* Expose the `headers` lens +* Represent an endpoint's path as `[String]` (previously `String`), fixing a corner case where the leading `/` would be missing. From b7591dd7e099cc745502ac8db0e7a47df38403ac Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 17:18:12 +0100 Subject: [PATCH 09/10] mention servant-pandoc in the readme --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 23ac3ea3..8adaf0b8 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) -Generate API docs for your *servant* webservice. +Generate API docs for your *servant* webservice. Feel free to also take a look at [servant-pandoc](https://github.com/mpickering/servant-pandoc) which uses this package to target a broad range of output formats using the excellent **pandoc**. ## Example From 44efc7ff20d156a9f9cadca59fd1e61380ffde2d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 4 Jan 2015 17:18:40 +0100 Subject: [PATCH 10/10] bump version --- servant-docs.cabal | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/servant-docs.cabal b/servant-docs.cabal index 7f7d8777..52c06b5b 100644 --- a/servant-docs.cabal +++ b/servant-docs.cabal @@ -1,5 +1,5 @@ name: servant-docs -version: 0.2.1 +version: 0.3 synopsis: generate API docs for your servant webservice description: Library for generating API docs from a servant API definition. @@ -9,13 +9,16 @@ license: BSD3 license-file: LICENSE author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni maintainer: alpmestan@gmail.com -copyright: 2014 Zalora South East Asia Pte Ltd +copyright: 2014-2015 Zalora South East Asia Pte Ltd category: Web build-type: Simple cabal-version: >=1.10 tested-with: GHC >= 7.8 homepage: http://haskell-servant.github.io/ Bug-reports: http://github.com/haskell-servant/servant-docs/issues +extra-source-files: + CHANGELOG.md + README.md source-repository head type: git location: http://github.com/haskell-servant/servant-docs.git