@@ -1,16 +1,16 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TemplateHaskell #-}
10−{-# LANGUAGE TupleSections #-}
11−{-# LANGUAGE TypeFamilies #-}
12−{-# LANGUAGE TypeOperators #-}
13−{-# LANGUAGE UndecidableInstances #-}
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TupleSections #-}
5+{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE TemplateHaskell #-}
7+{-# LANGUAGE FlexibleContexts #-}
8+{-# LANGUAGE FlexibleInstances #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE ConstraintKinds #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+{-# LANGUAGE PolyKinds #-}
1414
1515-------------------------------------------------------------------------------
1616-- | This module lets you get API docs for free. It lets generate
@@ -37,15 +37,17 @@
3737-- Here's a little (but complete) example that you can run to see the
3838-- markdown pretty printer in action:
3939--
40−-- > {-# LANGUAGE DataKinds #-}
41−-- > {-# LANGUAGE DeriveGeneric #-}
42−-- > {-# LANGUAGE TypeOperators #-}
43−-- > {-# LANGUAGE FlexibleInstances #-}
44−-- > {-# LANGUAGE OverloadedStrings #-}
40+-- > {-# LANGUAGE DataKinds #-}
41+-- > {-# LANGUAGE DeriveGeneric #-}
42+-- > {-# LANGUAGE FlexibleInstances #-}
43+-- > {-# LANGUAGE MultiParamTypeClasses #-}
44+-- > {-# LANGUAGE OverloadedStrings #-}
45+-- > {-# LANGUAGE TypeOperators #-}
4546-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
4647-- > import Data.Aeson
4748-- > import Data.Proxy
48−-- > import Data.Text(Text)
49+-- > import Data.String.Conversions
50+-- > import Data.Text (Text)
4951-- > import GHC.Generics
5052-- > import Servant.API
5153-- > import Servant.Docs
@@ -56,9 +58,15 @@
5658-- > newtype Greet = Greet Text
5759-- > deriving (Generic, Show)
5860-- >
61+-- > -- | We can get JSON support automatically. This will be used to parse
62+-- > -- and encode a Greeting as 'JSON'.
5963-- > instance FromJSON Greet
6064-- > instance ToJSON Greet
6165-- >
66+-- > -- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
67+-- > instance MimeRender PlainText Greet where
68+-- > toByteString Proxy (Greet s) = "\"" <> cs s <> "\""
69+-- >
6270-- > -- We add some useful annotations to our captures,
6371-- > -- query parameters and request body to make the docs
6472-- > -- really helpful.
@@ -91,6 +99,11 @@
9199-- > , ("If you use ?capital=false", Greet "Hello, haskeller")
92100-- > ]
93101-- >
102+-- > -- We define some introductory sections, these will appear at the top of the
103+-- > -- documentation.
104+-- > --
105+-- > -- We pass them in with 'docsWith', below. If you only want to add
106+-- > -- introductions, you may use 'docsWithIntros'
94107-- > intro1 :: DocIntro
95108-- > intro1 = DocIntro "On proper introductions." -- The title
96109-- > [ "Hello there."
@@ -104,8 +117,8 @@
104117-- >
105118-- > -- API specification
106119-- > type TestApi =
107−-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON
108−-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
120+-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
121+-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
109122-- >
110123-- > -- POST /greet with a Greet as JSON in the request body,
111124-- > -- returns a Greet as JSON
@@ -117,21 +130,34 @@
117130-- > testApi :: Proxy TestApi
118131-- > testApi = Proxy
119132-- >
133+-- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We
134+-- > -- want to add documentation about a secret unicorn header and some extra
135+-- > -- notes.
136+-- > extra :: ExtraInfo TestApi
137+-- > extra =
138+-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
139+-- > defAction & headers <>~ ["unicorns"]
140+-- > & notes <>~ [ DocNote "Title" ["This is some text"]
141+-- > , DocNote "Second secton" ["And some more"]
142+-- > ]
143+-- >
120144-- > -- Generate the data that lets us have API docs. This
121145-- > -- is derived from the type as well as from
122146-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
123147-- > --
124−-- > -- If you didn't want intros you could just call:
148+-- > -- If you didn't want intros and extra information, you could just call:
125149-- > --
126−-- > -- > docs testAPI
150+-- > -- > docs testAPI :: API
127151-- > docsGreet :: API
128−-- > docsGreet = docsWithIntros [intro1, intro2] testApi
152+-- > docsGreet = docsWith [intro1, intro2] extra testApi
129153-- >
130154-- > main :: IO ()
131155-- > main = putStrLn $ markdown docsGreet
132156module Servant.Docs
133157 ( -- * 'HasDocs' class and key functions
134− HasDocs(..), docs, docsWithIntros, markdown
158+ HasDocs(..), docs, markdown
159+ -- * Generating docs with extra information
160+ , ExtraInfo(..), docsWith, docsWithIntros, extraInfo
135161
136162 , -- * Classes you need to implement for your types
137163 ToSample(..)
@@ -158,7 +184,7 @@ module Servant.Docs
158184 ) where
159185
160186import Control.Applicative
161−import Control.Lens
187+import Control.Lens hiding (Action)
162188import Data.Aeson
163189import Data.ByteString.Lazy.Char8 (ByteString)
164190import Data.Hashable
@@ -172,7 +198,9 @@ import Data.String.Conversions
172198import Data.Text (Text, pack, unpack)
173199import GHC.Generics
174200import GHC.TypeLits
201+import GHC.Exts(Constraint)
175202import Servant.API
203+import Servant.Utils.Links
176204import Servant.API.ContentTypes
177205
178206import qualified Data.HashMap.Strict as HM
@@ -296,6 +324,17 @@ data DocNote = DocNote
296324 , _noteBody :: [String]
297325 } deriving (Eq, Show)
298326
327+-- | Type of extra information that a user may wish to "union" with their
328+-- documentation.
329+--
330+-- These are intended to be built using extraInfo.
331+-- Multiple ExtraInfo may be combined with the monoid instance.
332+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
333+instance Monoid (ExtraInfo a) where
334+ mempty = ExtraInfo mempty
335+ ExtraInfo a `mappend` ExtraInfo b =
336+ ExtraInfo $ HM.unionWith combineAction a b
337+
299338-- | Type of GET parameter:
300339--
301340-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -357,6 +396,16 @@ data Action = Action
357396 , _response :: Response -- user supplied
358397 } deriving (Eq, Show)
359398
399+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
400+-- laws.
401+--
402+-- As such, we invent a non-commutative, left associative operation
403+-- 'combineAction' to mush two together taking the response, body and content
404+-- types from the very left.
405+combineAction :: Action -> Action -> Action
406+Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
407+ Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
408+
360409-- Default 'Action'. Has no 'captures', no GET 'params', expects
361410-- no request body ('rqbody') and the typical response is 'defResponse'.
362411--
@@ -398,10 +447,62 @@ makeLenses ''Action
398447docs :: HasDocs layout => Proxy layout -> API
399448docs p = docsFor p (defEndpoint, defAction)
400449
450+-- | Closed type family, check if endpoint is exactly within API.
451+
452+-- We aren't sure what affects how an Endpoint is built up, so we require an
453+-- exact match.
454+type family IsIn (endpoint :: *) (api :: *) :: Constraint where
455+ IsIn e (sa :<|> sb) = Or (IsIn e sa) (IsIn e sb)
456+ IsIn (e :> sa) (e :> sb) = IsIn sa sb
457+ IsIn e e = ()
458+
459+-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
460+--
461+-- The safety here is to ensure that you only add custom documentation to an
462+-- endpoint that actually exists within your API.
463+--
464+-- > extra :: ExtraInfo TestApi
465+-- > extra =
466+-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
467+-- > defAction & headers <>~ ["unicorns"]
468+-- > & notes <>~ [ DocNote "Title" ["This is some text"]
469+-- > , DocNote "Second secton" ["And some more"]
470+-- > ]
471+
472+extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
473+ => Proxy endpoint -> Action -> ExtraInfo layout
474+extraInfo p action =
475+ let api = docsFor p (defEndpoint, defAction)
476+ -- Assume one endpoint, HasLink constraint means that we should only ever
477+ -- point at one endpoint.
478+ in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
479+
480+-- | Generate documentation given some extra introductions (in the form of
481+-- 'DocInfo') and some extra endpoint documentation (in the form of
482+-- 'ExtraInfo'.
483+--
484+-- The extra introductions will be prepended to the top of the documentation,
485+-- before the specific endpoint documentation. The extra endpoint documentation
486+-- will be "unioned" with the automatically generated endpoint documentation.
487+--
488+-- You are expected to build up the ExtraInfo with the Monoid instance and
489+-- 'extraInfo'.
490+--
491+-- If you only want to add an introduction, use 'docsWithIntros'.
492+docsWith :: HasDocs layout
493+ => [DocIntro]
494+ -> ExtraInfo layout
495+ -> Proxy layout
496+ -> API
497+docsWith intros (ExtraInfo endpoints) p =
498+ docs p & apiIntros <>~ intros
499+ & apiEndpoints %~ HM.unionWith combineAction endpoints
500+
501+
401502-- | Generate the docs for a given API that implements 'HasDocs' with with any
402503-- number of introduction(s)
403504docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
404−docsWithIntros intros p = docs p & apiIntros <>~ intros
505+docsWithIntros intros = docsWith intros mempty
405506
406507-- | The class that abstracts away the impact of API combinators
407508-- on documentation generation.
@@ -567,10 +668,7 @@ markdown api = unlines $
567668 mxParamsStr l =
568669 "#### Matrix Parameters:" :
569670 "" :
570− map segmentStr l ++
571− "" :
572− []
573−
671+ map segmentStr l
574672 segmentStr :: (String, [DocQueryParam]) -> String
575673 segmentStr (segment, l) = unlines $
576674 ("**" ++ segment ++ "**:") :
@@ -620,7 +718,7 @@ markdown api = unlines $
620718 <> concatMap formatBody samples
621719
622720 formatTypes [] = []
623− formatTypes ts = ["- Supported content types are: ", ""]
721+ formatTypes ts = ["- Supported content types are:", ""]
624722 <> map (\t -> " - `" <> show t <> "`") ts
625723 <> [""]
626724
@@ -639,7 +737,7 @@ markdown api = unlines $
639737
640738 contentStr mime_type body =
641739 "" :
642− "``` " <> markdownForType mime_type :
740+ "```" <> markdownForType mime_type :
643741 cs body :
644742 "```" :
645743 "" :