{-# 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 (ApiDocs -> ApiDocs -> Bool
(ApiDocs -> ApiDocs -> Bool)
-> (ApiDocs -> ApiDocs -> Bool) -> Eq ApiDocs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiDocs -> ApiDocs -> Bool
$c/= :: ApiDocs -> ApiDocs -> Bool
== :: ApiDocs -> ApiDocs -> Bool
$c== :: ApiDocs -> ApiDocs -> Bool
Eq, Int -> ApiDocs -> ShowS
[ApiDocs] -> ShowS
ApiDocs -> String
(Int -> ApiDocs -> ShowS)
-> (ApiDocs -> String) -> ([ApiDocs] -> ShowS) -> Show ApiDocs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiDocs] -> ShowS
$cshowList :: [ApiDocs] -> ShowS
show :: ApiDocs -> String
$cshow :: ApiDocs -> String
showsPrec :: Int -> ApiDocs -> ShowS
$cshowsPrec :: Int -> ApiDocs -> ShowS
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 (Details -> Details -> Bool
(Details -> Details -> Bool)
-> (Details -> Details -> Bool) -> Eq Details
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Details -> Details -> Bool
$c/= :: Details -> Details -> Bool
== :: Details -> Details -> Bool
$c== :: Details -> Details -> Bool
Eq, Int -> Details -> ShowS
[Details] -> ShowS
Details -> String
(Int -> Details -> ShowS)
-> (Details -> String) -> ([Details] -> ShowS) -> Show Details
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Details] -> ShowS
$cshowList :: [Details] -> ShowS
show :: Details -> String
$cshow :: Details -> String
showsPrec :: Int -> Details -> ShowS
$cshowsPrec :: Int -> Details -> ShowS
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 { Json -> Value
getJson :: Value } deriving stock (Json -> Json -> Bool
(Json -> Json -> Bool) -> (Json -> Json -> Bool) -> Eq Json
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c== :: Json -> Json -> Bool
Eq, Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
(Int -> Json -> ShowS)
-> (Json -> String) -> ([Json] -> ShowS) -> Show Json
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Json] -> ShowS
$cshowList :: [Json] -> ShowS
show :: Json -> String
$cshow :: Json -> String
showsPrec :: Int -> Json -> ShowS
$cshowsPrec :: Int -> Json -> ShowS
Show)

-- | Conversion to JSON using Data.Aeson
instance Renderable Json where
    render :: ApiDocs -> Json
render = Value -> Json
Json (Value -> Json) -> (ApiDocs -> Value) -> ApiDocs -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToJSON ApiDocs where
    toJSON :: ApiDocs -> Value
toJSON (ApiDocs [(Route, Details)]
endpoints) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Route, Details) -> Pair) -> [(Route, Details)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Route
route, Details
details) -> Route
route Route -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Route -> v -> kv
.= Details -> Value
forall a. ToJSON a => a -> Value
toJSON Details
details) [(Route, Details)]
endpoints

instance ToJSON Details where
    toJSON :: Details -> Value
toJSON (Detail Route
t)   = Route -> Value
String Route
t
    toJSON (Details [(Route, Details)]
ds) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Route, Details) -> Pair) -> [(Route, Details)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Route
param, Details
details) -> Route
param Route -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Route -> v -> kv
.= Details -> Value
forall a. ToJSON a => a -> Value
toJSON Details
details) [(Route, Details)]
ds

-- | Conversion to prettyprint
newtype Pretty = Pretty { Pretty -> Doc Ann
getPretty :: Doc Ann }

-- | Annotates our route and parameter keys
data Ann = AnnRoute | AnnParam | AnnDetail

-- | Conversion to prettyprint
instance Renderable Pretty where
    render :: ApiDocs -> Pretty
render = Doc Ann -> Pretty
Pretty (Doc Ann -> Pretty) -> (ApiDocs -> Doc Ann) -> ApiDocs -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Doc Ann
prettyPrint

-- | Helper function to prettyprint the ApiDocs
prettyPrint :: ApiDocs -> Doc Ann
prettyPrint :: ApiDocs -> Doc Ann
prettyPrint (ApiDocs [(Route, Details)]
endpoints) = [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
vsep
                                ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
intersperse Doc Ann
forall ann. Doc ann
line
                                ([Doc Ann] -> [Doc Ann]) -> [Doc Ann] -> [Doc Ann]
forall a b. (a -> b) -> a -> b
$ (Route, Details) -> Doc Ann
documentRoute
                              ((Route, Details) -> Doc Ann) -> [(Route, Details)] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Route, Details)]
endpoints

-- | Documents an API route
documentRoute :: (Route, Details) -- ^ Route-Details pair
               -> Doc Ann -- ^ documentation for Route-Details pair
documentRoute :: (Route, Details) -> Doc Ann
documentRoute (Route
r, Details
d) = Doc Ann
routeDoc Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
":" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
detailsDoc
  where routeDoc :: Doc Ann
routeDoc = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnRoute (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Route -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
r
        detailsDoc :: Doc Ann
detailsDoc = Int -> Details -> Doc Ann
documentDetails Int
0 Details
d

-- | Documents Details of an API route
documentDetails :: Int -- ^ Indentation
                -> Details -- ^ Details
                -> Doc Ann -- ^ documentation for Details
documentDetails :: Int -> Details -> Doc Ann
documentDetails Int
i Details
d = case Details
d of
    Detail Route
d'  -> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnDetail (Route -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
d')
    Details [(Route, Details)]
ds -> (Doc Ann
forall ann. Doc ann
line Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>)
                (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i
                (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
vcat
                ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ (Route, Details) -> Doc Ann
documentParameters ((Route, Details) -> Doc Ann) -> [(Route, Details)] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Route, Details)]
ds
      where documentParameters :: (Route, Details) -> Doc Ann
documentParameters (Route
param, Details
details) = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnParam (Route -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
param)
                                               Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
":"
                                               Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Int -> Details -> Doc Ann
documentDetails (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Details
details

-- | Conversion to plaintext
newtype PlainText = PlainText { PlainText -> Route
getPlainText :: Text } deriving stock (PlainText -> PlainText -> Bool
(PlainText -> PlainText -> Bool)
-> (PlainText -> PlainText -> Bool) -> Eq PlainText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlainText -> PlainText -> Bool
$c/= :: PlainText -> PlainText -> Bool
== :: PlainText -> PlainText -> Bool
$c== :: PlainText -> PlainText -> Bool
Eq, Int -> PlainText -> ShowS
[PlainText] -> ShowS
PlainText -> String
(Int -> PlainText -> ShowS)
-> (PlainText -> String)
-> ([PlainText] -> ShowS)
-> Show PlainText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlainText] -> ShowS
$cshowList :: [PlainText] -> ShowS
show :: PlainText -> String
$cshow :: PlainText -> String
showsPrec :: Int -> PlainText -> ShowS
$cshowsPrec :: Int -> PlainText -> ShowS
Show)

-- | Conversion to plaintext
instance Renderable PlainText where
    render :: ApiDocs -> PlainText
render = Route -> PlainText
PlainText (Route -> PlainText) -> (ApiDocs -> Route) -> ApiDocs -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Route
pack (String -> Route) -> (ApiDocs -> String) -> ApiDocs -> Route
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> String
forall a. Show a => a -> String
show (Doc Ann -> String) -> (ApiDocs -> Doc Ann) -> ApiDocs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Doc Ann
getPretty (Pretty -> Doc Ann) -> (ApiDocs -> Pretty) -> ApiDocs -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Pretty
forall a. Renderable a => ApiDocs -> a
render

-- | Conversion to markdown
newtype Markdown = Markdown { Markdown -> Route
getMarkdown :: Text } deriving stock (Markdown -> Markdown -> Bool
(Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool) -> Eq Markdown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markdown -> Markdown -> Bool
$c/= :: Markdown -> Markdown -> Bool
== :: Markdown -> Markdown -> Bool
$c== :: Markdown -> Markdown -> Bool
Eq, Int -> Markdown -> ShowS
[Markdown] -> ShowS
Markdown -> String
(Int -> Markdown -> ShowS)
-> (Markdown -> String) -> ([Markdown] -> ShowS) -> Show Markdown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Markdown] -> ShowS
$cshowList :: [Markdown] -> ShowS
show :: Markdown -> String
$cshow :: Markdown -> String
showsPrec :: Int -> Markdown -> ShowS
$cshowsPrec :: Int -> Markdown -> ShowS
Show)

instance Renderable Markdown where
    render :: ApiDocs -> Markdown
render ApiDocs
docs = Route -> Markdown
Markdown Route
m
      where m :: Route
m = (Route -> Route)
-> (Ann -> Route) -> (Ann -> Route) -> SimpleDocStream Ann -> Route
forall out ann.
Monoid out =>
(Route -> out)
-> (ann -> out) -> (ann -> out) -> SimpleDocStream ann -> out
renderSimplyDecorated Route -> Route
forall a. a -> a
id Ann -> Route
annOpen Ann -> Route
annClose SimpleDocStream Ann
docStream
            annOpen :: Ann -> Route
annOpen = \case
              Ann
AnnRoute  -> Route
"### "
              Ann
AnnParam  -> Route
"- **"
              Ann
AnnDetail -> Route
"`"
            annClose :: Ann -> Route
annClose = \case
              Ann
AnnRoute  -> Route
""
              Ann
AnnParam  -> Route
"**"
              Ann
AnnDetail -> Route
"`"
            docStream :: SimpleDocStream Ann
docStream = LayoutOptions -> Doc Ann -> SimpleDocStream Ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc Ann
docs'
            docs' :: Doc Ann
docs' = Pretty -> Doc Ann
getPretty (Pretty -> Doc Ann) -> Pretty -> Doc Ann
forall a b. (a -> b) -> a -> b
$ ApiDocs -> Pretty
forall a. Renderable a => ApiDocs -> a
render ApiDocs
docs