Add support for FsLab-compatible AddHtmlPrinter (#96)

Author: tpetricek

paket.dependencies

@@ -2,6 +2,7 @@ framework: >= net451
 source https://www.nuget.org/api/v2
 
 nuget FSharp.Compiler.Service
+nuget FSharp.Compiler.Tools
 nuget AsyncIO = 0.1.20.0
 nuget NetMQ
 nuget Newtonsoft.Json

paket.lock

@@ -8,6 +8,7 @@ NUGET
     FSharp.Compiler.Service (8.0)
       System.Collections.Immutable (>= 1.2)
       System.Reflection.Metadata (>= 1.4.1-beta-24227-04)
+    FSharp.Compiler.Tools (4.0.1.10)
     FSharp.Core (4.0.0.1)
     Mono.Cecil (0.9.6.4)
     NetMQ (3.3.3.4)

src/IfSharp.Kernel/Evaluation.fs

@@ -8,15 +8,49 @@ open Microsoft.FSharp.Compiler.Interactive.Shell
 [<AutoOpen>]
 module Evaluation = 
 
-    let internal fsiout = ref false
-    let internal sbOut = new StringBuilder()
-    let internal sbErr = new StringBuilder()
-    let internal inStream = new StringReader("")
-    let internal outStream = new StringWriter(sbOut)
-    let internal errStream = new StringWriter(sbErr)
-    let internal fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
-    let internal fsiEval = FsiEvaluationSession.Create(fsiConfig, [|"--noninteractive"|], inStream, outStream, errStream)
+    /// Extend the `fsi` object with `fsi.AddHtmlPrinter` 
+    let addHtmlPrinter = """
+        module FsInteractiveService = 
+            let mutable htmlPrinters = new ResizeArray<System.Type * (obj -> seq<string * string> * string)>()
+            let htmlPrinterParams = System.Collections.Generic.Dictionary<string, obj>()
+            do htmlPrinterParams.["html-standalone-output"] <- false
+
+        type Microsoft.FSharp.Compiler.Interactive.InteractiveSession with
+            member x.HtmlPrinterParameters = FsInteractiveService.htmlPrinterParams
+            member x.AddHtmlPrinter<'T>(f:'T -> seq<string * string> * string) = 
+                FsInteractiveService.htmlPrinters.Add(typeof<'T>, fun (value:obj) ->
+                    f (value :?> 'T))"""
+
+    /// Start the F# interactive session with HAS_FSI_ADDHTMLPRINTER symbol defined
+    let internal startSession () =
+        let sbOut = new StringBuilder()
+        let sbErr = new StringBuilder()
+        let inStream = new StringReader("")
+        let outStream = new StringWriter(sbOut)
+        let errStream = new StringWriter(sbErr)
 
+        let fsiObj = Microsoft.FSharp.Compiler.Interactive.Settings.fsi
+        let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration(fsiObj, false)
+        let args = [|"--noninteractive"; "--define:HAS_FSI_ADDHTMLPRINTER" |]
+        let fsiSession = FsiEvaluationSession.Create(fsiConfig, args, inStream, outStream, errStream)
+
+        // Load the `fsi` object from the right location of the `FSharp.Compiler.Interactive.Settings.dll`
+        // assembly and add the `fsi.AddHtmlPrinter` extension method; then clean it from FSI output
+        let origLength = sbOut.Length
+        let fsiLocation = typeof<Microsoft.FSharp.Compiler.Interactive.InteractiveSession>.Assembly.Location    
+        fsiSession.EvalInteraction("#r @\"" + fsiLocation + "\"")
+        fsiSession.EvalInteraction(addHtmlPrinter)
+        sbOut.Remove(origLength, sbOut.Length-origLength) |> ignore
+        
+        // Get reference to the extra HTML printers registered inside the FSI session
+        let extraPrinters = 
+          unbox<ResizeArray<System.Type * (obj -> seq<string * string> * string)>>
+            (fsiSession.EvalExpression("FsInteractiveService.htmlPrinters").Value.ReflectionValue)
+        sbErr, sbOut, extraPrinters, fsiSession
+
+    let internal fsiout = ref false
+    let internal sbErr, sbOut, extraPrinters, fsiEval = startSession ()
+
     /// Gets `it` only if `it` was printed to the console
     let GetLastExpression() =
 

src/IfSharp.Kernel/IfSharp.Kernel.fsproj

@@ -98,6 +98,9 @@
     <Content Include="app.config" />
   </ItemGroup>
   <ItemGroup>
+    <Reference Include="FSharp.Compiler.Interactive.Settings">
+      <HintPath>..\..\packages\FSharp.Compiler.Tools\tools\FSharp.Compiler.Interactive.Settings.dll</HintPath>
+    </Reference>
     <Reference Include="mscorlib" />
     <Reference Include="NuGet">
       <HintPath>..\..\lib\NuGet.dll</HintPath>

src/IfSharp.Kernel/Printers.fs

@@ -24,8 +24,17 @@ module Printers =
 
     /// Finds a display printer based off of the type
     let findDisplayPrinter(findType) =
+        // Get printers that were registered using `fsi.AddHtmlPrinter` and turn them 
+        // into printers expected here (just contactenate all <script> tags with HTML)
+        let extraPrinters = 
+            Evaluation.extraPrinters
+            |> Seq.map (fun (t, p) -> t, fun o -> 
+                let extras, html = p o
+                let extras = extras |> Seq.map snd |> String.concat ""
+                { ContentType = "text/html"; Data = extras + html })
+
         let printers =
-            displayPrinters
+            Seq.append displayPrinters extraPrinters
             |> Seq.filter (fun (t, _) -> t.IsAssignableFrom(findType))
             |> Seq.toList