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

Add DocOptions with maxSamples field

Browse source 
With DocOptions one can limit maximum number of samples.
This is useful for Generic-based instances for recursive data types
(e.g. `[]`). Default options set maxSamples to 5.
This commit is contained in:
Nickolay Kudasov 2015-09-21 13:36:57 +03:00
parent f96915e85e
commit 42f5795fcc
4 changed files with 49 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-docs/example/greet.hs
View file

@ -112,7 +112,7 @@ extra =
-- --
-- > docs testAPI :: API -- > docs testAPI :: API
docsGreet :: API docsGreet :: API
docsGreet = docsWith [intro1, intro2] extra testApi docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi
main :: IO () main :: IO ()
main = putStrLn $ markdown docsGreet main = putStrLn $ markdown docsGreet

4
servant-docs/src/Servant/Docs.hs
View file

@ -144,7 +144,9 @@ module Servant.Docs
( -- * 'HasDocs' class and key functions ( -- * 'HasDocs' class and key functions
HasDocs(..), docs, markdown HasDocs(..), docs, markdown
-- * Generating docs with extra information -- * Generating docs with extra information
, ExtraInfo(..), docsWith, docsWithIntros, extraInfo , docsWith, docsWithIntros, docsWithOptions
, ExtraInfo(..), extraInfo
, DocOptions(..) , defaultDocOptions, maxSamples
, -- * Classes you need to implement for your types , -- * Classes you need to implement for your types
ToSample(..) ToSample(..)

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

@ -9,6 +9,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
@ -176,6 +177,16 @@ instance Monoid (ExtraInfo a) where
ExtraInfo a `mappend` ExtraInfo b = ExtraInfo a `mappend` ExtraInfo b =
ExtraInfo $ HM.unionWith combineAction a b ExtraInfo $ HM.unionWith combineAction a b
-- | Documentation options.
data DocOptions = DocOptions
{ _maxSamples :: Int -- ^ Maximum samples allowed.
} deriving (Show)
-- | Default documentation options.
defaultDocOptions :: DocOptions
defaultDocOptions = DocOptions
{ _maxSamples = 5 }
-- | Type of GET parameter: -- | Type of GET parameter:
-- --
-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@ -280,6 +291,7 @@ single :: Endpoint -> Action -> API
single e a = API mempty (HM.singleton e a) single e a = API mempty (HM.singleton e a)
-- gimme some lenses -- gimme some lenses
makeLenses ''DocOptions
makeLenses ''API makeLenses ''API
makeLenses ''Endpoint makeLenses ''Endpoint
makeLenses ''DocCapture makeLenses ''DocCapture
@ -291,8 +303,14 @@ makeLenses ''Action
-- | Generate the docs for a given API that implements 'HasDocs'. This is the -- | Generate the docs for a given API that implements 'HasDocs'. This is the
-- default way to create documentation. -- default way to create documentation.
--
-- prop> docs == docsWithOptions defaultDocOptions
docs :: HasDocs layout => Proxy layout -> API docs :: HasDocs layout => Proxy layout -> API
docs p = docsFor p (defEndpoint, defAction) docs p = docsWithOptions p defaultDocOptions
-- | Generate the docs for a given API that implements 'HasDocs'.
docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API
docsWithOptions p = docsFor p (defEndpoint, defAction)
-- | Closed type family, check if endpoint is exactly within API. -- | Closed type family, check if endpoint is exactly within API.
@ -319,7 +337,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint) extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
=> Proxy endpoint -> Action -> ExtraInfo layout => Proxy endpoint -> Action -> ExtraInfo layout
extraInfo p action = extraInfo p action =
let api = docsFor p (defEndpoint, defAction) let api = docsFor p (defEndpoint, defAction) defaultDocOptions
-- Assume one endpoint, HasLink constraint means that we should only ever -- Assume one endpoint, HasLink constraint means that we should only ever
-- point at one endpoint. -- point at one endpoint.
in ExtraInfo $ api ^. apiEndpoints & traversed .~ action in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
@ -336,21 +354,22 @@ extraInfo p action =
-- 'extraInfo'. -- 'extraInfo'.
-- --
-- If you only want to add an introduction, use 'docsWithIntros'. -- If you only want to add an introduction, use 'docsWithIntros'.
docsWith :: HasDocs layout => [DocIntro] -> ExtraInfo layout -> Proxy layout -> API docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API
docsWith intros (ExtraInfo endpoints) p = docsWith opts intros (ExtraInfo endpoints) p =
docs p & apiIntros <>~ intros docsWithOptions p opts
& apiEndpoints %~ HM.unionWith (flip combineAction) endpoints & apiIntros <>~ intros
& apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
-- | Generate the docs for a given API that implements 'HasDocs' with with any -- | Generate the docs for a given API that implements 'HasDocs' with with any
-- number of introduction(s) -- number of introduction(s)
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
docsWithIntros intros = docsWith intros mempty docsWithIntros intros = docsWith defaultDocOptions intros mempty
-- | The class that abstracts away the impact of API combinators -- | The class that abstracts away the impact of API combinators
-- on documentation generation. -- on documentation generation.
class HasDocs layout where class HasDocs layout where
docsFor :: Proxy layout -> (Endpoint, Action) -> API docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API
-- | The class that lets us display a sample input or output in the supported -- | The class that lets us display a sample input or output in the supported
-- content-types when generating documentation for endpoints that either: -- content-types when generating documentation for endpoints that either:
@ -709,11 +728,11 @@ instance
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=> HasDocs (Delete cts a) where => HasDocs (Delete cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocDELETE where endpoint' = endpoint & method .~ DocDELETE
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
@ -725,12 +744,12 @@ instance
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Delete cts (Headers ls a)) where => HasDocs (Delete cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where hdrs = allHeaderToSample (Proxy :: Proxy ls) where hdrs = allHeaderToSample (Proxy :: Proxy ls)
endpoint' = endpoint & method .~ DocDELETE endpoint' = endpoint & method .~ DocDELETE
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respHeaders .~ hdrs & response.respHeaders .~ hdrs
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
@ -742,11 +761,11 @@ instance
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=> HasDocs (Get cts a) where => HasDocs (Get cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocGET where endpoint' = endpoint & method .~ DocGET
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
@ -758,12 +777,12 @@ instance
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Get cts (Headers ls a)) where => HasDocs (Get cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where hdrs = allHeaderToSample (Proxy :: Proxy ls) where hdrs = allHeaderToSample (Proxy :: Proxy ls)
endpoint' = endpoint & method .~ DocGET endpoint' = endpoint & method .~ DocGET
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respHeaders .~ hdrs & response.respHeaders .~ hdrs
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
@ -784,11 +803,11 @@ instance
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=> HasDocs (Post cts a) where => HasDocs (Post cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocPOST where endpoint' = endpoint & method .~ DocPOST
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respStatus .~ 201 & response.respStatus .~ 201
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
@ -801,12 +820,12 @@ instance
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Post cts (Headers ls a)) where => HasDocs (Post cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where hdrs = allHeaderToSample (Proxy :: Proxy ls) where hdrs = allHeaderToSample (Proxy :: Proxy ls)
endpoint' = endpoint & method .~ DocPOST endpoint' = endpoint & method .~ DocPOST
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respStatus .~ 201 & response.respStatus .~ 201
& response.respHeaders .~ hdrs & response.respHeaders .~ hdrs
@ -819,11 +838,11 @@ instance
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=> HasDocs (Put cts a) where => HasDocs (Put cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocPUT where endpoint' = endpoint & method .~ DocPUT
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respStatus .~ 200 & response.respStatus .~ 200
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
@ -836,12 +855,12 @@ instance
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Put cts (Headers ls a)) where => HasDocs (Put cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action' single endpoint' action'
where hdrs = allHeaderToSample (Proxy :: Proxy ls) where hdrs = allHeaderToSample (Proxy :: Proxy ls)
endpoint' = endpoint & method .~ DocPUT endpoint' = endpoint & method .~ DocPUT
action' = action & response.respBody .~ sampleByteStrings t p action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
& response.respTypes .~ supportedTypes t & response.respTypes .~ supportedTypes t
& response.respStatus .~ 200 & response.respStatus .~ 200
& response.respHeaders .~ hdrs & response.respHeaders .~ hdrs
@ -923,7 +942,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
symP = Proxy :: Proxy sym symP = Proxy :: Proxy sym
instance HasDocs Raw where instance HasDocs Raw where
docsFor _proxy (endpoint, action) = docsFor _proxy (endpoint, action) _ =
single endpoint action single endpoint action
-- TODO: We use 'AllMimeRender' here because we need to be able to show the -- TODO: We use 'AllMimeRender' here because we need to be able to show the

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

@ -36,7 +36,7 @@ spec = describe "Servant.Docs" $ do
extraInfo extraInfo
(Proxy :: Proxy (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 [] extra (Proxy :: Proxy TestApi1)) md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))
tests md tests md
it "contains the extra info provided" $ do it "contains the extra info provided" $ do
md `shouldContain` "Get an Integer" md `shouldContain` "Get an Integer"