@@ -8,6 +8,9 @@
8{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE ConstraintKinds #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+{-# LANGUAGE PolyKinds #-}
12-------------------------------------------------------------------------------
15-------------------------------------------------------------------------------
13-- | This module lets you get API docs for free. It lets generate
16-- | This module lets you get API docs for free. It lets generate
@@ -128,7 +131,9 @@
128-- > main = putStrLn $ markdown docsGreet
131-- > main = putStrLn $ markdown docsGreet
129module Servant.Docs
132module Servant.Docs
130 ( -- * 'HasDocs' class and key functions
133 ( -- * '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
133 , -- * Classes you need to implement for your types
138 , -- * Classes you need to implement for your types
134 ToSample(..)
139 ToSample(..)
@@ -169,7 +174,9 @@ import Data.Text (Text, pack, unpack)
169import Data.String.Conversions
174import Data.String.Conversions
170import GHC.Generics
175import GHC.Generics
171import GHC.TypeLits
176import GHC.TypeLits
177+import GHC.Exts(Constraint)
172import Servant.API
178import Servant.API
179+import Servant.Utils.Links
174import qualified Data.HashMap.Strict as HM
181import qualified Data.HashMap.Strict as HM
175import qualified Data.Text as T
182import qualified Data.Text as T
@@ -343,12 +350,21 @@ data Action = Action
343 { _captures :: [DocCapture] -- type collected + user supplied info
350 { _captures :: [DocCapture] -- type collected + user supplied info
344 , _headers :: [Text] -- type collected
351 , _headers :: [Text] -- type collected
345 , _params :: [DocQueryParam] -- type collected + user supplied info
352 , _params :: [DocQueryParam] -- type collected + user supplied info
346− , _notes :: [DocNote] -- user supplied
347 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
353 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
354+ , _notes :: [DocNote] -- user supplied
348 , _rqbody :: Maybe ByteString -- user supplied
355 , _rqbody :: Maybe ByteString -- user supplied
349 , _response :: Response -- user supplied
356 , _response :: Response -- user supplied
350 } deriving (Eq, Show)
357 } deriving (Eq, Show)
359+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
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
352-- Default 'Action'. Has no 'captures', no GET 'params', expects
368-- Default 'Action'. Has no 'captures', no GET 'params', expects
353-- no request body ('rqbody') and the typical response is 'defResponse'.
369-- no request body ('rqbody') and the typical response is 'defResponse'.
@@ -389,10 +405,51 @@ makeLenses ''Action
389docs :: HasDocs layout => Proxy layout -> API
405docs :: HasDocs layout => Proxy layout -> API
390docs p = docsFor p (defEndpoint, defAction)
406docs p = docsFor p (defEndpoint, defAction)
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
415+-- | Closed type family, check if endpoint is exactly within API.
417+-- We aren't sure what affects how an Endpoint is built up, so we require an
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
425+safeInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
426+ => Proxy endpoint -> Action -> ExtraInfo layout
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
433+-- | Generate documentation given some initial state, in which you may wish to
434+-- note that certain endpoints are special in some way.
436+-- If you only want to add an introduction, use 'docsWithIntros'.
438+-- You are expected to build up the SafeMap with safeEntry
439+docsWith :: HasDocs layout
444+docsWith intros (ExtraInfo endpoints) p =
445+ docs p & apiIntros <>~ intros
446+ & apiEndpoints %~ HM.unionWith combineAction endpoints
392-- | Generate the docs for a given API that implements 'HasDocs' with with any
449-- | Generate the docs for a given API that implements 'HasDocs' with with any
393-- number of introduction(s)
450-- number of introduction(s)
394docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
451docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
395−docsWithIntros intros p = docs p & apiIntros <>~ intros
452+docsWithIntros intros = docsWith intros mempty
397-- | The class that abstracts away the impact of API combinators
454-- | The class that abstracts away the impact of API combinators
398-- on documentation generation.
455-- on documentation generation.