From 43a2c0777948cd8ab868befbaffbb0585eee208c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 26 Dec 2010 17:29:03 -0500
Subject: queryString and effectfulUrl

---
 src/settings.sml | 32 ++++++++++++++++++++++++++------
 1 file changed, 26 insertions(+), 6 deletions(-)

(limited to 'src/settings.sml')

diff --git a/src/settings.sml b/src/settings.sml
index 5b4bbe2c..29bbb1d8 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -28,18 +28,38 @@
 structure Settings :> SETTINGS = struct
 
 val urlPrefix = ref "/"
+val urlPrePrefix = ref ""
 val timeout = ref 0
 val headers = ref ([] : string list)
 val scripts = ref ([] : string list)
 
 fun getUrlPrefix () = !urlPrefix
+fun getUrlPrePrefix () = !urlPrePrefix
 fun setUrlPrefix p =
-    urlPrefix := (if p = "" then
-                      "/"
-                  else if String.sub (p, size p - 1) <> #"/" then
-                      p ^ "/"
-                  else
-                      p)
+    let
+        val prefix = if p = "" then
+                         "/"
+                     else if String.sub (p, size p - 1) <> #"/" then
+                         p ^ "/"
+                     else
+                         p
+
+        val (prepre, prefix) =
+            if String.isPrefix "http://" prefix then
+                let
+                    val (befor, after) = Substring.splitl (fn ch => ch <> #"/") (Substring.extract (prefix, 7, NONE))
+                in
+                    if Substring.isEmpty after then
+                        ("", prefix)
+                    else
+                        ("http://" ^ Substring.string befor, Substring.string after)
+                end
+            else
+                ("", prefix)
+    in
+        urlPrePrefix := prepre;
+        urlPrefix := prefix
+    end
 
 fun getTimeout () = !timeout
 fun setTimeout n = timeout := n
-- 
cgit v1.2.3