09896b5 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Group mime-types together, and control how many get displayed

09896b5Ivan Lazar Miljenovic9 years ago

servant-docs/src/Servant/Docs.hs+3

compare with master

unifiedsplit

@@ -24,6 +24,9 @@

24module Servant.Docs

25 ( -- * 'HasDocs' class and key functions

26 HasDocs(..), docs, pretty, markdown

27+ -- ** Customising generated documentation

28+ , markdownWith, ApiOptions(..), defApiOptions

29+ , requestExamples, responseExamples, ShowContentTypes(..)

27 -- * Generating docs with extra information

30 -- * Generating docs with extra information

28 , docsWith, docsWithIntros, docsWithOptions

31 , docsWith, docsWithIntros, docsWithOptions

29 , ExtraInfo(..), extraInfo

32 , ExtraInfo(..), extraInfo

servant-docs/src/Servant/Docs/Internal.hs+62−16

@@ -20,24 +20,31 @@

20#include "overlapping-compat.h"

21module Servant.Docs.Internal where

23−import Prelude ()

23+import Prelude ()

24import Prelude.Compat

25+

25import Control.Applicative

26import Control.Applicative

26import Control.Arrow (second)

27import Control.Arrow (second)

27−import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),

28+import Control.Lens (makeLenses, mapped, over,

29+ traversed, view, (%~), (&), (.~),

28− (&), (.~), (<>~), (^.), (|>))

30+ (<>~), (^.), (|>))

29import qualified Control.Monad.Omega as Omega

31import qualified Control.Monad.Omega as Omega

30−import Data.ByteString.Lazy.Char8 (ByteString)

31import qualified Data.ByteString.Char8 as BSC

32import qualified Data.ByteString.Char8 as BSC

33+import Data.ByteString.Lazy.Char8 (ByteString)

32import qualified Data.CaseInsensitive as CI

34import qualified Data.CaseInsensitive as CI

35+import Data.Foldable (fold)

33import Data.Hashable (Hashable)

36import Data.Hashable (Hashable)

34import Data.HashMap.Strict (HashMap)

37import Data.HashMap.Strict (HashMap)

35import Data.List.Compat (intercalate, intersperse, sort)

38import Data.List.Compat (intercalate, intersperse, sort)

39+import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)

40+import qualified Data.List.NonEmpty as NE

36import Data.Maybe

41import Data.Maybe

37−import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..))

42+import Data.Monoid (All (..), Any (..), Dual (..),

38−import Data.Semigroup (Semigroup (..))

43+ First (..), Last (..),

44+ Product (..), Sum (..))

39import Data.Ord (comparing)

45import Data.Ord (comparing)

40−import Data.Proxy (Proxy(Proxy))

46+import Data.Proxy (Proxy (Proxy))

47+import Data.Semigroup (Semigroup (..))

41import Data.String.Conversions (cs)

48import Data.String.Conversions (cs)

42import Data.Text (Text, unpack)

49import Data.Text (Text, unpack)

43import GHC.Generics

50import GHC.Generics

@@ -291,6 +298,23 @@ defAction =

291single :: Endpoint -> Action -> API

298single :: Endpoint -> Action -> API

292single e a = API mempty (HM.singleton e a)

299single e a = API mempty (HM.singleton e a)

293

300

301+-- | How many examples should be shown?

302+data ShowContentTypes = AllContentTypes | FirstContentType

303+ deriving (Eq, Ord, Show, Read, Bounded, Enum)

304+

305+-- | Customise how an 'API' is converted into documentation.

306+data ApiOptions = ApiOptions

307+ { _requestExamples :: !ShowContentTypes

308+ , _responseExamples :: !ShowContentTypes

309+ } deriving (Show)

310+

311+-- | Default API generation options.

312+defApiOptions :: ApiOptions

313+defApiOptions = ApiOptions

314+ { _requestExamples = AllContentTypes

315+ , _responseExamples = AllContentTypes

316+ }

317+

294-- gimme some lenses

318-- gimme some lenses

295makeLenses ''DocAuthentication

319makeLenses ''DocAuthentication

296makeLenses ''DocOptions

320makeLenses ''DocOptions

@@ -302,6 +326,7 @@ makeLenses ''DocIntro

302makeLenses ''DocNote

326makeLenses ''DocNote

303makeLenses ''Response

327makeLenses ''Response

304makeLenses ''Action

328makeLenses ''Action

329+makeLenses ''ApiOptions

305

330

306-- | Generate the docs for a given API that implements 'HasDocs'. This is the

331-- | Generate the docs for a given API that implements 'HasDocs'. This is the

307-- default way to create documentation.

332-- default way to create documentation.

@@ -518,7 +543,10 @@ class ToAuthInfo a where

518-- | Generate documentation in Markdown format for

543-- | Generate documentation in Markdown format for

519-- the given 'API'.

544-- the given 'API'.

520markdown :: API -> String

545markdown :: API -> String

546+markdown = markdownWith defApiOptions

547+

548+markdownWith :: ApiOptions -> API -> String

521−markdown api = unlines $

549+markdownWith ApiOptions{..} api = unlines $

522 introsStr (api ^. apiIntros)

550 introsStr (api ^. apiIntros)

523 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)

551 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)

524

552

@@ -632,19 +660,34 @@ markdown api = unlines $

632 rqbodyStr types s =

660 rqbodyStr types s =

633 ["#### Request:", ""]

661 ["#### Request:", ""]

634 <> formatTypes types

662 <> formatTypes types

635− <> formatBodies s

663+ <> formatBodies _requestExamples s

636

664

637 formatTypes [] = []

665 formatTypes [] = []

638 formatTypes ts = ["- Supported content types are:", ""]

666 formatTypes ts = ["- Supported content types are:", ""]

639 <> map (\t -> " - `" <> show t <> "`") ts

667 <> map (\t -> " - `" <> show t <> "`") ts

640 <> [""]

668 <> [""]

641

669

670+ -- This assumes that when the bodies are created, identical

671+ -- labels and representations are located next to each other.

642− formatBodies :: [(Text, M.MediaType, ByteString)] -> [String]

672+ formatBodies :: ShowContentTypes -> [(Text, M.MediaType, ByteString)] -> [String]

643− formatBodies = concatMap formatBody

673+ formatBodies ex bds = concatMap formatBody (select bodyGroups)

644−

674+ where

645− formatBody (t, m, b) =

675+ bodyGroups :: [(Text, NonEmpty M.MediaType, ByteString)]

646− "- " <> cs t <> " (`" <> cs (show m) <> "`):" :

676+ bodyGroups =

677+ map (\grps -> let (t,_,b) = NE.head grps in (t, fmap (\(_,m,_) -> m) grps, b))

678+ . groupWith (\(t,_,b) -> (t,b))

679+ $ bds

680+

681+ select = case ex of

682+ AllContentTypes -> id

683+ FirstContentType -> map (\(t,ms,b) -> (t, NE.head ms :| [], b))

684+

685+ formatBody :: (Text, NonEmpty M.MediaType, ByteString) -> [String]

686+ formatBody (t, ms, b) =

687+ "- " <> cs t <> " (" <> mediaList ms <> "):" :

647− contentStr m b

688+ contentStr (NE.head ms) b

689+ where

690+ mediaList = fold . NE.intersperse ", " . fmap (\m -> "`" ++ show m ++ "`")

648

691

649 markdownForType mime_type =

692 markdownForType mime_type =

650 case (M.mainType mime_type, M.subType mime_type) of

693 case (M.mainType mime_type, M.subType mime_type) of

@@ -679,7 +722,10 @@ markdown api = unlines $

679 [] -> ["- No response body\n"]

722 [] -> ["- No response body\n"]

680 [("", t, r)] -> "- Response body as below." : contentStr t r

723 [("", t, r)] -> "- Response body as below." : contentStr t r

681 xs ->

724 xs ->

682− formatBodies xs

725+ formatBodies _responseExamples xs

726+

727+uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d

728+uncurry3 f (a,b,c) = f a b c

683

729

684-- * Instances

730-- * Instances

685

731