From cbce1b6184acae87ba220969ab2c69cf2697ea32 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 21 Jul 2012 15:16:57 -0400
Subject: Top.postFields

---
 lib/ur/basis.urs |  6 ++++++
 lib/ur/top.ur    | 12 ++++++++++++
 lib/ur/top.urs   |  2 ++
 3 files changed, 20 insertions(+)

(limited to 'lib/ur')

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 8ac94668..cb5d16ea 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -898,6 +898,12 @@ type postBody
 val postType : postBody -> string
 val postData : postBody -> string
 
+type postField
+val firstFormField : string -> option postField
+val fieldName : postField -> string
+val fieldValue : postField -> string
+val remainingFields : postField -> string
+
 con radio = [Body, Radio]
 val radio : formTag (option string) radio [Id = id]
 val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] []
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index e504204e..5b9d43ab 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -393,3 +393,15 @@ fun mkRead' [t ::: Type] (f : string -> option t) (name : string) : read t =
     mkRead (fn s => case f s of
                         None => error <xml>Invalid {txt name}: {txt s}</xml>
                       | Some v => v) f
+
+fun postFields pb =
+    let
+        fun postFields' s =
+            case firstFormField s of
+                None => []
+              | Some f => (fieldName f, fieldValue f) :: postFields' (remainingFields f)
+    in
+        case postType pb of
+            "application/x-www-form-urlencoded" => postFields' (postData pb)
+          | _ => error <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
+    end
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 489e744d..30f1eaad 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -281,3 +281,5 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
                   -> sql_exp tables agg exps bool
 
 val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
+
+val postFields : postBody -> list (string * string)
-- 
cgit v1.2.3