ServiceNow: querying full table contents generically

urweb · Aug 27, 2023 · 76bb3ec · 76bb3ec
1 parent 5a48dc0
commit 76bb3ec
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 0 deletions.
diff --git a/examples/serviceNowDemo.ur b/examples/serviceNowDemo.ur
@@ -50,3 +50,17 @@ val main =
 	    </xml>) ts}
 	  </table>
 	</body></xml>
+
+val incidents =
+    is <- S.Table.list {Description = "description",
+			Severity = "severity"} "incident";
+    return <xml><body>
+      <table>
+	<tr><th>Description</th> <th>Severity</th></tr>
+
+	{List.mapX (fn {Description = d : option string,
+			Severity = s : option int} => <xml>
+	  <tr><td>{[d]}</td> <td>{[s]}</td></tr>
+	</xml>) is}
+      </table>
+    </body></xml>
diff --git a/examples/serviceNowDemo.urs b/examples/serviceNowDemo.urs
@@ -1 +1,2 @@
 val main : transaction page
+val incidents : transaction page
diff --git a/src/ur/serviceNow.ur b/src/ur/serviceNow.ur
@@ -135,6 +135,25 @@ functor Make(M : AUTH) = struct
 			cs' <- columns p.Nam;
 			return (List.append cs cs')
     end
+
+    structure Table = struct
+	fun list [ts] (fl : folder ts) (labels : $(map (fn _ => string) ts))
+		 (jsons : $(map json ts)) (tname : string) =
+	    fields <- return (@foldR [fn _ => string] [fn _ => string]
+			      (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r]
+				  (label : string) (acc : string) =>
+				  case acc of
+				      "" => label
+				    | _ => acc ^ "," ^ label)
+			      "" fl labels);
+	    s <- api ("table/" ^ Urls.urlencode tname ^ "?sysparm_fields=" ^ fields);
+	    v <- return (@fromJson
+			  (@json_result (@json_list
+			    (@json_record_withOptional ! _ {} {}
+			      fl jsons labels)))
+			  s : result (list $(map option ts)));
+	    return v.Result
+    end
 end
 
 functor ThreeLegged(M : sig

diff --git a/src/ur/serviceNow.urs b/src/ur/serviceNow.urs
@@ -48,4 +48,13 @@ functor Make(M : AUTH) : sig
 	val list : transaction (list tabl)
 	val columns : string -> transaction (list column)
     end
+
+    structure Table : sig
+	val list : ts ::: {Type}
+		   -> folder ts
+		   -> $(map (fn _ => string) ts) (* labels in JSON *)
+		   -> $(map Json.json ts)
+		   -> string (* table name *)
+		   -> transaction (list $(map option ts))
+    end
 end
Original file line number	Diff line number	Diff line change
		@@ -1 +1,2 @@
		val main : transaction page
		val incidents : transaction page