Add custom display strings

FsEye/Fsi/Eye.fs

@@ -63,6 +63,21 @@ type Eye() as this =
             Async.Start(computation, listenerCts.Token)
             null
 
+    ///Add or replace a custom callback handler used to create the display strings for instances of objects
+    member __.SetFormatter(f) = WatchModel.customPrinter <- Some f
+
+    ///Remove the current custom formatter callback handler
+    member __.RemoveFormatter() = WatchModel.customPrinter <- None
+
+    ///Add or replace a custom display string for a type in the format: "Some text {PropertyA} more text and {PropertyB}"
+    member __.SetDisplayString(ty, displayString) =
+        if WatchModel.customSprintLookup.ContainsKey ty then WatchModel.customSprintLookup.Remove ty |> ignore
+        WatchModel.customSprintLookup.Add(ty, WatchModel.generateSprintFunction(displayString))
+
+    //Removes a custom display string for a given type
+    member __.RemoveDisplayString(ty) =
+      if WatchModel.customSprintLookup.ContainsKey ty then WatchModel.customSprintLookup.Remove ty |> ignore
+
     ///Add or update a watch with the given name, value, and type.
     member __.Watch(name, value:obj, ty) =
         resources.EyeForm.Watch(name, value, ty)
@@ -133,6 +148,7 @@ type Eye() as this =
 
     ///Manages plugins and plugin watch viewers
     member this.PluginManager = resources.PluginManager
+
 
 [<AutoOpen>]
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]

FsEye/WatchModel.fs

@@ -128,9 +128,37 @@ and Watch =
         | DataMember {ExpressionInfo=ei} -> Some(ei)
         | Organizer _ -> None
 
+
 open System.Text.RegularExpressions
+
+// dictionary of custom display functions 
+let customSprintLookup = new System.Collections.Generic.Dictionary<System.Type,obj->string>()
+
+// custom callback function for overriding display strings
+let mutable customPrinter = None : (obj -> string option) option
+
+// create a function that will replace {Property} with the .ToString() of the properties for an object instace
+let generateSprintFunction displayString =    
+    let r = new Regex("""\{(.*?)\}""",RegexOptions.IgnoreCase|||RegexOptions.Singleline);
+    // replace instances of {PropertyName} with the property value via reflection
+    // eg : "hello world {John} and maybe {Dave}"
+    let rec getResults (m:Match) = 
+        [if m.Success then
+            yield m.Value
+            yield! getResults (m.NextMatch())]
+    let results = getResults (r.Match displayString)
+    fun (o:obj) -> 
+        let getValue name = 
+            if o = null then "null" else 
+            let prop = o.GetType().GetProperty(name)
+            if prop = null then sprintf "could not find property %s" name else 
+            let i = prop.GetGetMethod().Invoke(o, [||]) 
+            if i = null then "null" else i.ToString()
+        (displayString,results) 
+        ||> List.fold(fun acc item -> acc.Replace(item, getValue(item.Replace("{","").Replace("}",""))))
+
 ///Sprint the given value with the given Type. Precondition: Type cannot be null.
-let private sprintValue (value:obj) (ty:Type) =
+let private sprintValue (value:obj) (ty:Type) =    
     if ty =& null then
         nullArg "ty cannot be null"
 
@@ -144,7 +172,16 @@ let private sprintValue (value:obj) (ty:Type) =
         if typeof<System.Type>.IsAssignableFrom(ty) then
             sprintf "typeof<%s>" (value :?> Type).FSharpName
         else
-            sprintf "%A" value |> cleanString
+            // always use a custom display string function if it exists
+            match customSprintLookup.TryGetValue ty with
+            | true, f -> f value
+            | _ -> 
+                // attempt to use callback function if set
+                customPrinter 
+                |> Option.bind(fun f -> try f value with ex -> Some (ex.Message))                
+                |> function                   
+                    | Some s -> s
+                    | None -> sprintf "%A" value |> cleanString
 
 ///Create lazy seq of children s for a typical valued 
 let rec createChildren ownerValue (ownerTy:Type) =