{- | Parse and render an API type, write documentation to file, stdout

__Example script__

[Writing documentation to file](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/generate.hs)

/With the following language extensions/

> DataKinds
> TypeApplications
> TypeOperators

/Using this script/

> module Main where
>
> import Servant.API ((:>), Post, ReqBody)
> import Servant.Docs.Simple (writeDocsJson, writeDocsPlainText)
>
> -- Our API type
> type API = "hello" :> "world" :> Request :> Response
> type Request = ReqBody '[()] ()
> type Response = Post '[()] ()
>
> main :: IO ()
> main = do
>   -- Writes to the file $PWD/docs.json
>   writeDocsJson @API "docs.json"
>
>   -- Writes to the file $PWD/docs.txt
>   writeDocsPlainText @API "docs.txt"

__Expected Output__

/Files should be generated relative to @$PWD@/

> $ ls | grep docs
> docs.json
> docs.txt

/docs.json/

> {
>     "/hello/world": {
>         "Response": {
>             "Format": "[()]",
>             "ContentType": "()"
>         },
>         "RequestType": "'POST",
>         "RequestBody": {
>             "Format": "[()]",
>             "ContentType": "()"
>         }
>     }
> }

/docs.txt/

> /hello/world:
> RequestBody:
>     Format: [()]
>     ContentType: ()
> RequestType: 'POST
> Response:
>     Format: [()]
>     ContentType: ()

-}

module Servant.Docs.Simple ( document
                           , documentWith
                           , stdoutJson
                           , stdoutMarkdown
                           , stdoutPlainText
                           , writeDocsJson
                           , writeDocsMarkdown
                           , 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 (HasParsableApi (..))
import Servant.Docs.Simple.Render (Json (..), Markdown (..), PlainText (..), Renderable (..))


-- | Write documentation as PlainText to file
writeDocsPlainText :: forall api. HasParsableApi api => FilePath -> IO ()
writeDocsPlainText :: FilePath -> IO ()
writeDocsPlainText FilePath
fp = FilePath -> Text -> IO ()
T.writeFile FilePath
fp (Text -> IO ()) -> (PlainText -> Text) -> PlainText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainText -> Text
getPlainText (PlainText -> IO ()) -> PlainText -> IO ()
forall a b. (a -> b) -> a -> b
$ HasParsableApi api => PlainText
forall k (api :: k). HasParsableApi api => PlainText
document @api

-- | Write documentation as Markdown to file
writeDocsMarkdown :: forall api. HasParsableApi api => FilePath -> IO ()
writeDocsMarkdown :: FilePath -> IO ()
writeDocsMarkdown FilePath
fp = FilePath -> Text -> IO ()
T.writeFile FilePath
fp (Text -> IO ()) -> (Markdown -> Text) -> Markdown -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> Text
getMarkdown (Markdown -> IO ()) -> Markdown -> IO ()
forall a b. (a -> b) -> a -> b
$ (HasParsableApi api, Renderable Markdown) => Markdown
forall k (api :: k) a. (HasParsableApi api, Renderable a) => a
documentWith @api @Markdown

-- | Write documentation as JSON to file
writeDocsJson :: forall api. HasParsableApi api => FilePath -> IO ()
writeDocsJson :: FilePath -> IO ()
writeDocsJson FilePath
fp = FilePath -> ByteString -> IO ()
B.writeFile FilePath
fp (ByteString -> IO ()) -> (Json -> ByteString) -> Json -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Value -> ByteString) -> (Json -> Value) -> Json -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json -> Value
getJson (Json -> IO ()) -> Json -> IO ()
forall a b. (a -> b) -> a -> b
$ (HasParsableApi api, Renderable Json) => Json
forall k (api :: k) a. (HasParsableApi api, Renderable a) => a
documentWith @api @Json

-- | Write documentation as PlainText to stdout
stdoutPlainText :: forall api. HasParsableApi api => IO ()
stdoutPlainText :: IO ()
stdoutPlainText = Text -> IO ()
T.putStrLn (Text -> IO ()) -> (PlainText -> Text) -> PlainText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainText -> Text
getPlainText (PlainText -> IO ()) -> PlainText -> IO ()
forall a b. (a -> b) -> a -> b
$ HasParsableApi api => PlainText
forall k (api :: k). HasParsableApi api => PlainText
document @api

-- | Write documentation as Markdown to stdout
stdoutMarkdown :: forall api. HasParsableApi api => IO ()
stdoutMarkdown :: IO ()
stdoutMarkdown = Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Markdown -> Text) -> Markdown -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> Text
getMarkdown (Markdown -> IO ()) -> Markdown -> IO ()
forall a b. (a -> b) -> a -> b
$ (HasParsableApi api, Renderable Markdown) => Markdown
forall k (api :: k) a. (HasParsableApi api, Renderable a) => a
documentWith @api @Markdown

-- | Write documentation as JSON to stdout
stdoutJson :: forall api. HasParsableApi api => IO ()
stdoutJson :: IO ()
stdoutJson = ByteString -> IO ()
BC.putStrLn (ByteString -> IO ()) -> (Json -> ByteString) -> Json -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Value -> ByteString) -> (Json -> Value) -> Json -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json -> Value
getJson (Json -> IO ()) -> Json -> IO ()
forall a b. (a -> b) -> a -> b
$ (HasParsableApi api, Renderable Json) => Json
forall k (api :: k) a. (HasParsableApi api, Renderable a) => a
documentWith @api @Json

-- | Convert API type into PlainText format
document :: forall api. HasParsableApi api => PlainText
document :: PlainText
document = (HasParsableApi api, Renderable PlainText) => PlainText
forall k (api :: k) a. (HasParsableApi api, Renderable a) => a
documentWith @api @PlainText

-- | Convert API type into specified formats
documentWith :: forall api a. (HasParsableApi api, Renderable a) => a
documentWith :: a
documentWith = ApiDocs -> a
forall a. Renderable a => ApiDocs -> a
render @a (HasParsableApi api => ApiDocs
forall k (api :: k). HasParsableApi api => ApiDocs
parseApi @api)