[MLton-commit] r6260

[Vesa Karvonen]

Added convenience functions, withShow and withFmt, for customizing pretty
printing.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
U   mltonlib/trunk/com/ssh/generic/unstable/public/value/pretty.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml	2007-12-11 11:26:44 UTC (rev 6259)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml	2007-12-12 06:53:12 UTC (rev 6260)
@@ -327,6 +327,16 @@
       fun pretty t = fmt t Fmt.default
       fun show t = Prettier.render NONE o pretty t
 
+      local
+         open Pretty
+      in
+         fun withShow toString =
+             setPrinter (fn v => return (ATOMIC, txt (toString v)))
+
+         fun withFmt fmt =
+             mapPrinter (fn p => fn v => setFmt fmt >>= (fn () => p v))
+      end
+
       structure Open = LayerDepCases
         (fun iso        aT = iso' (getT aT)
          fun isoProduct aP = iso' (getP aP)

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/pretty.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/pretty.sig	2007-12-11 11:26:44 UTC (rev 6259)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/pretty.sig	2007-12-12 06:53:12 UTC (rev 6260)
@@ -283,6 +283,29 @@
 
    val show : ('a, 'x) PrettyRep.t -> 'a -> String.t
    (** {show t} is equivalent to {Prettier.render NONE o pretty t}. *)
+
+   val withShow : ('a -> String.t) -> ('a, 'x) PrettyRep.t UnOp.t
+   (**
+    * Functionally updates the prettifying function in the given type
+    * representation with the given function for converting values to
+    * strings.
+    *
+    * {withShow} is equivalent to
+    *
+    *> fun withShow toString =
+    *>     setPrinter (fn v => return (ATOMIC, txt (toString v)))
+    *)
+
+   val withFmt : Fmt.t -> ('a, 'x) PrettyRep.t UnOp.t
+   (**
+    * Functionally updates the prettifying function in the given type
+    * representation to use exactly the given formatting options.
+    *
+    * {withFmt} is equivalent to
+    *
+    *> fun withFmt fmt =
+    *>     mapPrinter (fn p => fn v => setFmt fmt >>= (fn () => p v))
+    *)
 end
 
 signature PRETTY_CASES = sig