diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,6 +11,7 @@ This library uses [Data.Typeable](http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Typeable.html) to generate documentation for [Servant](https://hackage.haskell.org/package/servant) API types. + It relies on the `typeRep` of Servant's combinators and other datatypes used in the API to generate the documentation. @@ -18,103 +19,14 @@ 1) We need the `API Format types` inside the documentation. They can be used as keys -while querying an API endpoint, to look up examples, fields, and other -miscellaneous details. + to look up examples, fields, and other miscellaneous details. -2) We want to generate documentation from the information our `API` type provides, without having to write instances. +2) We want to generate an overview of our endpoints from the information our + `API` type provides, without having to write instances. [**In-depth explanation here**](https://github.com/Holmusk/servant-docs-simple#faq) -# Functionality - -## Servant.Docs.Simple.Parse - -*Parses the API into a documentation friendly structure* - -**API type** - -``` haskell -type API = "hello" :> "world" :> Request :> Response -type Request = ReqBody '[()] () -type Response = Post '[()] () - -``` - -**Intermediate structure** - -``` haskell -Endpoints [Node "/hello/world" - (Details [ Node "RequestBody" (Details [ Node "Format" - (Detail "': * () ('[] *)") - , Node "ContentType" - (Detail "()") - ]) - , Node "RequestType" (Detail "'POST") - , Node "Response" (Details [ Node "Format" - (Detail "': * () ('[] *)") - , Node "ContentType" - (Detail "()") - ]) - ])] -``` - -## Servant.Docs.Simple.Render - -*Renders the intermediate structure into common documentation formats* - -**Intermediate structure** - -``` haskell -Endpoints [Node "/hello/world" - (Details [ Node "RequestBody" (Details [ Node "Format" - (Detail "': * () ('[] *)") - , Node "ContentType" - (Detail "()") - ]) - , Node "RequestType" (Detail "'POST") - , Node "Response" (Details [ Node "Format" - (Detail "': * () ('[] *)") - , Node "ContentType" - (Detail "()") - ]) - ])] -``` - - -**JSON** - -``` json -{ - "/hello/world": { - "Response": { - "Format": "': * () ('[] *)", - "ContentType": "()" - }, - "RequestType": "'POST", - "RequestBody": { - "Format": "': * () ('[] *)", - "ContentType": "()" - } - } -} -``` - -**Text** - -``` text -/hello/world: -RequestBody: - Format: ': * () ('[] *) - ContentType: () -RequestType: 'POST -Response: - Format: ': * () ('[] *) - ContentType: () -``` - -## Servant.Docs.Simple - -*Provides functions to write rendered formats to file/stdout* +# Example usage **Using this script** @@ -127,13 +39,8 @@ module Main where -import Data.Aeson (Value) -import Data.Text (Text) - import Servant.API ((:>), Post, ReqBody) -import Servant.Docs.Simple (document, documentWith, stdoutJson, stdoutPlainText, writeDocsJson, - writeDocsPlainText) -import Servant.Docs.Simple.Render (Json (..), PlainText (..)) +import Servant.Docs.Simple (writeDocsJson, rriteDocsPlainText) -- Our API type type API = "hello" :> "world" :> Request :> Response @@ -146,12 +53,13 @@ writeDocsJson @API "docs.json" -- Writes to the file $PWD/docsPlainText - writeDocsPlainText @API "docs.txt" + writeDocsPlainText @API "docs.txt" + ``` **Expected Output** -*Files should be generated relative to $PWD* +*Files should be generated relative to `$PWD`* ``` sh $ ls | grep docs @@ -194,12 +102,14 @@ **Click on these links for tutorials** -[Generating plaintext/JSON documentation from api types](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/render.hs) +[Generating plaintext/JSON documentation from api types](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/generate.hs) [Generating the intermediate documentation structure](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/parse.hs) -[Writing our own rendering format](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/format.hs) +[Writing our own rendering format](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/render.hs) +[Parsing custom API combinators](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/custom.hs) + **To run tutorial scripts** ``` sh @@ -214,7 +124,7 @@ **What's the usecase for this?** -1) Lightweight documentation solution. +1) Lightweight documentation solution by providing an overview of endpoints. 2) Keeping documentation for types in one place diff --git a/servant-docs-simple.cabal b/servant-docs-simple.cabal --- a/servant-docs-simple.cabal +++ b/servant-docs-simple.cabal @@ -1,12 +1,13 @@ cabal-version: 2.4 name: servant-docs-simple -version: 0.1.0.0 -synopsis: Generate documentation via TypeRep for Servant API +version: 0.2.0.0 +synopsis: Generate endpoints overview for Servant API description: This library uses [Data.Typeable](http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Typeable.html) to generate documentation for [Servant](https://hackage.haskell.org/package/servant) API types. + It relies on the `typeRep` of Servant's combinators and other datatypes used in the API to generate the documentation. @@ -31,12 +32,14 @@ common common-options build-depends: base >= 4.11.1.0 && < 4.14 - , aeson >= 1.4.6 && < 1.5 - , aeson-pretty >= 0.8.8 && < 0.9 + , aeson >= 1.4.2 && < 1.5 + , aeson-pretty >= 0.8.7 && < 0.9 , bytestring >= 0.10.8.2 && < 0.11 - , prettyprinter >= 1.2.1.1 && < 1.7 - , servant >= 0.16 && < 0.18 + , ordered-containers >= 0.2.2 && < 0.3 + , prettyprinter >= 1.2.1 && < 1.7 + , servant >= 0.15 && < 0.18 , text >= 1.2.3.1 && < 1.3 + , unordered-containers >= 0.2.10 && < 0.3 ghc-options: -Wall -Wcompat diff --git a/src/Servant/Docs/Simple.hs b/src/Servant/Docs/Simple.hs --- a/src/Servant/Docs/Simple.hs +++ b/src/Servant/Docs/Simple.hs @@ -1,4 +1,71 @@ --- | Documentation for API endpoints +{- | Parse and render an API type, write documentation to file, stdout + +__Example script__ + +[Writing documentation to file](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/generate.hs) + +/With the following language extensions/ + +> DataKinds +> TypeApplications +> TypeOperators + +/Using this script/ + +> module Main where +> +> import Servant.API ((:>), Post, ReqBody) +> import Servant.Docs.Simple (writeDocsJson, writeDocsPlainText) +> +> -- Our API type +> type API = "hello" :> "world" :> Request :> Response +> type Request = ReqBody '[()] () +> type Response = Post '[()] () +> +> main :: IO () +> main = do +> -- Writes to the file $PWD/docsJson +> writeDocsJson @API "docs.json" +> +> -- Writes to the file $PWD/docsPlainText +> writeDocsPlainText @API "docs.txt" + +__Expected Output__ + +/Files should be generated relative to @$PWD@/ + +> $ ls | grep docs +> docs.json +> docs.txt + +/docs.json/ + +> { +> "/hello/world": { +> "Response": { +> "Format": "': * () ('[] *)", +> "ContentType": "()" +> }, +> "RequestType": "'POST", +> "RequestBody": { +> "Format": "': * () ('[] *)", +> "ContentType": "()" +> } +> } +> } + +/docs.txt/ + +> /hello/world: +> RequestBody: +> Format: ': * () ('[] *) +> ContentType: () +> RequestType: 'POST +> Response: +> Format: ': * () ('[] *) +> ContentType: () + +-} module Servant.Docs.Simple ( document , documentWith diff --git a/src/Servant/Docs/Simple/Parse.hs b/src/Servant/Docs/Simple/Parse.hs --- a/src/Servant/Docs/Simple/Parse.hs +++ b/src/Servant/Docs/Simple/Parse.hs @@ -1,11 +1,61 @@ {- | Parse Servant API into documentation + +__Example script__ + +[Generating the intermediate documentation structure](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/parse.hs) + +[Parsing custom API type combinators](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/custom.hs) + +__Example of parsing an API__ + +/API type/ + +> type API = "hello" :> "world" :> Request :> Response +> type Request = ReqBody '[()] () +> type Response = Post '[()] () + +/Intermediate structure/ + +> ApiDocs ( fromList [( "/hello/world", +> , Details (fromList ([ ( "RequestBody" +> , Details (fromList ([ ( "Format" +> , Detail "': * () ('[] *)" +> ) +> , ( "ContentType" +> , Detail "()" +> ) +> ])) +> ) +> , ( "RequestType" +> , Detail "'POST" +> ) +> , ( "Response" +> , Details (fromList ([ ( "Format" +> , Detail "': * () ('[] *)" +> ) +> , ( "ContentType" +> , Detail "()" +> ) +> ])) +> ) +> ])) +> )]) + -} + {-# LANGUAGE UndecidableInstances #-} -module Servant.Docs.Simple.Parse (HasParsable (..)) where +module Servant.Docs.Simple.Parse + ( HasDocumentApi (..) + , HasParsable (..) + , symbolVal' + , toDetails + , typeText + ) where import Data.Foldable (fold) +import Data.Map.Ordered (OMap, empty, fromList, (|<)) import Data.Proxy import Data.Text (Text, pack) import Data.Typeable (Typeable, typeRep) @@ -16,41 +66,45 @@ ReqBody', StreamBody', Summary, Vault, Verb) import qualified Servant.API.TypeLevel as S (Endpoints) -import Servant.Docs.Simple.Render (Details (..), Endpoints (..), Node (..)) +import Servant.Docs.Simple.Render (ApiDocs (..), Details (..), Parameter, Route) --- | Flattens API into type level list of 'Endpoints' +-- | Flattens API into type level list of Endpoints class HasParsable api where - parse :: Endpoints + parse :: ApiDocs +-- | If the flattened API can be collated into documentation, it is parsable instance HasCollatable (S.Endpoints a) => HasParsable a where parse = collate @(S.Endpoints a) +-- | Empty APIs should have no documentation instance {-# OVERLAPPING #-} HasParsable EmptyAPI where parse = collate @'[] -- | Folds api endpoints into documentation class HasCollatable api where -- | Folds list of endpoints to documentation - collate :: Endpoints + collate :: ApiDocs +-- | Collapse a type-level list of API endpoints into documentation instance (HasDocumentApi api, HasCollatable b) => HasCollatable (api ': b) where - collate = Endpoints $ documentEndpoint @api : previous - where Endpoints previous = collate @b + collate = ApiDocs $ (Details <$> documentEndpoint @api) |< previous + where ApiDocs previous = collate @b +-- | Terminal step when there are no more endpoints left to recurse over instance HasCollatable '[] where - collate = Endpoints [] + collate = ApiDocs empty -- | Folds an api endpoint into documentation -documentEndpoint :: forall a. HasDocumentApi a => Node +documentEndpoint :: forall a. HasDocumentApi a => (Route, OMap Parameter Details) documentEndpoint = document @a "" [] -- | Folds an api endpoint into documentation class HasDocumentApi api where -- | We use this to destructure the API type and convert it into documentation - document :: Text -- ^ Route documentation - -> [Node] -- ^ Everything else documentation - -> Node -- ^ Generated documentation for the route + document :: Route -- ^ Route documentation + -> [(Parameter, Details)] -- ^ Everything else documentation + -> (Route, OMap Parameter Details) -- ^ Generated documentation for the route -- | Static route documentation instance (HasDocumentApi b, KnownSymbol route) => HasDocumentApi ((route :: Symbol) :> b) where @@ -74,113 +128,112 @@ -- | Request HttpVersion documentation instance HasDocumentApi b => HasDocumentApi (HttpVersion :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "Captures Http Version" (Detail "True") + document r a = document @b r $ a <> [("Captures Http Version", Detail "True")] -- | IsSecure documentation instance HasDocumentApi b => HasDocumentApi (IsSecure :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "SSL Only" (Detail "True") + document r a = document @b r $ a <> [("SSL Only", Detail "True")] -- | Request Remote host documentation instance HasDocumentApi b => HasDocumentApi (RemoteHost :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "Captures RemoteHost/IP" (Detail "True") + document r a = document @b r $ a <> [("Captures RemoteHost/IP", Detail "True")] -- | Description documentation instance (HasDocumentApi b, KnownSymbol desc) => HasDocumentApi (Description (desc :: Symbol) :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "Description" (Detail $ symbolVal' @desc) + document r a = document @b r $ a <> [("Description", Detail $ symbolVal' @desc)] -- | Summary documentation instance (HasDocumentApi b, KnownSymbol s) => HasDocumentApi (Summary (s :: Symbol) :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "Summary" (Detail $ symbolVal' @s) + document r a = document @b r $ a <> [("Summary", Detail $ symbolVal' @s)] -- | Vault documentation instance HasDocumentApi b => HasDocumentApi (Vault :> b) where - document r a = document @b r (a <> [desc]) - where desc = Node "Vault" (Detail "True") + document r a = document @b r $ a <> [("Vault", Detail "True")] -- | Basic authentication documentation instance (HasDocumentApi b, KnownSymbol realm, Typeable a) => HasDocumentApi (BasicAuth (realm :: Symbol) a :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "Basic Authentication" $ - Details [ Node "Realm" (Detail realm) - , Node "UserData" (Detail userData) - ] - realm = symbolVal' @realm + document r a = document @b r $ a <> [( "Basic Authentication" + , toDetails [ ("Realm", Detail realm) + , ("UserData", Detail userData) + ] + )] + + where realm = symbolVal' @realm userData = typeText @a -- | Authentication documentation instance (HasDocumentApi b, KnownSymbol token) => HasDocumentApi (AuthProtect (token :: Symbol) :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "Authentication" (Detail authDoc) - authDoc = symbolVal' @token + document r a = document @b r $ a <> [("Authentication", Detail authDoc)] + where authDoc = symbolVal' @token -- | Request header documentation instance (HasDocumentApi b, KnownSymbol ct, Typeable typ) => HasDocumentApi (Header' m (ct :: Symbol) typ :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "RequestHeaders" $ - Details [ Node "Name" (Detail $ symbolVal' @ct) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = document @b r $ a <> [( "RequestHeaders" + , toDetails [ ("Name", Detail $ symbolVal' @ct) + , ("ContentType", Detail $ typeText @typ) + ] + )] -- | Query flag documentation instance (HasDocumentApi b, KnownSymbol param) => HasDocumentApi (QueryFlag (param :: Symbol) :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "QueryFlag" $ - Details [ Node "Param" (Detail $ symbolVal' @param) ] + document r a = document @b r $ a <> [( "QueryFlag" + , toDetails [ ("Param", Detail $ symbolVal' @param) ] + )] -- | Query param documentation instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParam' m (param :: Symbol) typ :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "QueryParam" $ - Details [ Node "Param" (Detail $ symbolVal' @param) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = document @b r $ a <> [( "QueryParam" + , toDetails [ ("Param", Detail $ symbolVal' @param) + , ("ContentType", Detail $ typeText @typ) + ] + )] -- | Query params documentation instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParams (param :: Symbol) typ :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "QueryParams" $ - Details [ Node "Param" (Detail $ symbolVal' @param) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = document @b r $ a <> [( "QueryParams" + , toDetails [ ("Param", Detail $ symbolVal' @param) + , ("ContentType", Detail $ typeText @typ) + ] + )] -- | Request body documentation instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (ReqBody' m ct typ :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "RequestBody" $ - Details [ Node "Format" (Detail $ typeText @ct) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = document @b r $ a <> [( "RequestBody" + , toDetails [ ("Format", Detail $ typeText @ct) + , ("ContentType", Detail $ typeText @typ) + ] + )] -- | Stream body documentation instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (StreamBody' m ct typ :> b) where - document r a = document @b r (a <> [formatted]) - where formatted = Node "StreamBody" $ - Details [ Node "Format" (Detail $ typeText @ct) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = document @b r $ a <> [( "StreamBody" + , toDetails [ ("Format", Detail $ typeText @ct) + , ("ContentType", Detail $ typeText @typ) + ] + )] -- | Response documentation -- Terminates here as responses are last parts of api endpoints -- Note that request type information (GET, POST etc...) is contained here instance (Typeable m, Typeable ct, Typeable typ) => HasDocumentApi (Verb m s ct typ) where - document r a = Node r $ - Details (a <> [ requestType - , response - ]) - where requestType = Node "RequestType" (Detail $ typeText @m) - response = Node "Response" $ - Details [ Node "Format" (Detail $ typeText @ct) - , Node "ContentType" (Detail $ typeText @typ) - ] + document r a = ( r + , fromList $ a <> [requestType, response] + ) + where requestType = ("RequestType", Detail $ typeText @m) + response = ( "Response" + , toDetails [ ("Format", Detail $ typeText @ct) + , ("ContentType", Detail $ typeText @typ) + ] + ) --- | Internal Helper utilities +-- | Convert parameter-value pairs to Details type +toDetails :: [(Text, Details)] -> Details +toDetails = Details . fromList + +-- | Convert types to Text typeText :: forall a. (Typeable a) => Text typeText = pack . show . typeRep $ Proxy @a +-- | Convert symbol to Text symbolVal' :: forall n. KnownSymbol n => Text symbolVal' = pack . symbolVal $ Proxy @n diff --git a/src/Servant/Docs/Simple/Render.hs b/src/Servant/Docs/Simple/Render.hs --- a/src/Servant/Docs/Simple/Render.hs +++ b/src/Servant/Docs/Simple/Render.hs @@ -1,19 +1,89 @@ --- | Provides an Intermediate documentation structure ('Endpoints'), and renderable formats ('Renderable') -module Servant.Docs.Simple.Render ( Details (..) - , Endpoints (..) - , Node (..) - , Renderable (..) - , Json (..) - , Pretty (..) - , PlainText (..) - ) where +{- | Renders the intermediate structure into common documentation formats -import Data.Aeson (ToJSON (..), Value (..), object, (.=)) +__Example scripts__ + +[Generating plaintext/JSON documentation from api types](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/generate.hs) + +[Writing our own rendering format](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/render.hs) + +__Example of rendering the intermediate structure__ + +/Intermediate structure/ + +> ApiDocs ( fromList [( "/hello/world", +> , Details (fromList ([ ( "RequestBody" +> , Details (fromList ([ ( "Format" +> , Detail "': * () ('[] *)" +> ) +> , ( "ContentType" +> , Detail "()" +> ) +> ])) +> ) +> , ( "RequestType" +> , Detail "'POST" +> ) +> , ( "Response" +> , Details (fromList ([ ( "Format" +> , Detail "': * () ('[] *)" +> ) +> , ( "ContentType" +> , Detail "()" +> ) +> ])) +> ) +> ])) +> )]) + + +/JSON/ + +> { +> "/hello/world": { +> "Response": { +> "Format": "': * () ('[] *)", +> "ContentType": "()" +> }, +> "RequestType": "'POST", +> "RequestBody": { +> "Format": "': * () ('[] *)", +> "ContentType": "()" +> } +> } +> } + +/Text/ + +> /hello/world: +> RequestBody: +> Format: ': * () ('[] *) +> ContentType: () +> RequestType: 'POST +> Response: +> Format: ': * () ('[] *) +> ContentType: () + +-} + +module Servant.Docs.Simple.Render + ( ApiDocs (..) + , Details (..) + , Renderable (..) + , Parameter + , Route + , Json (..) + , Pretty (..) + , PlainText (..) + ) where + +import Data.Aeson (ToJSON (..), Value (..)) +import Data.HashMap.Strict (fromList) import Data.List (intersperse) +import Data.Map.Ordered (OMap, assocs) import Data.Text (Text, pack) import Data.Text.Prettyprint.Doc (Doc, cat, line, nest, pretty, vcat, vsep) --- | Intermediate documentation structure, a linked-list of endpoints (__'Node's__) +-- | Intermediate documentation structure, a hashmap of endpoints -- -- API type: -- @@ -21,104 +91,105 @@ -- > :<|> "get" :> Response '[()] () -- > ) -- --- Parsed into Endpoints: +-- Parsed into ApiDocs: -- --- > Endpoints [ Node "/users/update" --- > (Details [ Node "Response" --- > (Details [ Node "Format" (Detail "': * () ('[] *)") --- > , Node "ContentType" (Detail "()") --- > ]) --- > ]) --- > , Node "/users/get" --- > (Details [ Node "Response" --- > (Details [ Node "Format" (Detail "': * () ('[] *)") --- > , Node "ContentType" (Detail "()") --- > ]) --- > ]) --- > ] -- --- For a breakdown reference 'Node' +-- > ApiDocs ( fromList [ ( "/users/update", +-- > , Details (fromList ([ ( "Response" +-- > , Details (fromList ([ ( "Format" +-- > , Detail "': * () ('[] *)" +-- > ) +-- > , ( "ContentType" +-- > , Detail "()" +-- > ) +-- > ])) +-- > ) +-- > ])) +-- > ) +-- > , ( "/users/get", +-- > , Details (fromList ([ ( "Response" +-- > , Details (fromList ([ ( "Format" +-- > , Detail "': * () ('[] *)" +-- > ) +-- > , ( "ContentType" +-- > , Detail "()" +-- > ) +-- > ])) +-- > ) +-- > ])) +-- > ) +-- > ]) -- -- For more examples reference [Test.Servant.Docs.Simple.Samples](https://github.com/Holmusk/servant-docs-simple/blob/master/test/Test/Servant/Docs/Simple/Samples.hs) -- -newtype Endpoints = Endpoints [Node] deriving stock (Eq, Show) +newtype ApiDocs = ApiDocs (OMap Route Details) deriving stock (Eq, Show) --- | Key-Value pair for endpoint parameters and their values --- --- __Example 1__ --- --- An endpoint is represented as a node, with the __route__ as its parameter and its Details as its value --- --- > Node "/users/get"
--- --- __Example 2__ --- --- Details of each endpoint can also be represented as nodes --- --- Given the following: --- --- > Response '[()] () --- --- This can be interpreted as a __Response__ parameter, with a value of 2 Details, __Format__ and __ContentType__ +-- | Route representation +type Route = Text + +-- | Details of the Api Route -- --- In turn, this: +-- __Examples__ -- --- > Format: @'[()]@ +-- > Authentication: true -- --- can be interpreted as a __Format__ parameter with a value of __@'[()]@__. +-- Can be interpreted as a Parameter (Authentication) and a /Detail/ (true) -- --- And so parsing __@Response '[()] ()@__ comes together as: +-- > Response: +-- > Format: ... +-- > ContentType: ... -- --- > Node "Response" --- Parameter --- > (Details [ Node "Format" -- Parameter --- --- > (Detail "': * () ('[] *)") -- Value | --- > , Node "ContentType" -- Parameter | Value --- > (Detail "()") -- Value | --- > ]) --- +-- Can be interpreted as a Parameter (Response) and /Details/ (Format (...), ContentType (...)) -- - -data Node = Node Text -- ^ Parameter name - Details -- ^ Parameter value(s) - deriving stock (Eq, Show) - --- | Value representation; see 'Endpoints' and 'Node' documentation for a clearer picture -data Details = Details [Node] -- ^ List of Parameter-Value pairs +data Details = Details (OMap Parameter Details) -- ^ OMap of Parameter-Details | Detail Text -- ^ Single Value deriving stock (Eq, Show) --- | Convert __Endpoints__ into different documentation formats +-- | Parameter names +type Parameter = Text + +-- | Convert ApiDocs into different documentation formats class Renderable a where - render :: Endpoints -> a + render :: ApiDocs -> a -- | Conversion to JSON using Data.Aeson newtype Json = Json { getJson :: Value } deriving stock (Eq, Show) + +-- | Conversion to JSON using Data.Aeson instance Renderable Json where - render = Json . toJSON + render = Json . toJSON -instance ToJSON Endpoints where - toJSON (Endpoints endpoints) = toJSON $ Details endpoints +-- | Json instance for the endpoints hashmap +instance ToJSON ApiDocs where + toJSON (ApiDocs endpoints) = toJSON . fromList . assocs $ endpoints +-- | Json instance for the parameter hashmap of each endpoint instance ToJSON Details where - toJSON (Detail t) = String t - toJSON (Details ls) = object . fmap jsonify $ ls - where jsonify (Node name details) = name .= toJSON details + toJSON (Detail t) = String t + toJSON (Details ls) = toJSON . fromList . assocs $ ls -- | Conversion to prettyprint newtype Pretty ann = Pretty { getPretty :: Doc ann } +-- | Conversion to prettyprint instance Renderable (Pretty ann) where - render = Pretty . prettyPrint + render = Pretty . prettyPrint -prettyPrint :: Endpoints -> Doc ann -prettyPrint (Endpoints ls) = vcat . intersperse line $ toDoc 0 <$> ls +-- | Helper function to prettyprint the ApiDocs +prettyPrint :: ApiDocs -> Doc ann +prettyPrint (ApiDocs endpoints) = vcat . intersperse line + $ uncurry (toDoc 0) <$> assocs endpoints -toDoc :: Int -> Node -> Doc ann -toDoc i (Node t d) = case d of +-- | Helper function +toDoc :: Int -> Text -> Details -> Doc ann +toDoc i t d = case d of Detail a -> cat [pretty t, ": ", pretty a] Details as -> nest i . vsep $ pretty t <> ":" - : (toDoc (i + 4) <$> as) + : (uncurry (toDoc (i + 4)) <$> assocs as) -- | Conversion to plaintext newtype PlainText = PlainText { getPlainText :: Text } deriving stock (Eq, Show) + +-- | Conversion to plaintext instance Renderable PlainText where - render = PlainText . pack . show . getPretty . render + render = PlainText . pack . show . getPretty . render diff --git a/test/Test/Servant/Docs/Simple/Parse.hs b/test/Test/Servant/Docs/Simple/Parse.hs --- a/test/Test/Servant/Docs/Simple/Parse.hs +++ b/test/Test/Servant/Docs/Simple/Parse.hs @@ -3,6 +3,7 @@ module Test.Servant.Docs.Simple.Parse (parseSpec) where +import Data.Map.Ordered (empty) import Servant.API (EmptyAPI) import Test.Hspec (Spec, describe, it, shouldBe) @@ -10,13 +11,13 @@ apiMultipleParsed) import Servant.Docs.Simple.Parse (parse) -import Servant.Docs.Simple.Render (Endpoints (..)) +import Servant.Docs.Simple.Render (ApiDocs (..)) parseSpec :: Spec parseSpec = describe "Parses API to Document Tree" $ do it "parses an EmptyAPI Details" $ - parse @EmptyAPI `shouldBe` Endpoints [] + parse @EmptyAPI `shouldBe` ApiDocs empty it "parses all Servant API Combinators" $ parse @ApiComplete `shouldBe` apiCompleteParsed it "parses an API with multiple endpoints" $ diff --git a/test/Test/Servant/Docs/Simple/Samples.hs b/test/Test/Servant/Docs/Simple/Samples.hs --- a/test/Test/Servant/Docs/Simple/Samples.hs +++ b/test/Test/Servant/Docs/Simple/Samples.hs @@ -5,20 +5,21 @@ apiCompleteParsed, apiCompleteJson, apiMultipleParsed) where import Data.Aeson (Value (String), object) +import Data.Map.Ordered (fromList, singleton) import Servant.API ((:<|>), (:>), AuthProtect, BasicAuth, Capture, CaptureAll, Description, Header, HttpVersion, IsSecure, Post, QueryFlag, QueryParam, QueryParams, RemoteHost, ReqBody, StreamBody, Summary, Vault) import Text.RawString.QQ (r) -import Servant.Docs.Simple.Render (Details (..), Endpoints (..), Json (..), Node (..), - PlainText (..)) +import Servant.Docs.Simple.Parse (toDetails) +import Servant.Docs.Simple.Render (ApiDocs (..), Details (..), Json (..), PlainText (..)) type ApiComplete = StaticRouteTest :> DynRouteTest :> CaptureAllTest :> ApiDetails -apiCompleteParsed :: Endpoints -apiCompleteParsed = Endpoints [ Node "/test_route/{test::()}/{test::()}" apiDetails ] +apiCompleteParsed :: ApiDocs +apiCompleteParsed = ApiDocs $ curry singleton "/test_route/{test::()}/{test::()}" apiDetails apiCompleteJson :: Json apiCompleteJson = Json (object [ ( "/test_route/{test::()}/{test::()}" @@ -115,11 +116,11 @@ :<|> "route2" :> DynRouteTest :> CaptureAllTest :> ApiDetails :<|> "route3" :> DynRouteTest :> CaptureAllTest :> ApiDetails -apiMultipleParsed :: Endpoints -apiMultipleParsed = Endpoints [ Node "/route1/{test::()}/{test::()}" apiDetails - , Node "/route2/{test::()}/{test::()}" apiDetails - , Node "/route3/{test::()}/{test::()}" apiDetails - ] +apiMultipleParsed :: ApiDocs +apiMultipleParsed = ApiDocs $ fromList [ ("/route1/{test::()}/{test::()}", apiDetails) + , ("/route2/{test::()}/{test::()}", apiDetails) + , ("/route3/{test::()}/{test::()}", apiDetails) + ] type ApiDetails = HttpVersionTest @@ -139,38 +140,46 @@ :> ResponseTest apiDetails :: Details -apiDetails = Details [ Node "Captures Http Version" (Detail "True") - , Node "SSL Only" (Detail "True") - , Node "Captures RemoteHost/IP" (Detail "True") - , Node "Description" (Detail "sampleText") - , Node "Summary" (Detail "sampleText") - , Node "Vault" (Detail "True") - , Node "Basic Authentication" (Details [ Node "Realm" (Detail "local") - , Node "UserData" (Detail "()")]) +apiDetails = toDetails [ ("Captures Http Version", Detail "True") + , ("SSL Only", Detail "True") + , ("Captures RemoteHost/IP", Detail "True") + , ("Description", Detail "sampleText") + , ("Summary", Detail "sampleText") + , ("Vault", Detail "True") + , ("Basic Authentication", toDetails [ ("Realm", Detail "local") + , ("UserData", Detail "()") + ]) - , Node "Authentication" (Detail "TEST_JWT") + , ("Authentication", Detail "TEST_JWT") - , Node "RequestHeaders" (Details [ Node "Name" (Detail "test") - , Node "ContentType" (Detail "()")]) + , ("RequestHeaders", toDetails [ ("Name", Detail "test") + , ("ContentType", Detail "()") + ]) - , Node "QueryFlag" (Details [Node "Param" (Detail "test")]) + , ("QueryFlag", Details $ curry singleton "Param" (Detail "test")) - , Node "QueryParam" (Details [ Node "Param" (Detail "test") - , Node "ContentType" (Detail "()")]) + , ("QueryParam", toDetails [ ("Param", Detail "test") + , ("ContentType", Detail "()") + ]) - , Node "QueryParams" (Details [ Node "Param" (Detail "test") - , Node "ContentType" (Detail "()")]) + , ("QueryParams", toDetails [ ("Param", Detail "test") + , ("ContentType", Detail "()") + ]) - , Node "RequestBody" (Details [ Node "Format" (Detail "': * () ('[] *)") - , Node "ContentType" (Detail "()")]) + , ("RequestBody", toDetails [ ("Format", Detail "': * () ('[] *)") + , ("ContentType", Detail "()") + ]) - , Node "StreamBody" (Details [ Node "Format" (Detail "()") - , Node "ContentType" (Detail "()")]) + , ("StreamBody", toDetails [ ("Format", Detail "()") + , ("ContentType", Detail "()") + ]) - , Node "RequestType" (Detail "'POST") + , ("RequestType", Detail "'POST") - , Node "Response" (Details [ Node "Format" (Detail "': * () ('[] *)") - , Node "ContentType" (Detail "()")])] + , ("Response", toDetails [ ("Format", Detail "': * () ('[] *)") + , ("ContentType", Detail "()") + ]) + ] type StaticRouteTest = "test_route"