servant-docs 0.2.1 → 0.3
raw patch · 5 files changed
+145/−34 lines, 5 filesdep +aeson-pretty
Dependencies added: aeson-pretty
Files
- CHANGELOG.md +6/−0
- README.md +67/−0
- example/greet.hs +6/−0
- servant-docs.cabal +6/−2
- src/Servant/Docs.hs +60/−32
+ CHANGELOG.md view
@@ -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.
+ README.md view
@@ -0,0 +1,67 @@+# servant-docs++[](http://travis-ci.org/haskell-servant/servant-docs)++++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+```
example/greet.hs view
@@ -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 =
servant-docs.cabal view
@@ -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
src/Servant/Docs.hs view
@@ -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 {-