1 files changed, 99 insertions, 0 deletions
diff --git a/gravatar.ur b/gravatar.ur
new file mode 100644
index 0000000..2ecbdde
--- /dev/null
+++ b/gravatar.ur
@@ -0,0 +1,99 @@
+(* Copyright 2015 the Massachusetts Institute of Technology
+
+Licensed under the Apache License, Version 2.0 (the "License"); you may not use
+this file except in compliance with the License.  You may obtain a copy of the
+License at
+
+    http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software distributed
+under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
+CONDITIONS OF ANY KIND, either express or implied.  See the License for the
+specific language governing permissions and limitations under the License. *)
+
+fun separate_with (sep : string) (xs : list string) : string =
+  List.foldr (fn result x => case x of
+                                 "" => result
+                               | _ => strcat x (strcat sep result))
+             ""
+             xs
+
+structure Options = struct
+  datatype missing_image_response =
+      FourOhFour
+    | MysteryMan
+    | Identicon
+    | Monster
+    | Wavatar
+    | Retro
+    | Blank
+    | Url of url
+
+  val show_missing_image_response : show missing_image_response =
+    mkShow (fn r =>
+              case r of
+                  FourOhFour => "404"
+                | MysteryMan => "mm"
+                | Identicon => "identicon"
+                | Monster => "monsterid"
+                | Wavatar => "wavatar"
+                | Retro => "retro"
+                | Blank => "blank"
+                | Url u => show u)
+
+  datatype rating = G | PG | R | X
+
+  val show_rating : show rating =
+    mkShow (fn r =>
+              case r of
+                  G => "g"
+                | PG => "pg"
+                | R => "r"
+                | X => "x")
+
+  type t = {
+      Size : option int,
+      Default : option missing_image_response,
+      ForceDefault : bool,
+      Rating : option rating
+    }
+
+  (* Converts a possibly null value to a component in an HTTP query string. *)
+  fun parameter_string [a] (show_a : show a)
+                       (url_key : string) (value : option a)
+                       : string =
+    case value of
+        None => ""
+      | Some v => strcat url_key (strcat "=" (@show show_a v))
+
+  (* Generates a list of the components in the HTTP query string corresponding
+  to [options]. *)
+  fun query_string_elements (options : t) : list string =
+    parameter_string "s" options.Size
+    :: parameter_string "d" options.Default
+    :: (case options.ForceDefault of
+            False => ""
+          | True => "f=y")
+    :: parameter_string "r" options.Rating
+    :: []
+
+  fun to_query_string (options : t) : string =
+    case (separate_with "&" (query_string_elements options)) of
+        "" => ""
+      | query_string =>
+        (* Hey, we got some.  Stick a "?" at the beginning so it can be used
+        as a query string. *)
+        strcat "?" query_string
+  end
+
+fun calculate_hash email =
+  show (Hash.md5 (textBlob (String.mp tolower (String.trim email))))
+
+fun url' options email =
+  bless
+    (strcat "https://secure.gravatar.com/avatar/"
+       (strcat (calculate_hash email)
+          (Options.to_query_string options)))
+
+fun url email =
+  url' {Size = None, Default = None, ForceDefault = False, Rating = None} email