Skip to content
Browse files

JSONP response

  • Loading branch information...
1 parent ef683d4 commit 5664bfb43bda8a2487ed054037570c43938bb59e @VictorNicollet committed
Showing with 48 additions and 14 deletions.
  1. +11 −0 src/action.mli
  2. +37 −14 src/action_Response.ml
View
11 src/action.mli
@@ -136,6 +136,17 @@ end
*)
val file : file:string -> mime:string -> data:string -> response -> response
+(** {b JSONP}: returns the provided JSON using the JSONP format.
+
+ Any existing JSON or HTML data present in the response is removed, but JS code
+ is kept and appended to the JSONP output. Existing JSONP data is also kept
+ (which means it is possible to return several pieces of data in a single HTTP
+ request using JSONP).
+
+ By default, the callback is [callback].
+*)
+val jsonp: ?callback:string -> Json.t -> response -> response
+
(** {b JavaScript}: attaches some JavaScript to be executed after an HTML or JSON response.
If the response is HTML, the view will receive the JavaScript code (turned to a string) as
a parameter to insert it into an appropriate script tag. If the response is JSON, a [code]
View
51 src/action_Response.ml
@@ -6,8 +6,9 @@ open BatPervasives
type response_kind =
| Page of (JsCode.t -> string) * JsCode.t
| Redirect of string
- | Json of (string * Json_type.t) list * JsCode.t
+ | Json of (string * Json.t) list * JsCode.t
| File of string * string * string
+ | Jsonp of (string * Json.t) list * JsCode.t
type response =
{
@@ -25,18 +26,20 @@ let redirect url response = {
let more_javascript new_js response = {
response with
kind = begin match response.kind with
- | Json (j,js) -> Json (j, JsCode.seq [js;new_js])
- | Page (p,js) -> Page (p, JsCode.seq [js;new_js])
- | keep -> keep
+ | Json (j,js) -> Json (j, JsCode.seq [js;new_js])
+ | Page (p,js) -> Page (p, JsCode.seq [js;new_js])
+ | Jsonp (j,js) -> Jsonp (j, JsCode.seq [js;new_js])
+ | keep -> keep
end
}
let javascript new_js response = {
response with
kind = begin match response.kind with
- | Json (j,js) -> Json (j, JsCode.seq [js;new_js])
- | Page (p,js) -> Page (p, JsCode.seq [js;new_js])
- | _ -> Json ([], new_js)
+ | Json (j,js) -> Json (j, JsCode.seq [js;new_js])
+ | Page (p,js) -> Page (p, JsCode.seq [js;new_js])
+ | Jsonp (j,js) -> Jsonp (j, JsCode.seq [js;new_js])
+ | _ -> Jsonp ([], new_js)
end
}
@@ -53,18 +56,30 @@ let file ~file ~mime ~data response = {
let json json response = {
response with
kind = begin match response.kind with
- | Page (_,js) -> Json (json, js)
- | Json (f,js) -> Json (json @ f, js)
- | _ -> Json (json, JsCode.seq [])
+ | Page (_,js)
+ | Jsonp (_,js) -> Json (json, js)
+ | Json (f,js) -> Json (json @ f, js)
+ | _ -> Json (json, JsCode.seq [])
+ end
+}
+
+let jsonp ?(callback="callback") json response = {
+ response with
+ kind = begin match response.kind with
+ | Page (_,js)
+ | Json (_,js) -> Jsonp ([callback,json], js)
+ | Jsonp (f,js) -> Jsonp ((callback,json) :: f, js)
+ | _ -> Jsonp ([callback,json], JsCode.seq [])
end
}
let page html response = {
response with
kind = begin match response.kind with
- | Page (_,js)
- | Json (_,js) -> Page (html, js)
- | _ -> Page (html, JsCode.seq [])
+ | Page (_,js)
+ | Json (_,js)
+ | Jsonp (_,js) -> Page (html, js)
+ | _ -> Page (html, JsCode.seq [])
end
}
@@ -102,7 +117,15 @@ let process suffix (cgi : Netcgi.cgi) response =
cgi # set_header ~set_cookies:cookies ~content_type:mime ~filename:file ();
cgi # environment # send_output_header () ;
ignore (out_channel # output data 0 (String.length data))
-
+
+ | Jsonp (jsonp,js) ->
+ cgi # set_header ~set_cookies:cookies ~content_type:"text/javascript" ();
+ cgi # environment # send_output_header () ;
+ let code = JsCode.seq (List.map (fun (name,json) -> JsCode.make name [json]) jsonp) in
+ let full = JsCode.seq [ code ; js ] in
+ let js = JsCode.to_script full in
+ ignore (out_channel # output js 0 (String.length js))
+
| Json (json,js) ->
cgi # set_header ~set_cookies:cookies ~content_type:"application/json" ();
cgi # environment # send_output_header () ;

0 comments on commit 5664bfb

Please sign in to comment.
Something went wrong with that request. Please try again.