@@ -8,6 +8,9 @@
88{-# LANGUAGE FlexibleInstances #-}
99{-# LANGUAGE OverloadedStrings #-}
1010{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE ConstraintKinds #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+{-# LANGUAGE PolyKinds #-}
1114
1215-------------------------------------------------------------------------------
1316-- | This module lets you get API docs for free. It lets generate
@@ -128,7 +131,9 @@
128131-- > main = putStrLn $ markdown docsGreet
129132module Servant.Docs
130133 ( -- * 'HasDocs' class and key functions
131− HasDocs(..), docs, docsWithIntros, markdown
134+ HasDocs(..), docs, markdown
135+ -- * Generating docs with extra information
136+ , ExtraInfo(..), docsWith, docsWithIntros, safeInfo
132137
133138 , -- * Classes you need to implement for your types
134139 ToSample(..)
@@ -169,7 +174,9 @@ import Data.Text (Text, pack, unpack)
169174import Data.String.Conversions
170175import GHC.Generics
171176import GHC.TypeLits
177+import GHC.Exts(Constraint)
172178import Servant.API
179+import Servant.Utils.Links
173180
174181import qualified Data.HashMap.Strict as HM
175182import qualified Data.Text as T
@@ -343,12 +350,21 @@ data Action = Action
343350 { _captures :: [DocCapture] -- type collected + user supplied info
344351 , _headers :: [Text] -- type collected
345352 , _params :: [DocQueryParam] -- type collected + user supplied info
346− , _notes :: [DocNote] -- user supplied
347353 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
354+ , _notes :: [DocNote] -- user supplied
348355 , _rqbody :: Maybe ByteString -- user supplied
349356 , _response :: Response -- user supplied
350357 } deriving (Eq, Show)
351358
359+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
360+-- laws.
361+--
362+-- As such, we invent a non-commutative, left associative operation
363+-- 'combineAction' to mush two together taking the response from the very left.
364+combineAction :: Action -> Action -> Action
365+Action c h p m n r resp `combineAction` Action c' h' p' m' n' r' _ =
366+ Action (c <> c') (h <> h') (p <> p') (m <> m') (n <> n') (r <> r') resp
367+
352368-- Default 'Action'. Has no 'captures', no GET 'params', expects
353369-- no request body ('rqbody') and the typical response is 'defResponse'.
354370--
@@ -389,10 +405,51 @@ makeLenses ''Action
389405docs :: HasDocs layout => Proxy layout -> API
390406docs p = docsFor p (defEndpoint, defAction)
391407
408+
409+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
410+instance Monoid (ExtraInfo a) where
411+ mempty = ExtraInfo mempty
412+ ExtraInfo a `mappend` ExtraInfo b =
413+ ExtraInfo $ HM.unionWith combineAction a b
414+
415+-- | Closed type family, check if endpoint is exactly within API.
416+
417+-- We aren't sure what affects how an Endpoint is built up, so we require an
418+-- exact match.
419+type family IsIn (endpoint :: *) (api :: *) :: Constraint where
420+ IsIn e (sa :<|> sb) = Or (IsIn e sa) (IsIn e sb)
421+ IsIn (e :> sa) (e :> sb) = IsIn sa sb
422+ IsIn e e = ()
423+
424+
425+safeInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
426+ => Proxy endpoint -> Action -> ExtraInfo layout
427+safeInfo p action =
428+ let api = docsFor p (defEndpoint, defAction)
429+ -- Assume one endpoint, HasLink constraint means that we should only ever
430+ -- point at one endpoint.
431+ in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
432+
433+-- | Generate documentation given some initial state, in which you may wish to
434+-- note that certain endpoints are special in some way.
435+--
436+-- If you only want to add an introduction, use 'docsWithIntros'.
437+--
438+-- You are expected to build up the SafeMap with safeEntry
439+docsWith :: HasDocs layout
440+ => [DocIntro]
441+ -> ExtraInfo layout
442+ -> Proxy layout
443+ -> API
444+docsWith intros (ExtraInfo endpoints) p =
445+ docs p & apiIntros <>~ intros
446+ & apiEndpoints %~ HM.unionWith combineAction endpoints
447+
448+
392449-- | Generate the docs for a given API that implements 'HasDocs' with with any
393450-- number of introduction(s)
394451docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
395−docsWithIntros intros p = docs p & apiIntros <>~ intros
452+docsWithIntros intros = docsWith intros mempty
396453
397454-- | The class that abstracts away the impact of API combinators
398455-- on documentation generation.