{- | 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/render.hs)

[Writing our own rendering format](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/format.hs)

__Example of rendering the intermediate structure__

/Intermediate structure/

> 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/

> {
>     "/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 ( 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 (Endpoints -> Endpoints -> Bool
(Endpoints -> Endpoints -> Bool)
-> (Endpoints -> Endpoints -> Bool) -> Eq Endpoints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoints -> Endpoints -> Bool
$c/= :: Endpoints -> Endpoints -> Bool
== :: Endpoints -> Endpoints -> Bool
$c== :: Endpoints -> Endpoints -> Bool
Eq, Int -> Endpoints -> ShowS
[Endpoints] -> ShowS
Endpoints -> String
(Int -> Endpoints -> ShowS)
-> (Endpoints -> String)
-> ([Endpoints] -> ShowS)
-> Show Endpoints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoints] -> ShowS
$cshowList :: [Endpoints] -> ShowS
show :: Endpoints -> String
$cshow :: Endpoints -> String
showsPrec :: Int -> Endpoints -> ShowS
$cshowsPrec :: Int -> Endpoints -> ShowS
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" <Details>
--
-- __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 (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
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 (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)

-- | Convert Endpoints into different documentation formats
class Renderable a where
  render :: Endpoints -> 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)
instance Renderable Json where
  render :: Endpoints -> Json
render = Value -> Json
Json (Value -> Json) -> (Endpoints -> Value) -> Endpoints -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToJSON Endpoints where
    toJSON :: Endpoints -> Value
toJSON (Endpoints endpoints :: [Node]
endpoints) = Details -> Value
forall a. ToJSON a => a -> Value
toJSON (Details -> Value) -> Details -> Value
forall a b. (a -> b) -> a -> b
$ [Node] -> Details
Details [Node]
endpoints

instance ToJSON Details where
    toJSON :: Details -> Value
toJSON (Detail t :: Text
t) = Text -> Value
String Text
t
    toJSON (Details ls :: [Node]
ls) = [Pair] -> Value
object ([Pair] -> Value) -> ([Node] -> [Pair]) -> [Node] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Pair) -> [Node] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> Pair
forall kv. KeyValue kv => Node -> kv
jsonify ([Node] -> Value) -> [Node] -> Value
forall a b. (a -> b) -> a -> b
$ [Node]
ls
      where jsonify :: Node -> kv
jsonify (Node name :: Text
name details :: Details
details) = Text
name Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Value
forall a. ToJSON a => a -> Value
toJSON Details
details

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

instance Renderable (Pretty ann) where
  render :: Endpoints -> Pretty ann
render = Doc ann -> Pretty ann
forall ann. Doc ann -> Pretty ann
Pretty (Doc ann -> Pretty ann)
-> (Endpoints -> Doc ann) -> Endpoints -> Pretty ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Doc ann
forall ann. Endpoints -> Doc ann
prettyPrint

prettyPrint :: Endpoints -> Doc ann
prettyPrint :: Endpoints -> Doc ann
prettyPrint (Endpoints ls :: [Node]
ls) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ Int -> Node -> Doc ann
forall ann. Int -> Node -> Doc ann
toDoc 0 (Node -> Doc ann) -> [Node] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
ls

toDoc :: Int -> Node -> Doc ann
toDoc :: Int -> Node -> Doc ann
toDoc i :: Int
i (Node t :: Text
t d :: Details
d) = case Details
d of
    Detail a :: Text
a   -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t, ": ", Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a]
    Details as :: [Node]
as -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
i (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ":"
                                Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Int -> Node -> Doc ann
forall ann. Int -> Node -> Doc ann
toDoc (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4) (Node -> Doc ann) -> [Node] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
as)

-- | Conversion to plaintext
newtype PlainText = PlainText { PlainText -> Text
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)
instance Renderable PlainText where
  render :: Endpoints -> PlainText
render = Text -> PlainText
PlainText (Text -> PlainText)
-> (Endpoints -> Text) -> Endpoints -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Endpoints -> String) -> Endpoints -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (Endpoints -> Doc Any) -> Endpoints -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty Any -> Doc Any
forall ann. Pretty ann -> Doc ann
getPretty (Pretty Any -> Doc Any)
-> (Endpoints -> Pretty Any) -> Endpoints -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Pretty Any
forall a. Renderable a => Endpoints -> a
render