diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,67 @@ +# servant-docs + +[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-docs.svg)](http://travis-ci.org/haskell-servant/servant-docs) + +![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) + +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 + +See [here](https://github.com/haskell-servant/servant-docs/blob/master/example/greet.md) for the output of the following program. + +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +import Data.Proxy +import Data.Text +import Servant + +-- our type for a Greeting message +data Greet = Greet { _msg :: Text } + deriving (Generic, Show) + +-- we get our JSON serialization for free +instance FromJSON Greet +instance ToJSON Greet + +-- we provide a sample value for the 'Greet' type +instance ToSample Greet where + toSample = Just g + + where g = Greet "Hello, haskeller!" + +instance ToParam (QueryParam "capital" Bool) where + toParam _ = + DocQueryParam "capital" + ["true", "false"] + "Get the greeting message in uppercase (true) or not (false). Default is false." + +instance ToCapture (Capture "name" Text) where + toCapture _ = DocCapture "name" "name of the person to greet" + +instance ToCapture (Capture "greetid" Text) where + toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove" + +-- API specification +type TestApi = + "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet + :<|> "greet" :> RQBody Greet :> Post Greet + :<|> "delete" :> Capture "greetid" Text :> Delete + +testApi :: Proxy TestApi +testApi = Proxy + +-- Generate the Documentation's ADT +greetDocs :: API +greetDocs = docs testApi + +main :: IO () +main = putStrLn $ markdown greetDocs +``` diff --git a/example/greet.hs b/example/greet.hs --- a/example/greet.hs +++ b/example/greet.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} import Data.Aeson import Data.Proxy import Data.Text @@ -37,6 +38,11 @@ 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 = diff --git a/servant-docs.cabal b/servant-docs.cabal --- 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-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 @@ -26,6 +29,7 @@ build-depends: base >=4.7 && <5 , aeson + , aeson-pretty < 0.8 , bytestring , hashable , lens diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs --- 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 @@ ( -- * '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(..) @@ -99,7 +99,7 @@ , 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 @@ -109,10 +109,12 @@ import Control.Lens hiding (Action) import Data.Aeson +import Data.Aeson.Encode.Pretty (encodePretty) 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) @@ -122,6 +124,7 @@ 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 @@ -147,20 +150,27 @@ -- @ -- λ> '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' -- -- Here's how you can modify it: @@ -168,13 +178,13 @@ -- @ -- λ> '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 @@ -225,12 +235,12 @@ -- 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. @@ -242,7 +252,7 @@ -- > λ> 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: @@ -326,15 +336,29 @@ -- > 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 Proxy = fmap encode (toSample :: Maybe a) +sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString +sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a) +sampleByteStrings :: forall a. 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. -- @@ -375,7 +399,7 @@ responseStr (action ^. response) ++ [] - where str = show (endpoint^.method) ++ " " ++ endpoint^.path + where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path) len = length str capturesStr :: [DocCapture] -> [String] @@ -440,10 +464,14 @@ "**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 -- | The generated docs for @a ':<|>' b@ just appends the docs @@ -471,7 +499,7 @@ 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 @@ -481,7 +509,7 @@ where endpoint' = endpoint & method .~ DocDELETE - action' = action & response.respBody .~ Nothing + action' = action & response.respBody .~ [] & response.respStatus .~ 204 instance ToSample a => HasDocs (Get a) where @@ -489,7 +517,7 @@ 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) @@ -507,7 +535,7 @@ where endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ sampleByteString p + action' = action & response.respBody .~ sampleByteStrings p & response.respStatus .~ 201 p = Proxy :: Proxy a @@ -518,7 +546,7 @@ where endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ sampleByteString p + action' = action & response.respBody .~ sampleByteStrings p & response.respStatus .~ 200 p = Proxy :: Proxy a @@ -576,7 +604,7 @@ docsFor sublayoutP (endpoint', action) where sublayoutP = Proxy :: Proxy sublayout - endpoint' = endpoint & path <>~ symbolVal pa + endpoint' = endpoint & path <>~ [symbolVal pa] pa = Proxy :: Proxy path {-