From aa64d7a0bfec0d5c91631e7559f071f292f059a0 Mon Sep 17 00:00:00 2001 From: Christian Marie Date: Fri, 23 Jan 2015 12:19:37 +1100 Subject: [PATCH 1/2] Add DocIntro and DocNote types to allow extra docs This commit provides a way for a user to add information to either the beginning of the output, and for a HasDoc instance to add extra sections to an endpoint. See example/greet.hs for usage of the Intro type. --- example/greet.hs | 22 ++++++-- example/greet.md | 33 +++++++----- src/Servant/Docs.hs | 121 +++++++++++++++++++++++++++++++++++++++----- 3 files changed, 146 insertions(+), 30 deletions(-) diff --git a/example/greet.hs b/example/greet.hs index 38a29292..1bb36c4a 100644 --- a/example/greet.hs +++ b/example/greet.hs @@ -6,7 +6,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} import Data.Aeson import Data.Proxy -import Data.Text +import Data.Text(Text) import GHC.Generics import Servant.API import Servant.Docs @@ -44,6 +44,17 @@ instance ToSample Greet where , ("If you use ?capital=false", Greet "Hello, haskeller") ] +instance ToIntro "on proper introductions" where + toIntro _ = DocIntro "On proper introductions." -- The title + [ "Hello there." + , "As documentation is usually written for humans, it's often useful \ + \to introduce concepts with a few words." ] -- Elements are paragraphs + +instance ToIntro "on zebras" where + toIntro _ = DocIntro "This title is below the last" + [ "You'll also note that multiple intros are possible." ] + + -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON @@ -56,14 +67,17 @@ type TestApi = -- DELETE /greet/:greetid :<|> "greet" :> Capture "greetid" Text :> Delete -testApi :: Proxy TestApi -testApi = Proxy +type IntroducedApi = + Intro "on proper introductions" :> Intro "on zebras" :> TestApi + +introducedApi :: Proxy IntroducedApi +introducedApi = Proxy -- Generate the data that lets us have API docs. This -- is derived from the type as well as from -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above. docsGreet :: API -docsGreet = docs testApi +docsGreet = docs introducedApi main :: IO () main = putStrLn $ markdown docsGreet diff --git a/example/greet.md b/example/greet.md index 284c7eeb..fa870ac5 100644 --- a/example/greet.md +++ b/example/greet.md @@ -1,7 +1,16 @@ -POST /greet ------------ +#### On proper introductions. -**Request Body**: +Hello there. + +As documentation is usually written for humans, it's often useful to introduce concepts with a few words. + +#### This title is below the last + +You'll also note that multiple intros are possible. + +## POST /greet + +#### Request Body: ``` javascript { @@ -9,7 +18,7 @@ POST /greet } ``` -**Response**: +#### Response: - Status code 201 - If you use ?capital=true @@ -28,21 +37,20 @@ POST /greet } ``` -GET /hello/:name ----------------- +## GET /hello/:name -**Captures**: +#### Captures: - *name*: name of the person to greet -**GET Parameters**: +#### GET Parameters: - capital - **Values**: *true, false* - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false. -**Response**: +#### Response: - Status code 200 - If you use ?capital=true @@ -61,14 +69,13 @@ GET /hello/:name } ``` -DELETE /greet/:greetid ----------------------- +## DELETE /greet/:greetid -**Captures**: +#### Captures: - *greetid*: identifier of the greet msg to remove -**Response**: +#### Response: - Status code 204 - No response body diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index c1f4aa92..0c35a89b 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} @@ -91,6 +92,7 @@ module Servant.Docs , sampleByteStrings , ToParam(..) , ToCapture(..) + , ToIntro(..) , -- * ADTs to represent an 'API' Method(..) @@ -98,8 +100,10 @@ module Servant.Docs , API, emptyAPI , DocCapture(..), capSymbol, capDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind + , DocNote(..), noteTitle, noteBody + , DocIntro(..), Intro , Response, respStatus, respBody, defResponse - , Action, captures, headers, params, rqbody, response, defAction + , Action, captures, headers, notes, params, rqbody, response, defAction , single , -- * Useful modules when defining your doc printers @@ -110,6 +114,7 @@ module Servant.Docs import Control.Lens hiding (Action) import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Ord(comparing) import Data.ByteString.Lazy.Char8 (ByteString) import Data.Hashable import Data.HashMap.Strict (HashMap) @@ -188,12 +193,36 @@ defEndpoint = Endpoint [] DocGET instance Hashable Endpoint --- | Our API type, a good old hashmap from 'Endpoint' to 'Action' -type API = HashMap Endpoint Action +-- | Our API documentation type, a product of top-level information and a good +-- old hashmap from 'Endpoint' to 'Action' +data API = API + { _apiIntros :: [DocIntro] + , _apiEndpoints :: HashMap Endpoint Action + } deriving (Eq, Show) + +instance Monoid API where + API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2) + mempty = API mempty mempty + +-- | A way for a developer to insert an introductory paragraph manually. This +-- is not to be used in server or client facing API types. +-- +-- Example: +-- +-- > type OurAPI = "users" :> Get [User] +-- > type IntroducedAPI = Intro "of human bondage" :> OurAPI +-- > +-- > instance ToIntro "of human bondage" where +-- > toIntro = DocIntro "A title for the intro section" +-- > [ "A blob of text that will be at the top." +-- > , "List elements are paragraphs." +-- > ] +-- +data Intro (name :: Symbol) -- | An empty 'API' emptyAPI :: API -emptyAPI = HM.empty +emptyAPI = mempty -- | A type to represent captures. Holds the name of the capture -- and a description. @@ -216,6 +245,26 @@ data DocQueryParam = DocQueryParam , _paramKind :: ParamKind } deriving (Eq, Show) +-- | An introductory paragraph for your documentation. You can attach these +-- with the 'Intro' type. +-- +data DocIntro = DocIntro + { _introTitle :: String -- ^ Appears above the intro blob + , _introBody :: [String] -- ^ Each String is a paragraph. + } deriving (Eq, Show) + +instance Ord DocIntro where + compare = comparing _introTitle + +-- | A type to represent extra notes that may be attached to an 'Action'. +-- +-- This is intended to be used when writing your own HasDocs instances to +-- add extra sections to your endpoint's documentation. +data DocNote = DocNote + { _noteTitle :: String + , _noteBody :: [String] + } deriving (Eq, Show) + -- | Type of GET parameter: -- -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter @@ -268,6 +317,7 @@ data Action = Action { _captures :: [DocCapture] -- type collected + user supplied info , _headers :: [Text] -- type collected , _params :: [DocQueryParam] -- type collected + user supplied info + , _notes :: [DocNote] -- user supplied , _rqbody :: Maybe ByteString -- user supplied , _response :: Response -- user supplied } deriving (Eq, Show) @@ -284,6 +334,7 @@ data Action = Action defAction :: Action defAction = Action [] + [] [] [] Nothing @@ -293,12 +344,15 @@ defAction = -- 'API' is a 'Monoid', so combine multiple endpoints with -- 'mappend' or '<>'. single :: Endpoint -> Action -> API -single = HM.singleton +single e a = API mempty (HM.singleton e a) -- gimme some lenses +makeLenses ''API makeLenses ''Endpoint makeLenses ''DocCapture makeLenses ''DocQueryParam +makeLenses ''DocIntro +makeLenses ''DocNote makeLenses ''Response makeLenses ''Action @@ -382,16 +436,26 @@ class ToParam t where class ToCapture c where toCapture :: Proxy c -> DocCapture +-- | The class to define the contents of an 'Intro' +-- Example of an instance: +-- +-- > instance ToIntro "an intro" where +-- > toIntro _ = DocIntro "This is some text" +class ToIntro (intro :: Symbol) where + toIntro :: Proxy intro -> DocIntro + -- | Generate documentation in Markdown format for -- the given 'API'. markdown :: API -> String -markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList +markdown api = unlines $ + introsStr (api ^. apiIntros) + ++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints) where printEndpoint :: Endpoint -> Action -> [String] printEndpoint endpoint action = str : - replicate len '-' : "" : + notesStr (action ^. notes) ++ capturesStr (action ^. captures) ++ headersStr (action ^. headers) ++ paramsStr (action ^. params) ++ @@ -399,13 +463,35 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList responseStr (action ^. response) ++ [] - where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path) - len = length str + where str = "## " ++ show (endpoint^.method) + ++ " " ++ showPath (endpoint^.path) + + introsStr :: [DocIntro] -> [String] + introsStr = concatMap introStr + + introStr :: DocIntro -> [String] + introStr i = + ("#### " ++ i ^. introTitle) : + "" : + intersperse "" (i ^. introBody) ++ + "" : + [] + + notesStr :: [DocNote] -> [String] + notesStr = concatMap noteStr + + noteStr :: DocNote -> [String] + noteStr nt = + ("#### " ++ nt ^. noteTitle) : + "" : + intersperse "" (nt ^. noteBody) ++ + "" : + [] capturesStr :: [DocCapture] -> [String] capturesStr [] = [] capturesStr l = - "**Captures**: " : + "#### Captures:" : "" : map captureStr l ++ "" : @@ -423,7 +509,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList paramsStr :: [DocQueryParam] -> [String] paramsStr [] = [] paramsStr l = - "**GET Parameters**: " : + "#### GET Parameters:" : "" : map paramStr l ++ "" : @@ -448,7 +534,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList rqbodyStr :: Maybe ByteString -> [String] rqbodyStr Nothing = [] rqbodyStr (Just b) = - "**Request Body**: " : + "#### Request Body:" : jsonStr b jsonStr b = @@ -461,7 +547,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList responseStr :: Response -> [String] responseStr resp = - "**Response**: " : + "#### Response:" : "" : (" - Status code " ++ show (resp ^. respStatus)) : bodies @@ -607,6 +693,15 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh endpoint' = endpoint & path <>~ [symbolVal pa] pa = Proxy :: Proxy path +instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro) + => HasDocs (Intro intro :> sublayout) where + + docsFor Proxy x = + docsFor sublayoutP x & apiIntros %~ (toIntro intro <|) + where sublayoutP = Proxy :: Proxy sublayout + intro :: Proxy intro + intro = Proxy + {- -- | Serve your API's docs as markdown embedded in an html \
 tag.

From b85a90c4f5c2cc64f10474916c68d6c7bce54acc Mon Sep 17 00:00:00 2001
From: Christian Marie 
Date: Fri, 30 Jan 2015 15:45:00 +1100
Subject: [PATCH 2/2] Add docsWithIntros function, update documentation

---
 example/greet.hs    |  26 ++++----
 src/Servant/Docs.hs | 143 +++++++++++++++++++++++---------------------
 2 files changed, 89 insertions(+), 80 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 1bb36c4a..95588deb 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -14,7 +14,7 @@ import Servant.Docs
 -- * Example
 
 -- | A greet message data type
-newtype Greet = Greet { msg :: Text }
+newtype Greet = Greet Text
   deriving (Generic, Show)
 
 instance FromJSON Greet
@@ -33,7 +33,8 @@ instance ToParam (QueryParam "capital" Bool) where
   toParam _ =
     DocQueryParam "capital"
                   ["true", "false"]
-                  "Get the greeting message in uppercase (true) or not (false). Default is false."
+                  "Get the greeting message in uppercase (true) or not (false).\
+                  \Default is false."
                   Normal
 
 instance ToSample Greet where
@@ -44,14 +45,14 @@ instance ToSample Greet where
     , ("If you use ?capital=false", Greet "Hello, haskeller")
     ]
 
-instance ToIntro "on proper introductions" where
-  toIntro _ = DocIntro "On proper introductions." -- The title
+intro1 :: DocIntro
+intro1 = DocIntro "On proper introductions." -- The title
     [ "Hello there."
     , "As documentation is usually written for humans, it's often useful \
       \to introduce concepts with a few words." ] -- Elements are paragraphs
 
-instance ToIntro "on zebras" where
-  toIntro _ = DocIntro "This title is below the last"
+intro2 :: DocIntro
+intro2 = DocIntro "This title is below the last"
     [ "You'll also note that multiple intros are possible." ]
 
 
@@ -67,17 +68,18 @@ type TestApi =
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete
 
-type IntroducedApi =
-    Intro "on proper introductions" :> Intro "on zebras" :> TestApi
-
-introducedApi :: Proxy IntroducedApi
-introducedApi = Proxy
+testApi :: Proxy TestApi
+testApi = Proxy
 
 -- Generate the data that lets us have API docs. This
 -- is derived from the type as well as from
 -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
+--
+-- If you didn't want intros you could just call:
+--
+-- > docs testAPI
 docsGreet :: API
-docsGreet = docs introducedApi
+docsGreet = docsWithIntros [intro1, intro2] testApi
 
 main :: IO ()
 main = putStrLn $ markdown docsGreet
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 0c35a89b..77000510 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -15,7 +15,12 @@
 --
 -- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
 --
--- You can then call 'markdown' on it:
+-- Alternately, if you wish to add one or more introductions to your
+-- documentation, use 'docsWithIntros':
+--
+-- @docsWithIntros :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
+--
+-- You can then call 'markdown' on the 'API' value:
 --
 -- @markdown :: 'API' -> String@
 --
@@ -30,61 +35,92 @@
 -- markdown pretty printer in action:
 --
 -- > {-# LANGUAGE DataKinds #-}
--- > {-# LANGUAGE PolyKinds #-}
--- > {-# LANGUAGE TypeFamilies #-}
 -- > {-# LANGUAGE DeriveGeneric #-}
 -- > {-# LANGUAGE TypeOperators #-}
 -- > {-# LANGUAGE FlexibleInstances #-}
 -- > {-# LANGUAGE OverloadedStrings #-}
--- >
+-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
+-- > import Data.Aeson
 -- > import Data.Proxy
--- > import Data.Text
--- > import Servant
+-- > import Data.Text(Text)
+-- > import GHC.Generics
+-- > import Servant.API
+-- > import Servant.Docs
 -- >
--- > -- our type for a Greeting message
--- > data Greet = Greet { _msg :: Text }
+-- > -- * Example
+-- >
+-- > -- | A greet message data type
+-- > newtype Greet = Greet Text
 -- >   deriving (Generic, Show)
 -- >
--- > -- we get our JSON serialization for free
 -- > instance FromJSON Greet
 -- > instance ToJSON Greet
 -- >
--- > -- we provide a sample value for the 'Greet' type
--- > instance ToSample Greet where
--- >   toSample = Just g
--- >
--- >     where g = Greet "Hello, haskeller!"
--- >
--- > instance ToParam (QueryParam "capital" Bool) where
--- >   toParam _ =
--- >     DocQueryParam "capital"
--- >                   ["true", "false"]
--- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
--- >
+-- > -- We add some useful annotations to our captures,
+-- > -- query parameters and request body to make the docs
+-- > -- really helpful.
 -- > instance ToCapture (Capture "name" Text) where
 -- >   toCapture _ = DocCapture "name" "name of the person to greet"
 -- >
 -- > instance ToCapture (Capture "greetid" Text) where
 -- >   toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
 -- >
+-- > instance ToParam (QueryParam "capital" Bool) where
+-- >   toParam _ =
+-- >     DocQueryParam "capital"
+-- >                   ["true", "false"]
+-- >                   "Get the greeting message in uppercase (true) or not (false).\
+-- >                   \Default is false."
+-- >                   Normal
+-- >
+-- > instance ToSample Greet where
+-- >   toSample = Just $ Greet "Hello, haskeller!"
+-- >
+-- >   toSamples =
+-- >     [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
+-- >     , ("If you use ?capital=false", Greet "Hello, haskeller")
+-- >     ]
+-- >
+-- > intro1 :: DocIntro
+-- > intro1 = DocIntro "On proper introductions." -- The title
+-- >     [ "Hello there."
+-- >     , "As documentation is usually written for humans, it's often useful \
+-- >       \to introduce concepts with a few words." ] -- Elements are paragraphs
+-- >
+-- > intro2 :: DocIntro
+-- > intro2 = DocIntro "This title is below the last"
+-- >     [ "You'll also note that multiple intros are possible." ]
+-- >
+-- >
 -- > -- API specification
 -- > type TestApi =
+-- >        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
 -- >        "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
--- >   :<|> "greet" :> RQBody Greet :> Post Greet
--- >   :<|> "delete" :> Capture "greetid" Text :> Delete
+-- >
+-- >        -- POST /greet with a Greet as JSON in the request body,
+-- >        --             returns a Greet as JSON
+-- >   :<|> "greet" :> ReqBody Greet :> Post Greet
+-- >
+-- >        -- DELETE /greet/:greetid
+-- >   :<|> "greet" :> Capture "greetid" Text :> Delete
 -- >
 -- > testApi :: Proxy TestApi
 -- > testApi = Proxy
 -- >
--- > -- Generate the Documentation's ADT
--- > greetDocs :: API
--- > greetDocs = docs testApi
--- >
+-- > -- Generate the data that lets us have API docs. This
+-- > -- is derived from the type as well as from
+-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
+-- > --
+-- > -- If you didn't want intros you could just call:
+-- > --
+-- > -- > docs testAPI
+-- > docsGreet :: API
+-- > docsGreet = docsWithIntros [intro1, intro2] testApi
 -- > main :: IO ()
--- > main = putStrLn $ markdown greetDocs
+-- > main = putStrLn $ markdown docsGreet
 module Servant.Docs
   ( -- * 'HasDocs' class and key functions
-    HasDocs(..), docs, markdown
+    HasDocs(..), docs, docsWithIntros, markdown
 
   , -- * Classes you need to implement for your types
     ToSample(..)
@@ -92,7 +128,6 @@ module Servant.Docs
   , sampleByteStrings
   , ToParam(..)
   , ToCapture(..)
-  , ToIntro(..)
 
   , -- * ADTs to represent an 'API'
     Method(..)
@@ -101,7 +136,7 @@ module Servant.Docs
   , DocCapture(..), capSymbol, capDesc
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
   , DocNote(..), noteTitle, noteBody
-  , DocIntro(..), Intro
+  , DocIntro(..)
   , Response, respStatus, respBody, defResponse
   , Action, captures, headers, notes, params, rqbody, response, defAction
   , single
@@ -204,22 +239,6 @@ instance Monoid API where
     API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
     mempty = API mempty mempty
 
--- | A way for a developer to insert an introductory paragraph manually. This
--- is not to be used in server or client facing API types.
---
--- Example:
---
--- > type OurAPI = "users" :> Get [User]
--- > type IntroducedAPI = Intro "of human bondage" :> OurAPI
--- >
--- > instance ToIntro "of human bondage" where
--- >    toIntro = DocIntro "A title for the intro section"
--- >      [ "A blob of text that will be at the top."
--- >      , "List elements are paragraphs."
--- >      ]
---
-data Intro (name :: Symbol)
-
 -- | An empty 'API'
 emptyAPI :: API
 emptyAPI = mempty
@@ -245,9 +264,8 @@ data DocQueryParam = DocQueryParam
   , _paramKind   :: ParamKind
   } deriving (Eq, Show)
 
--- | An introductory paragraph for your documentation. You can attach these
--- with the 'Intro' type.
---
+-- | An introductory paragraph for your documentation. You can pass these to
+-- 'docsWithIntros'.
 data DocIntro = DocIntro
   { _introTitle :: String   -- ^ Appears above the intro blob
   , _introBody  :: [String] -- ^ Each String is a paragraph.
@@ -356,10 +374,16 @@ makeLenses ''DocNote
 makeLenses ''Response
 makeLenses ''Action
 
--- | Generate the docs for a given API that implements 'HasDocs'.
+-- | Generate the docs for a given API that implements 'HasDocs'. This is the
+-- default way to create documentation.
 docs :: HasDocs layout => Proxy layout -> API
 docs p = docsFor p (defEndpoint, defAction)
 
+-- | Generate the docs for a given API that implements 'HasDocs' with with any
+-- number of introduction(s)
+docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
+docsWithIntros intros p = docs p & apiIntros <>~ intros
+
 -- | The class that abstracts away the impact of API combinators
 --   on documentation generation.
 class HasDocs layout where
@@ -436,14 +460,6 @@ class ToParam t where
 class ToCapture c where
   toCapture :: Proxy c -> DocCapture
 
--- | The class to define the contents of an 'Intro'
--- Example of an instance:
---
--- > instance ToIntro "an intro" where
--- >   toIntro _ = DocIntro "This is some text"
-class ToIntro (intro :: Symbol) where
-    toIntro :: Proxy intro -> DocIntro
-
 -- | Generate documentation in Markdown format for
 --   the given 'API'.
 markdown :: API -> String
@@ -693,15 +709,6 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
           endpoint' = endpoint & path <>~ [symbolVal pa]
           pa = Proxy :: Proxy path
 
-instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro)
-      => HasDocs (Intro intro :> sublayout) where
-
-  docsFor Proxy x =
-    docsFor sublayoutP x & apiIntros %~ (toIntro intro <|)
-    where sublayoutP = Proxy :: Proxy sublayout
-          intro :: Proxy intro
-          intro = Proxy
-
 {-
 
 -- | Serve your API's docs as markdown embedded in an html \
 tag.