Dream.redirect: add request argument

docs/web/postprocess/index.ml

@@ -566,7 +566,7 @@ let json_replacement = {|
 
 let val_redirect_expected = {|<div class="spec value" id="val-redirect">
  <a href="#val-redirect" class="anchor"></a><code><span><span class="keyword">val</span> redirect : <span>?status:<a href="#type-status">status</a> <span class="arrow">-&gt;</span></span> <span>?code:int <span class="arrow">-&gt;</span></span> <span>?headers:<span><span>(string * string)</span> list</span> <span class="arrow">-&gt;</span></span>
-<span>string <span class="arrow">-&gt;</span></span> <span><a href="#type-response">response</a> <a href="#type-promise">promise</a></span></span></code>
+<span><a href="#type-request">request</a> <span class="arrow">-&gt;</span></span> <span>string <span class="arrow">-&gt;</span></span> <span><a href="#type-response">response</a> <a href="#type-promise">promise</a></span></span></code>
 </div>
 |}
 
@@ -575,7 +575,7 @@ let val_redirect_replacement = {|
   <span class="optional">?status:<a href="#type-status">status</a> ->
   ?code:int ->
   ?headers:(string * string) list -></span>
-    string -> <a href="#type-response">response</a> <a href="#type-promise">promise</a>
+    <a href="#type-request">request</a> -> string -> <a href="#type-response">response</a> <a href="#type-promise">promise</a>
 </pre>
 |}
 

example/h-sql/README.md

@@ -66,7 +66,7 @@ let () =
       match%lwt Dream.form request with
       | `Ok ["text", text] ->
         let%lwt () = Dream.sql (add_comment text) request in
-        Dream.redirect "/"
+        Dream.redirect request "/"
       | _ ->
         Dream.empty `Bad_Request);
 

example/h-sql/sql.eml.ml

@@ -47,7 +47,7 @@ let () =
       match%lwt Dream.form request with
       | `Ok ["text", text] ->
         let%lwt () = Dream.sql (add_comment text) request in
-        Dream.redirect "/"
+        Dream.redirect request "/"
       | _ ->
         Dream.empty `Bad_Request);
 

example/z-playground/server/playground.ml

@@ -248,11 +248,11 @@ let () =
   @@ Dream.router [
 
     (* Generate a fresh valid id for new visitors, and redirect. *)
-    Dream.get "/" (fun _ ->
+    Dream.get "/" (fun request ->
       Dream.random 9
       |> Dream.to_base64url
       |> (^) "/"
-      |> Dream.redirect);
+      |> Dream.redirect request);
 
     (* Apply function communicate to WebSocket connections. *)
     Dream.get "/socket" (fun _ ->

src/dream.mli

@@ -443,11 +443,13 @@ val redirect :
   ?status:status ->
   ?code:int ->
   ?headers:(string * string) list ->
-    string -> response promise
+    request -> string -> response promise
 (** Creates a new {!type-response}. Adds a [Location:] header with the given
     string. The default status code is [303 See Other], for a temporary
     redirection. Use [~status:`Moved_Permanently] or [~code:301] for a permanent
-    redirection. *)
+    redirection. The {!type-request} is used for retrieving the site prefix, if
+    the string is an absolute path. Most applications don't have a site
+    prefix. *)
 
 val empty :
   ?headers:(string * string) list ->

src/pure/inmost.ml

@@ -485,7 +485,8 @@ let json ?status ?code ?headers body =
   |> with_header "Content-Type" Formats.application_json
   |> Lwt.return
 
-let redirect ?status ?code ?headers location =
+(* TODO Actually use the request and extract the site prefix. *)
+let redirect ?status ?code ?headers _request location =
   let status =
     match status, code with
     | None, None -> Some (`See_Other)