{- | 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 (..)
       , 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 hashmap 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 (OMap 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 (OMap Parameter Details) -- ^ OMap of 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

-- | Json instance for the endpoints hashmap
instance ToJSON ApiDocs where
    toJSON :: ApiDocs -> Value
toJSON (ApiDocs endpoints :: OMap Route Details
endpoints) = HashMap Route Details -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Route Details -> Value)
-> (OMap Route Details -> HashMap Route Details)
-> OMap Route Details
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Route, Details)] -> HashMap Route Details
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Route, Details)] -> HashMap Route Details)
-> (OMap Route Details -> [(Route, Details)])
-> OMap Route Details
-> HashMap Route Details
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs (OMap Route Details -> Value) -> OMap Route Details -> Value
forall a b. (a -> b) -> a -> b
$ OMap Route Details
endpoints

-- | Json instance for the parameter hashmap of each endpoint
instance ToJSON Details where
    toJSON :: Details -> Value
toJSON (Detail t :: Route
t)   = Route -> Value
String Route
t
    toJSON (Details ls :: OMap Route Details
ls) = HashMap Route Details -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Route Details -> Value)
-> (OMap Route Details -> HashMap Route Details)
-> OMap Route Details
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Route, Details)] -> HashMap Route Details
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Route, Details)] -> HashMap Route Details)
-> (OMap Route Details -> [(Route, Details)])
-> OMap Route Details
-> HashMap Route Details
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs (OMap Route Details -> Value) -> OMap Route Details -> Value
forall a b. (a -> b) -> a -> b
$ OMap Route Details
ls

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

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

-- | Helper function to prettyprint the ApiDocs
prettyPrint :: ApiDocs -> Doc ann
prettyPrint :: ApiDocs -> Doc ann
prettyPrint (ApiDocs endpoints :: OMap Route Details
endpoints) = [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
$ (Route -> Details -> Doc ann) -> (Route, Details) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Route -> Details -> Doc ann
forall ann. Int -> Route -> Details -> Doc ann
toDoc 0) ((Route, Details) -> Doc ann) -> [(Route, Details)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs OMap Route Details
endpoints

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

-- | 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 Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (ApiDocs -> Doc Any) -> ApiDocs -> 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)
-> (ApiDocs -> Pretty Any) -> ApiDocs -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Pretty Any
forall a. Renderable a => ApiDocs -> a
render