diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog + +`servant-docs-simple` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. + +## 0.1.0.0 + +* Initially created. + +[1]: https://pvp.haskell.org +[2]: https://github.com/Holmusk/servant-docs-simple/releases diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020 kwannoel + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,296 @@ +# servant-docs-simple + +[![Build status](https://img.shields.io/travis/holmusk/servant-docs-simple.svg?logo=travis)](https://travis-ci.org/holmusk/servant-docs-simple) +[![Hackage](https://img.shields.io/hackage/v/servant-docs-simple.svg?logo=haskell)](https://hackage.haskell.org/package/servant-docs-simple) +[![Stackage Lts](http://stackage.org/package/servant-docs-simple/badge/lts)](http://stackage.org/lts/package/servant-docs-simple) +[![Stackage Nightly](http://stackage.org/package/servant-docs-simple/badge/nightly)](http://stackage.org/nightly/package/servant-docs-simple) +[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) + +# Introduction + +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. + +**Why do we need this?** + + +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. + +2) We want to generate documentation 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* + +**Using this script** + +``` haskell +-- stack --system-ghc runghc --package servant-docs-simple +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + + +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 (..)) + +-- 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* + +``` sh +$ ls | grep docs +docs.json +docs.txt +``` + +*docs.json* + +``` json +{ + "/hello/world": { + "Response": { + "Format": "': * () ('[] *)", + "ContentType": "()" + }, + "RequestType": "'POST", + "RequestBody": { + "Format": "': * () ('[] *)", + "ContentType": "()" + } + } +} +``` + +*docs.txt* + +``` text +/hello/world: +RequestBody: + Format: ': * () ('[] *) + ContentType: () +RequestType: 'POST +Response: + Format: ': * () ('[] *) + ContentType: () +``` + +# Tutorials + +**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 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) + +**To run tutorial scripts** + +``` sh +# clone this repository +git clone git@github.com:Holmusk/servant-docs-simple.git + +# run the examples +stack examples/ +``` + +# FAQ + +**What's the usecase for this?** + +1) Lightweight documentation solution. + +2) Keeping documentation for types in one place + + Suppose we have a library of format types. These are shared between different + languages and formats. If we centralize all the information in this + library, we have one source of truth. + + ``` haskell + -- --- Format Types --- + -- | | + -- v v + type singleAPI = "hello" :> ReqBody '[JSON] User :> POST '[JSON] Message + data User = User Name Password deriving Typeable + data Messsage = Message Id Content deriving Typeable + + ``` + + We use these format types in our `API` as illustrated above. + Developers can use these format types to index the library, to find information + (examples, instances, ...) they need about the type. + +**What is required to achieve this?** + +1) We need documentation to be generated from the API type, without writing +extra instances for each **format type** we use. + + We can do this with `typeRep` from `Data.Typeable`. + + ``` sh + $ stack ghci + Prelude> import Data.Typeable + Prelude Data.Typeable> data Alignment = Good | Bad deriving Typeable + Prelude Data.Typeable> typeRep (Proxy :: Proxy Alignment) + Alignment + ``` + +2) We need access to the API format types (`Email`, `Users`, ...) in documentation. + + This is so we can index our library with these types to get the relevant + fields, examples for these. + +**Why don't we use Servant.Docs?** + +1) `Servant.Docs` generates documentation **only if** `Format Types` have + implemented the necessary instances. + + ``` haskell + -- Instances for format types; they provide examples for format types + + instance ToSample User where + toSamples _ = + + instance ToSample Message where + toSamples _ = + ``` + + Hence, we cannot generate documentation solely from the `Format Type`. + +2) In documentation generated by `Servant.Docs`, the format types mentioned above (`User`, +`Message`) are not included. This means we can't use them to index our library +to look for the relevant information. + +**What are the trade-offs?** + +1) Currently `Servant.Docs.Simple` does not support as many formats as +`Servant.Docs` (via `Servant.Docs.Pandoc`). + +2) Examples are not mandatory as you do not have to write instances for your format +types. + + This means that **if developers don't provide examples**, the generated + documentation would be **without them**. + + We can still provide these examples through: + + - The shared library of types + + - Using `Servant combinators` such as `Summary` and `Description`. + These are generated as part of Documentation through `Servant.Docs.Simple`. diff --git a/servant-docs-simple.cabal b/servant-docs-simple.cabal new file mode 100644 --- /dev/null +++ b/servant-docs-simple.cabal @@ -0,0 +1,96 @@ +cabal-version: 2.4 +name: servant-docs-simple +version: 0.1.0.0 +synopsis: Generate documentation via TypeRep 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. + +homepage: https://github.com/Holmusk/servant-docs-simple +bug-reports: https://github.com/Holmusk/servant-docs-simple/issues +license: MIT +license-file: LICENSE +author: kwannoel +maintainer: Holmusk +copyright: 2020 Holmusk +category: Utility +build-type: Simple +extra-doc-files: README.md + CHANGELOG.md +extra-source-files: README.md +tested-with: GHC == 8.6.5 + GHC == 8.8.2 + +source-repository head + type: git + location: https://github.com/Holmusk/servant-docs-simple.git + +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 + , bytestring >= 0.10.8.2 && < 0.11 + , prettyprinter >= 1.2.1.1 && < 1.7 + , servant >= 0.16 && < 0.18 + , text >= 1.2.3.1 && < 1.3 + + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + + default-language: Haskell2010 + default-extensions: AllowAmbiguousTypes + ConstraintKinds + DataKinds + DerivingStrategies + FlexibleInstances + FunctionalDependencies + OverloadedStrings + PolyKinds + ScopedTypeVariables + TypeApplications + TypeFamilies + TypeOperators + +library + import: common-options + hs-source-dirs: src + + exposed-modules: Servant.Docs.Simple + Servant.Docs.Simple.Parse + Servant.Docs.Simple.Render + +test-suite servant-docs-simple-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + + build-depends: servant-docs-simple + , hspec >= 2.7.1 && < 2.8 + , hspec-core >= 2.7.1 && < 2.8 + , raw-strings-qq >= 1.1 && < 1.2 + + other-modules: Test.Servant.Docs.Simple + Test.Servant.Docs.Simple.Render + Test.Servant.Docs.Simple.Parse + Test.Servant.Docs.Simple.Samples + + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N diff --git a/src/Servant/Docs/Simple.hs b/src/Servant/Docs/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Docs/Simple.hs @@ -0,0 +1,41 @@ +-- | Documentation for API endpoints + +module Servant.Docs.Simple ( document + , documentWith + , stdoutJson + , stdoutPlainText + , writeDocsJson + , writeDocsPlainText + ) where + +import Data.Aeson.Encode.Pretty (encodePretty) +import qualified Data.ByteString.Lazy as B (writeFile) +import qualified Data.ByteString.Lazy.Char8 as BC (putStrLn) +import qualified Data.Text.IO as T (putStrLn, writeFile) +import Servant.Docs.Simple.Parse (HasParsable (..)) +import Servant.Docs.Simple.Render (Json (..), PlainText (..), Renderable (..)) + + +-- | Write documentation as PlainText to file +writeDocsPlainText :: forall api. HasParsable api => FilePath -> IO () +writeDocsPlainText fp = T.writeFile fp . getPlainText $ document @api + +-- | Write documentation as JSON to file +writeDocsJson :: forall api. HasParsable api => FilePath -> IO () +writeDocsJson fp = B.writeFile fp . encodePretty . getJson $ documentWith @api @Json + +-- | Write documentation as PlainText to stdout +stdoutPlainText :: forall api. HasParsable api => IO () +stdoutPlainText = T.putStrLn . getPlainText $ document @api + +-- | Write documentation as JSON to stdout +stdoutJson :: forall api. HasParsable api => IO () +stdoutJson = BC.putStrLn . encodePretty . getJson $ documentWith @api @Json + +-- | Convert API type into PlainText format +document :: forall api. HasParsable api => PlainText +document = documentWith @api @PlainText + +-- | Convert API type into specified formats +documentWith :: forall api a. (HasParsable api, Renderable a) => a +documentWith = render @a (parse @api) diff --git a/src/Servant/Docs/Simple/Parse.hs b/src/Servant/Docs/Simple/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Docs/Simple/Parse.hs @@ -0,0 +1,186 @@ +{- | Parse Servant API into documentation +-} +{-# LANGUAGE UndecidableInstances #-} + +module Servant.Docs.Simple.Parse (HasParsable (..)) where + + +import Data.Foldable (fold) +import Data.Proxy +import Data.Text (Text, pack) +import Data.Typeable (Typeable, typeRep) +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) + +import Servant.API ((:>), AuthProtect, BasicAuth, Capture', CaptureAll, Description, EmptyAPI, + Header', HttpVersion, IsSecure, QueryFlag, QueryParam', QueryParams, RemoteHost, + ReqBody', StreamBody', Summary, Vault, Verb) +import qualified Servant.API.TypeLevel as S (Endpoints) + +import Servant.Docs.Simple.Render (Details (..), Endpoints (..), Node (..)) + +-- | Flattens API into type level list of 'Endpoints' +class HasParsable api where + parse :: Endpoints + +instance HasCollatable (S.Endpoints a) => HasParsable a where + parse = collate @(S.Endpoints a) + +instance {-# OVERLAPPING #-} HasParsable EmptyAPI where + parse = collate @'[] + +-- | Folds api endpoints into documentation +class HasCollatable api where + -- | Folds list of endpoints to documentation + collate :: Endpoints + +instance (HasDocumentApi api, HasCollatable b) => HasCollatable (api ': b) where + collate = Endpoints $ documentEndpoint @api : previous + where Endpoints previous = collate @b + +instance HasCollatable '[] where + collate = Endpoints [] + +-- | Folds an api endpoint into documentation +documentEndpoint :: forall a. HasDocumentApi a => Node +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 + +-- | Static route documentation +instance (HasDocumentApi b, KnownSymbol route) => HasDocumentApi ((route :: Symbol) :> b) where + document r = document @b formatted + where formatted = fold [r, "/", fragment] + fragment = symbolVal' @route + +-- | Capture documentation +instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (Capture' m (dRoute :: Symbol) t :> b) where + document r = document @b formatted + where formatted = fold [r, "/", "{", var, "::", format, "}"] + var = symbolVal' @dRoute + format = typeText @t + +-- | CaptureAll documentation +instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (CaptureAll (dRoute :: Symbol) t :> b) where + document r = document @b formatted + where formatted = fold [r, "/", "{", var, "::", format, "}"] + var = symbolVal' @dRoute + format = typeText @t + +-- | 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") + +-- | IsSecure documentation +instance HasDocumentApi b => HasDocumentApi (IsSecure :> b) where + document r a = document @b r (a <> [desc]) + where desc = Node "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") + +-- | 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) + +-- | 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) + +-- | Vault documentation +instance HasDocumentApi b => HasDocumentApi (Vault :> b) where + document r a = document @b r (a <> [desc]) + where desc = Node "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 + 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 + +-- | 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) + ] + +-- | 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) ] + +-- | 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) + ] + +-- | 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) + ] + +-- | 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) + ] + +-- | 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) + ] + +-- | 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) + ] + +-- | Internal Helper utilities +typeText :: forall a. (Typeable a) => Text +typeText = pack . show . typeRep $ Proxy @a + +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 new file mode 100644 --- /dev/null +++ b/src/Servant/Docs/Simple/Render.hs @@ -0,0 +1,124 @@ +-- | Provides an Intermediate documentation structure ('Endpoints'), and renderable formats ('Renderable') +module Servant.Docs.Simple.Render ( Details (..) + , Endpoints (..) + , Node (..) + , Renderable (..) + , Json (..) + , Pretty (..) + , PlainText (..) + ) where + +import Data.Aeson (ToJSON (..), Value (..), object, (.=)) +import Data.List (intersperse) +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__) +-- +-- API type: +-- +-- > type API = "users" :> ( "update" :> Response '[()] () +-- > :<|> "get" :> Response '[()] () +-- > ) +-- +-- Parsed into Endpoints: +-- +-- > 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' +-- +-- 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) + +-- | 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__ +-- +-- In turn, this: +-- +-- > Format: @'[()]@ +-- +-- can be interpreted as a __Format__ parameter with a value of __@'[()]@__. +-- +-- And so parsing __@Response '[()] ()@__ comes together as: +-- +-- > Node "Response" --- Parameter +-- > (Details [ Node "Format" -- Parameter --- +-- > (Detail "': * () ('[] *)") -- Value | +-- > , Node "ContentType" -- Parameter | Value +-- > (Detail "()") -- Value | +-- > ]) --- +-- + +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 + | Detail Text -- ^ Single Value + deriving stock (Eq, Show) + +-- | Convert __Endpoints__ into different documentation formats +class Renderable a where + render :: Endpoints -> a + +-- | Conversion to JSON using Data.Aeson +newtype Json = Json { getJson :: Value } deriving stock (Eq, Show) +instance Renderable Json where + render = Json . toJSON + +instance ToJSON Endpoints where + toJSON (Endpoints endpoints) = toJSON $ Details endpoints + +instance ToJSON Details where + toJSON (Detail t) = String t + toJSON (Details ls) = object . fmap jsonify $ ls + where jsonify (Node name details) = name .= toJSON details + +-- | Conversion to prettyprint +newtype Pretty ann = Pretty { getPretty :: Doc ann } + +instance Renderable (Pretty ann) where + render = Pretty . prettyPrint + +prettyPrint :: Endpoints -> Doc ann +prettyPrint (Endpoints ls) = vcat . intersperse line $ toDoc 0 <$> ls + +toDoc :: Int -> Node -> Doc ann +toDoc i (Node t d) = case d of + Detail a -> cat [pretty t, ": ", pretty a] + Details as -> nest i . vsep $ pretty t <> ":" + : (toDoc (i + 4) <$> as) + +-- | Conversion to plaintext +newtype PlainText = PlainText { getPlainText :: Text } deriving stock (Eq, Show) +instance Renderable PlainText where + render = PlainText . pack . show . getPretty . render diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,12 @@ +import Test.Hspec +import Test.Hspec.Core.Spec (sequential) + +import Test.Servant.Docs.Simple (mainSpec) +import Test.Servant.Docs.Simple.Parse (parseSpec) +import Test.Servant.Docs.Simple.Render (renderSpec) + +main :: IO () +main = hspec $ sequential $ do + renderSpec + parseSpec + mainSpec diff --git a/test/Test/Servant/Docs/Simple.hs b/test/Test/Servant/Docs/Simple.hs new file mode 100644 --- /dev/null +++ b/test/Test/Servant/Docs/Simple.hs @@ -0,0 +1,18 @@ +-- | Unit tests for generating documentation of api + +module Test.Servant.Docs.Simple (mainSpec) where + + +import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Servant.Docs.Simple.Samples + +import Servant.Docs.Simple (document, documentWith) +import Servant.Docs.Simple.Render (Json) + + +mainSpec :: Spec +mainSpec = describe "Generates Documentation" $ do + it "should generate Plaintext" $ + document @ApiComplete `shouldBe` apiCompletePlainText + it "should generate JSON" $ + documentWith @ApiComplete @Json `shouldBe` apiCompleteJson diff --git a/test/Test/Servant/Docs/Simple/Parse.hs b/test/Test/Servant/Docs/Simple/Parse.hs new file mode 100644 --- /dev/null +++ b/test/Test/Servant/Docs/Simple/Parse.hs @@ -0,0 +1,23 @@ +-- | Unit tests for generating documentation of api + +module Test.Servant.Docs.Simple.Parse (parseSpec) where + + +import Servant.API (EmptyAPI) +import Test.Hspec (Spec, describe, it, shouldBe) + +import Test.Servant.Docs.Simple.Samples (ApiComplete, ApiMultiple, apiCompleteParsed, + apiMultipleParsed) + +import Servant.Docs.Simple.Parse (parse) +import Servant.Docs.Simple.Render (Endpoints (..)) + + +parseSpec :: Spec +parseSpec = describe "Parses API to Document Tree" $ do + it "parses an EmptyAPI Details" $ + parse @EmptyAPI `shouldBe` Endpoints [] + it "parses all Servant API Combinators" $ + parse @ApiComplete `shouldBe` apiCompleteParsed + it "parses an API with multiple endpoints" $ + parse @ApiMultiple `shouldBe` apiMultipleParsed diff --git a/test/Test/Servant/Docs/Simple/Render.hs b/test/Test/Servant/Docs/Simple/Render.hs new file mode 100644 --- /dev/null +++ b/test/Test/Servant/Docs/Simple/Render.hs @@ -0,0 +1,17 @@ +-- | Unit tests for generating documentation of api + +module Test.Servant.Docs.Simple.Render (renderSpec) where + + +import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Servant.Docs.Simple.Samples (apiCompleteJson, apiCompleteParsed, apiCompletePlainText) + +import Servant.Docs.Simple.Render (Json (..), PlainText (..), render) + + +renderSpec :: Spec +renderSpec = describe "Renders Details" $ do + it "should render as JSON" $ + render @Json apiCompleteParsed `shouldBe` apiCompleteJson + it "should render as PlainText" $ + render @PlainText apiCompleteParsed `shouldBe` apiCompletePlainText diff --git a/test/Test/Servant/Docs/Simple/Samples.hs b/test/Test/Servant/Docs/Simple/Samples.hs new file mode 100644 --- /dev/null +++ b/test/Test/Servant/Docs/Simple/Samples.hs @@ -0,0 +1,209 @@ +-- | Contains sample Servant API types and their formatted counterparts +{-# LANGUAGE QuasiQuotes #-} + +module Test.Servant.Docs.Simple.Samples (ApiComplete, ApiMultiple, apiCompletePlainText, + apiCompleteParsed, apiCompleteJson, apiMultipleParsed) where + +import Data.Aeson (Value (String), object) +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 (..)) + + +type ApiComplete = StaticRouteTest :> DynRouteTest :> CaptureAllTest :> ApiDetails + +apiCompleteParsed :: Endpoints +apiCompleteParsed = Endpoints [ Node "/test_route/{test::()}/{test::()}" apiDetails ] + +apiCompleteJson :: Json +apiCompleteJson = Json (object [ ( "/test_route/{test::()}/{test::()}" + , object [ ( "StreamBody" + , object [ ( "Format", String "()") + , ( "ContentType", String "()") + ]) + + , ( "Summary",String "sampleText" ) + + , ( "Basic Authentication" + , object [ ( "UserData", String "()") + , ( "Realm", String "local") + ]) + + , ( "Captures Http Version", String "True") + + , ( "QueryParam" + , object [ ( "Param",String "test") + , ( "ContentType",String "()") + ]) + + , ( "Authentication", String "TEST_JWT") + + , ( "Response" + , object [ ( "Format", String "': * () ('[] *)") + , ( "ContentType",String "()") + ]) + + , ( "RequestType", String "'POST") + + , ( "Vault", String "True") + + , ( "Captures RemoteHost/IP", String "True") + + , ( "RequestHeaders" + , object [ ( "Name",String "test") + , ( "ContentType",String "()") + ]) + + , ( "SSL Only",String "True") + + , ( "QueryParams" + , object [ ( "Param",String "test") + , ( "ContentType",String "()") + ]) + + , ( "Description", String "sampleText") + + , ( "QueryFlag", object [( "Param",String "test")]) + + , ( "RequestBody" + , object [ ( "Format", String "': * () ('[] *)") + , ( "ContentType",String "()") + ]) + + ])]) + +apiCompletePlainText :: PlainText +apiCompletePlainText = PlainText [r|/test_route/{test::()}/{test::()}: +Captures Http Version: True +SSL Only: True +Captures RemoteHost/IP: True +Description: sampleText +Summary: sampleText +Vault: True +Basic Authentication: + Realm: local + UserData: () +Authentication: TEST_JWT +RequestHeaders: + Name: test + ContentType: () +QueryFlag: + Param: test +QueryParam: + Param: test + ContentType: () +QueryParams: + Param: test + ContentType: () +RequestBody: + Format: ': * () ('[] *) + ContentType: () +StreamBody: + Format: () + ContentType: () +RequestType: 'POST +Response: + Format: ': * () ('[] *) + ContentType: ()|] + +type ApiMultiple = "route1" :> DynRouteTest :> CaptureAllTest :> ApiDetails + :<|> "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 + ] + + +type ApiDetails = HttpVersionTest + :> IsSecureTest + :> RemoteHostTest + :> DescriptionTest + :> SummaryTest + :> VaultTest + :> BasicAuthTest + :> AuthTest + :> HeaderTest + :> QueryFlagTest + :> QueryParamTest + :> QueryParamsTest + :> ReqBodyTest + :> StreamBodyTest + :> 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 "()")]) + + , Node "Authentication" (Detail "TEST_JWT") + + , Node "RequestHeaders" (Details [ Node "Name" (Detail "test") + , Node "ContentType" (Detail "()")]) + + , Node "QueryFlag" (Details [Node "Param" (Detail "test")]) + + , Node "QueryParam" (Details [ Node "Param" (Detail "test") + , Node "ContentType" (Detail "()")]) + + , Node "QueryParams" (Details [ Node "Param" (Detail "test") + , Node "ContentType" (Detail "()")]) + + , Node "RequestBody" (Details [ Node "Format" (Detail "': * () ('[] *)") + , Node "ContentType" (Detail "()")]) + + , Node "StreamBody" (Details [ Node "Format" (Detail "()") + , Node "ContentType" (Detail "()")]) + + , Node "RequestType" (Detail "'POST") + + , Node "Response" (Details [ Node "Format" (Detail "': * () ('[] *)") + , Node "ContentType" (Detail "()")])] + +type StaticRouteTest = "test_route" + +type DynRouteTest = Capture "test" () + +type CaptureAllTest = CaptureAll "test" () + +type HttpVersionTest = HttpVersion + +type IsSecureTest = IsSecure + +type RemoteHostTest = RemoteHost + +type DescriptionTest = Description "sampleText" + +type SummaryTest = Summary "sampleText" + +type VaultTest = Vault + +type BasicAuthTest = BasicAuth "local" () + +type AuthTest = AuthProtect "TEST_JWT" + +type HeaderTest = Header "test" () + +type QueryFlagTest = QueryFlag "test" + +type QueryParamTest = QueryParam "test" () + +type QueryParamsTest = QueryParams "test" () + +type ReqBodyTest = ReqBody '[()] () + +type StreamBodyTest = StreamBody () () + +type ResponseTest = Post '[()] ()