servant-docs-simple-0.4.0.0: src/Servant/Docs/Simple/Render.hs
{-# LANGUAGE CPP #-}
{- | Renders the intermediate structure into common documentation formats
__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 (..)
, Markdown (..)
, Pretty (..)
, PlainText (..)
) where
import Data.Aeson (ToJSON (..), Value (..), (.=), object)
import Data.List (intersperse)
import Data.Text (Text, pack)
#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter (Doc, annotate, defaultLayoutOptions, indent, layoutPretty, line, pretty, vcat,
vsep)
import Prettyprinter.Render.Util.StackMachine (renderSimplyDecorated)
#else
import Data.Text.Prettyprint.Doc (Doc, annotate, defaultLayoutOptions, indent, layoutPretty, line,
pretty, vcat, vsep)
import Data.Text.Prettyprint.Doc.Render.Util.StackMachine (renderSimplyDecorated)
#endif
-- | Intermediate documentation structure, a tree of endpoints
--
-- API type:
--
-- > type API = "users" :> ( "update" :> Response '[()] ()
-- > :<|> "get" :> Response '[()] ()
-- > )
--
-- Parsed into ApiDocs:
--
--
-- > 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 ApiDocs = ApiDocs [(Route, Details)] deriving stock (Eq, Show)
-- | Route representation
type Route = Text
-- | Details of the Api Route
--
-- __Examples__
--
-- > Authentication: true
--
-- Can be interpreted as a Parameter (Authentication) and a /Detail/ (true)
--
-- > Response:
-- > Format: ...
-- > ContentType: ...
--
-- Can be interpreted as a Parameter (Response) and /Details/ (Format (...), ContentType (...))
--
data Details = Details [(Parameter, Details)]
| Detail Text -- ^ Single Value
deriving stock (Eq, Show)
-- | Parameter names
type Parameter = Text
-- | Convert ApiDocs into different documentation formats
class Renderable a where
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
instance ToJSON ApiDocs where
toJSON (ApiDocs endpoints) =
object $ fmap (\(route, details) -> route .= toJSON details) endpoints
instance ToJSON Details where
toJSON (Detail t) = String t
toJSON (Details ds) = object $ fmap (\(param, details) -> param .= toJSON details) ds
-- | Conversion to prettyprint
newtype Pretty = Pretty { getPretty :: Doc Ann }
-- | Annotates our route and parameter keys
data Ann = AnnRoute | AnnParam | AnnDetail
-- | Conversion to prettyprint
instance Renderable Pretty where
render = Pretty . prettyPrint
-- | Helper function to prettyprint the ApiDocs
prettyPrint :: ApiDocs -> Doc Ann
prettyPrint (ApiDocs endpoints) = vsep
$ intersperse line
$ documentRoute
<$> endpoints
-- | Documents an API route
documentRoute :: (Route, Details) -- ^ Route-Details pair
-> Doc Ann -- ^ documentation for Route-Details pair
documentRoute (r, d) = routeDoc <> ":" <> detailsDoc
where routeDoc = annotate AnnRoute $ pretty r
detailsDoc = documentDetails 0 d
-- | Documents Details of an API route
documentDetails :: Int -- ^ Indentation
-> Details -- ^ Details
-> Doc Ann -- ^ documentation for Details
documentDetails i d = case d of
Detail d' -> " " <> annotate AnnDetail (pretty d')
Details ds -> (line <>)
$ indent i
$ vcat
$ documentParameters <$> ds
where documentParameters (param, details) = annotate AnnParam (pretty param)
<> ":"
<> documentDetails (i + 4) details
-- | 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
-- | Conversion to markdown
newtype Markdown = Markdown { getMarkdown :: Text } deriving stock (Eq, Show)
instance Renderable Markdown where
render docs = Markdown m
where m = renderSimplyDecorated id annOpen annClose docStream
annOpen = \case
AnnRoute -> "### "
AnnParam -> "- **"
AnnDetail -> "`"
annClose = \case
AnnRoute -> ""
AnnParam -> "**"
AnnDetail -> "`"
docStream = layoutPretty defaultLayoutOptions docs'
docs' = getPretty $ render docs