{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

module Data.API.Doc.Types
    ( URL
    , HTTPMethod
    , StatusCode
    , Call(..)
    , Header(..)
    , Param(..)
    , View(..)
    , Sample(..)
    , Body(..)
    , DocInfo(..)
    , renderAPIType
    , renderBodyType
    , mk_link
    ) where

import           Data.API.PP
import           Data.API.Types

import qualified Data.Text                      as T
import           Text.Printf

type URL        = String
type HTTPMethod = String
type StatusCode = Int

-- | Documents a single method call on a resource in a web application
data Call
    = Call
        { Call -> URL
call_http_method   :: HTTPMethod               -- ^ HTTP method being documented
        , Call -> [URL]
call_path          :: [String]                 -- ^ Relative URL path of the resource
        , Call -> URL
call_description   :: String                   -- ^ Free-form text description
        , Call -> Bool
call_auth_required :: Bool                     -- ^ Does the call require authentication?
        , Call -> [Header]
call_headers       :: [Header]                 -- ^ HTTP headers relevant to the call
        , Call -> Maybe (APIType, URL)
call_body          :: Maybe (APIType, String)  -- ^ Type and example of request body
        , Call -> [Param]
call_params        :: [Param]                  -- ^ Query parameters relevant to the call
        , Call -> [View]
call_views         :: [View]                   -- ^ Available views of the result data
        , Call -> [Sample]
call_samples       :: [Sample]                 -- ^ Example responses
        }
    deriving (Int -> Call -> URL -> URL
[Call] -> URL -> URL
Call -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Call] -> URL -> URL
$cshowList :: [Call] -> URL -> URL
show :: Call -> URL
$cshow :: Call -> URL
showsPrec :: Int -> Call -> URL -> URL
$cshowsPrec :: Int -> Call -> URL -> URL
Show)

-- | Documents a HTTP header that may be supplied to a 'Call'
data Header
    = Header
        { Header -> URL
header_name     :: String  -- ^ Header name
        , Header -> URL
header_expl     :: String  -- ^ Example value for header
        , Header -> URL
header_desc     :: String  -- ^ Free-form text description
        , Header -> APIType
header_type     :: APIType -- ^ Type of data in header
        , Header -> Bool
header_required :: Bool    -- ^ Is including the header with the request mandatory?
        } deriving (Int -> Header -> URL -> URL
[Header] -> URL -> URL
Header -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Header] -> URL -> URL
$cshowList :: [Header] -> URL -> URL
show :: Header -> URL
$cshow :: Header -> URL
showsPrec :: Int -> Header -> URL -> URL
$cshowsPrec :: Int -> Header -> URL -> URL
Show)

-- | Documents a URL query parameter that may be included with a 'Call'
data Param
    = Param
        { Param -> URL
param_name     :: String                -- ^ Parameter name
        , Param -> URL
param_expl     :: String                -- ^ Example value for parameter
        , Param -> URL
param_desc     :: String                -- ^ Free-form text description
        , Param -> Either URL APIType
param_type     :: Either String APIType -- ^ Type of data in the parameter
        , Param -> Bool
param_required :: Bool                  -- ^ Is including the parameter mandatory?
        } deriving (Int -> Param -> URL -> URL
[Param] -> URL -> URL
Param -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Param] -> URL -> URL
$cshowList :: [Param] -> URL -> URL
show :: Param -> URL
$cshow :: Param -> URL
showsPrec :: Int -> Param -> URL -> URL
$cshowsPrec :: Int -> Param -> URL -> URL
Show)

-- | Documents a specific view of the result data available in a 'Call'
data View
    = View
        { View -> URL
view_id     :: String  -- ^ View name
        , View -> APIType
view_type   :: APIType -- ^ Type of result data returned
        , View -> URL
view_doc    :: String  -- ^ Free-form text description
        , View -> [Param]
view_params :: [Param] -- ^ Query parameters that may be supplied for this view
        } deriving (Int -> View -> URL -> URL
[View] -> URL -> URL
View -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [View] -> URL -> URL
$cshowList :: [View] -> URL -> URL
show :: View -> URL
$cshow :: View -> URL
showsPrec :: Int -> View -> URL -> URL
$cshowsPrec :: Int -> View -> URL -> URL
Show)

-- | Example response data from a 'Call'
data Sample
    = Sample
        { Sample -> Int
sample_status   :: StatusCode    -- ^ HTTP status code for this example response
        , Sample -> Body APIType
sample_type     :: Body APIType  -- ^ Type of example response
        , Sample -> Maybe URL
sample_response :: Maybe String  -- ^ Content of response, or 'Nothing' for empty response
        } deriving (Int -> Sample -> URL -> URL
[Sample] -> URL -> URL
Sample -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Sample] -> URL -> URL
$cshowList :: [Sample] -> URL -> URL
show :: Sample -> URL
$cshow :: Sample -> URL
showsPrec :: Int -> Sample -> URL -> URL
$cshowsPrec :: Int -> Sample -> URL -> URL
Show)

-- | Type for 'Sample' response body, parameterised by possible JSON types
data Body t = EmptyBody        -- ^ An empty response
            | JSONBody  t      -- ^ A JSON response of the given type
            | OtherBody String -- ^ A non-empty, non-JSON response
  deriving (forall a b. a -> Body b -> Body a
forall a b. (a -> b) -> Body a -> Body b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Body b -> Body a
$c<$ :: forall a b. a -> Body b -> Body a
fmap :: forall a b. (a -> b) -> Body a -> Body b
$cfmap :: forall a b. (a -> b) -> Body a -> Body b
Functor, Int -> Body t -> URL -> URL
forall t. Show t => Int -> Body t -> URL -> URL
forall t. Show t => [Body t] -> URL -> URL
forall t. Show t => Body t -> URL
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Body t] -> URL -> URL
$cshowList :: forall t. Show t => [Body t] -> URL -> URL
show :: Body t -> URL
$cshow :: forall t. Show t => Body t -> URL
showsPrec :: Int -> Body t -> URL -> URL
$cshowsPrec :: forall t. Show t => Int -> Body t -> URL -> URL
Show)

-- | Record of arguments that must be supplied to generate HTML
-- documentation for a 'Call'
data DocInfo
    = DocInfo
        { DocInfo -> URL -> [URL] -> URL
doc_info_call_url :: HTTPMethod -> [String] -> URL
          -- ^ URL for individual call documentation from the index
        , DocInfo -> TypeName -> URL
doc_info_type_url :: TypeName -> URL
          -- ^ URL for documentation of an API type
        }

renderBodyType :: DocInfo -> Body APIType -> String
renderBodyType :: DocInfo -> Body APIType -> URL
renderBodyType DocInfo
_  Body APIType
EmptyBody     = URL
"empty"
renderBodyType DocInfo
di (JSONBody APIType
ty) = URL
"json&nbsp;&nbsp;" forall a. [a] -> [a] -> [a]
++ DocInfo -> APIType -> URL
renderAPIType DocInfo
di APIType
ty
renderBodyType DocInfo
_  (OtherBody URL
s) = URL
s

renderAPIType :: DocInfo -> APIType -> String
renderAPIType :: DocInfo -> APIType -> URL
renderAPIType DocInfo
di (TyList  APIType
ty  ) = URL
"[" forall a. [a] -> [a] -> [a]
++ DocInfo -> APIType -> URL
renderAPIType DocInfo
di APIType
ty forall a. [a] -> [a] -> [a]
++ URL
"]"
renderAPIType DocInfo
di (TyMaybe APIType
ty  ) = URL
"?" forall a. [a] -> [a] -> [a]
++ DocInfo -> APIType -> URL
renderAPIType DocInfo
di APIType
ty
renderAPIType DocInfo
di (TyName  TypeName
tn  ) = URL -> URL -> URL
mk_link (DocInfo -> TypeName -> URL
doc_info_type_url DocInfo
di TypeName
tn) (Text -> URL
T.unpack (TypeName -> Text
_TypeName TypeName
tn))
renderAPIType DocInfo
_  (TyBasic BasicType
bt  ) = forall t. PP t => t -> URL
pp BasicType
bt
renderAPIType DocInfo
_  APIType
TyJSON         = URL
"json"

mk_link :: URL -> String -> String
mk_link :: URL -> URL -> URL
mk_link = forall r. PrintfType r => URL -> r
printf URL
"<b><a class='reflink' href='%s' >%s</a></b>"