{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Data.API.Doc.Call ( callHtml ) where import Data.API.Doc.Subst import Data.API.Doc.Types import Data.List import Data.Ord -- | Generate a web page documenting a 'Call' callHtml :: DocInfo -> Dict -> Call -> String callHtml di dct0 call@Call{..} = concat [ container_open dct , headersHtml di call dct , paramsHtml di call dct , bodyHtml di call dct , viewsHtml di call dct , samplesHtml di call dct ] where dct = flip extDict dct0 [ (,) "HTTP-METHOD" $ call_http_method , (,) "PATH" $ ('/' :) $ concat $ intersperse "/" call_path , (,) "CALL-DESCRIPTION" call_description , (,) "AUTH-REQUIRED" $ if call_auth_required then "yes" else "no" ] headersHtml :: DocInfo -> Call -> Dict -> String headersHtml di Call{..} c_dct = case call_headers of [] -> "" _ -> concat [ headers_head , concatMap mk_header $ sortBy (comparing header_name) call_headers , headers_foot ] where mk_header hdr = header_content $ call_dict_header di c_dct hdr paramsHtml :: DocInfo -> Call -> Dict -> String paramsHtml di Call{..} c_dct = case call_params of [] -> no_params c_dct _ -> concat [ params_head c_dct , paramsRows di c_dct call_params , params_foot c_dct ] paramsRows :: DocInfo -> Dict -> [Param] -> String paramsRows di c_dct = concatMap mk_param . sortBy (comparing param_name) where mk_param param = parameter_row $ call_dict_param di c_dct param bodyHtml :: DocInfo -> Call -> Dict -> String bodyHtml di Call{..} c_dct = case call_body of Nothing -> "" Just (typ,spl) -> body_sample $ flip extDict c_dct [ (,) "BODY-TYPE" (renderAPIType di typ) , (,) "BODY-SAMPLE" spl ] viewsHtml :: DocInfo -> Call -> Dict -> String viewsHtml di Call{..} c_dct | null call_views = "" | otherwise = concat [ views_head , concatMap (view_content . view_dict) call_views , views_foot , concatMap view_detailed call_views ] where view_dict vw = flip extDict c_dct [ (,) "VIEW-ID" $ view_id vw , (,) "VIEW-TYPE" $ renderAPIType di $ view_type vw , (,) "VIEW-DOC" $ view_doc vw ] view_detailed vw | null (view_params vw) = "" | otherwise = concat [ view_detail_head v_dct , paramsRows di v_dct $ view_params vw , view_detail_foot ] where v_dct = view_dict vw samplesHtml :: DocInfo -> Call -> Dict -> String samplesHtml di Call{..} c_dct = concat [ sample_heading c_dct , concat $ map mk_sample call_samples ] where mk_sample spl = sample s_dct where s_dct = call_dict_sample di c_dct spl call_dict_header :: DocInfo -> Dict -> Header -> Dict call_dict_header di dct Header{..} = flip extDict dct [ (,) "HEADER-NAME" header_name , (,) "HEADER-OR" $ if header_required then "Required" else "Optional" , (,) "HEADER-EXAMPLE" header_expl , (,) "HEADER-DESC" header_desc , (,) "HEADER-TYPE" $ renderAPIType di header_type ] call_dict_param :: DocInfo -> Dict -> Param -> Dict call_dict_param di dct Param{..} = flip extDict dct [ (,) "PARAMETER-NAME" param_name , (,) "PARAMETER-OR" $ if param_required then "Required" else "Optional" , (,) "PARAMETER-EXAMPLE" param_expl , (,) "PARAMETER-DESC" param_desc , (,) "PARAMETER-TYPE" $ either id (renderAPIType di) param_type ] call_dict_sample :: DocInfo -> Dict -> Sample -> Dict call_dict_sample di dct Sample{..} = flip extDict dct [ (,) "HTTP-STATUS" $ show sample_status , (,) "SAMPLE-TYPE" $ renderBodyType di sample_type , (,) "SAMPLE-RESPONSE" $ maybe "" id sample_response ] container_open :: Dict -> String container_open dct = prep dct [ " " , "

" , " <> <>" , "

" , "
" , "
" , "

<>

" , "
" , " " , " " , " " , " " , " " , " " , " " , " " , " " , " " , " " , " " , " " -- , " " -- , " " -- , " " -- , " " , "
Request Method<> 
Resource URI<><> 
Authentication Required" , " <>" , "  " , "
Request Body" ++ mkLink dct "POST-NODE-URL" "POST-NODE" ++ "
" , "
" , "
" ] headers_head :: String headers_head = unlines [ "
" , "

Headers

" , "
" , " " ] header_content :: Dict -> String header_content dct = prep dct [ " " , " " , " " , " " , " " , " " , " " ] headers_foot :: String headers_foot = "
<><>

<>

<>

<>


" no_params :: Dict -> String no_params dct = prep dct [ "
" , "

Parameters

" , "
" , " There are no parameters for this resource." , "
" ] params_head :: Dict -> String params_head dct = prep dct [ "
" , "

Parameters

" , "
" , " " ] parameter_row :: Dict -> String parameter_row dct = prep dct [ " " , " " , " " , " " , " " , " " , " " ] params_foot :: Dict -> String params_foot dct = prep dct [ "
<>" , " " , " <>" , " " , " " , "

<>

" , " 		" , "

<>

" , " 		" , "

<>

" , "
" ] body_sample :: Dict -> String body_sample dct = prep dct [ "
" , "

Sample Body

" , "
" , "
" , " <>" , "
" , " 
<>
" ] views_head :: String views_head = unlines [ "
" , "

Views

" , "
" , " " ] view_content :: Dict -> String view_content dct = prep dct [ " " , " " , " " , " " , " " ] views_foot :: String views_foot = "
<>

<>

<>


" view_detail_head :: Dict -> String view_detail_head dct = prep dct [ "
" , "

Parameters for <> view :: <>

" , "
" , " " ] view_detail_foot :: String view_detail_foot = "
" sample_heading :: Dict -> String sample_heading dct = prep dct [ "
" , "

Sample Responses

" , "
" ] sample :: Dict -> String sample dct = prep dct [ "
" , " <>" , " HTTP Status: <>" , "
" , " 
<>
" ]