Merge pull request #60 from rneatherway/colorizations

Provide a command to request colorization info

FsAutoComplete/CommandInput.fs

@@ -23,13 +23,24 @@ type Command =
   | Parse of string * ParseKind * string[]
   | Error of string
   | Project of string * DateTime
+  | Colorization of bool
   | CompilerLocation
   | Quit
 
 module CommandInput =
   /// Parse 'quit' command
   let quit = string "quit" |> Parser.map (fun _ -> Quit)
 
+  /// Parse 'colorizations' command
+  let colorizations = parser {
+      let! _ = string "colorizations "
+      let! b = parser { let! _ = string "true"
+                        return true } <|>
+               parser { let! _ = string "false"
+                        return false }
+      return Colorization b
+    }
+
   /// Parse 'declarations' command
   let declarations = parser {
     let! _ = string "declarations "
@@ -114,7 +125,7 @@ module CommandInput =
     | null -> Quit
     | input ->
       let reader = Parsing.createForwardStringReader input 0
-      let cmds = compilerlocation <|> helptext <|> declarations <|> parse <|> project <|> completionTipOrDecl <|> quit <|> error
+      let cmds = compilerlocation <|> helptext <|> declarations <|> parse <|> project <|> completionTipOrDecl <|> quit <|> colorizations <|> error
       let cmd = reader |> Parsing.getFirst cmds
       match cmd with
       | Parse (filename,kind,_) ->

FsAutoComplete/CommandResponse.fs

@@ -154,6 +154,12 @@ module CommandResponse =
         Subcategory = e.Subcategory
       }
 
+  type Colorization =
+    {
+      Range: Range.range
+      Kind: string
+    }
+
   type private FSharpErrorSeverityConverter() =
     inherit JsonConverter()
 
@@ -272,6 +278,11 @@ module CommandResponse =
     writeJson { Kind = "errors"
                 Data = Seq.map FSharpErrorInfo.OfFSharpError errors }
 
+  let colorizations(colorizations: (Range.range * FSharpTokenColorKind)[]) =
+    let data = [ for r, k in colorizations do
+                   yield { Range = r; Kind = Enum.GetName(typeof<FSharpTokenColorKind>, k) } ]
+    writeJson { Kind = "colorizations"; Data = data }
+
   let findDeclaration(range: Range.range) =
     let data = { Line = range.StartLine; Column = range.StartColumn + 1; File = range.FileName }
     writeJson { Kind = "finddecl"; Data = data }

FsAutoComplete/CompilerServiceInterface.fs

@@ -99,6 +99,9 @@ type ParseAndCheckResults(parseResults: FSharpParseFileResults,
       Some (decls, residue)
     with :? TimeoutException -> None
 
+  member x.GetExtraColorizations =
+    checkResults.GetExtraColorizationsAlternate()
+
 type FSharpCompilerServiceChecker() =
   let checker = FSharpChecker.Instance
   do checker.BeforeBackgroundFileCheck.Add (fun _ -> ())

FsAutoComplete/Program.fs

@@ -15,13 +15,15 @@ type internal State =
     FileCheckOptions : Map<string,FSharpProjectOptions>
     ProjectLoadTimes : Map<string,DateTime>
     HelpText : Map<String, FSharpToolTipText>
+    ColorizationOutput: bool
   }
 
   static member Initial =
     { Files = Map.empty
       FileCheckOptions = Map.empty
       ProjectLoadTimes = Map.empty
-      HelpText = Map.empty }
+      HelpText = Map.empty
+      ColorizationOutput = false }
 
   member x.WithFileTextGetCheckerOptions(file, lines) : State * FSharpProjectOptions =
     let opts =
@@ -93,7 +95,10 @@ module internal Main =
                 let! _parseResults, checkResults = checker.ParseAndCheckFileInProject(fileName, 0, text, options)
                 match checkResults with
                 | FSharpCheckFileAnswer.Aborted -> ()
-                | FSharpCheckFileAnswer.Succeeded results -> Response.errors(results.Errors)
+                | FSharpCheckFileAnswer.Succeeded results ->
+                     Response.errors(results.Errors)
+                     if state.ColorizationOutput then
+                       Response.colorizations(results.GetExtraColorizationsAlternate())
               }
             match kind with
             | Synchronous -> Response.info "Synchronous parsing started"
@@ -237,6 +242,9 @@ module internal Main =
           Response.compilerLocation Environment.fsc Environment.fsi Environment.msbuild
           main state
 
+      | Colorization enabled ->
+          main { state with ColorizationOutput = enabled }
+
       | Error(msg) ->
           Response.error msg
           main state

FsAutoComplete/test/integration/Colorizations/Runner.fsx

@@ -0,0 +1,19 @@
+#load "../TestHelpers.fsx"
+open TestHelpers
+open System.IO
+open System
+
+Environment.CurrentDirectory <- __SOURCE_DIRECTORY__
+File.Delete "output.json"
+
+let p = new FsAutoCompleteWrapper()
+
+p.parse "Script.fsx"
+p.send "colorizations true\n"
+p.parse "Script.fsx"
+p.send "colorizations false\n"
+p.parse "Script.fsx"
+p.send "quit\n"
+p.finalOutput ()
+|> writeNormalizedOutput "output.json"
+

FsAutoComplete/test/integration/Colorizations/Script.fsx

@@ -0,0 +1,95 @@
+open System
+
+#nowarn "40"
+
+let a f = async { let! x = f "hello"
+                  return x }
+
+type LazyList<'T> =
+  | Nil
+  | Cons of 'T * Lazy<LazyList<'T>>
+
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module LazyList =
+  let ofSeq (s:seq<'T>) =
+    let en = s.GetEnumerator()
+    let rec take() =
+      if en.MoveNext() then
+        Cons(en.Current, lazy take())
+      else
+        en.Dispose()
+        Nil
+    take()
+
+type Parser<'T> = P of (LazyList<char> -> ('T * LazyList<char>) list)
+
+
+let result v = P(fun c -> [v, c])
+let zero () = P(fun _ -> [])
+let bind (P p) f = P(fun inp ->
+  [ for (pr, inp') in p inp do
+      let (P pars) = f pr
+      yield! pars inp' ])
+let plus (P p) (P q) = P (fun inp ->
+  (p inp) @ (q inp) )
+
+let (<|>) p1 p2 = plus p1 p2
+
+type ParserBuilder() =
+  member x.Bind(v, f) = bind v f
+  member x.Zero() = zero()
+  member x.Return(v) = result(v)
+  member x.ReturnFrom(p) = p
+  member x.Combine(a, b) = plus a b
+  member x.Delay(f) = f()
+
+let parser = new ParserBuilder()
+
+let item = P(function | LazyList.Nil -> [] | LazyList.Cons(c, r) -> [c,r.Value])
+
+let sat p = parser { 
+  let! v = item 
+  if (p v) then return v }
+
+let char x = sat ((=) x)
+let digit = sat Char.IsDigit    
+let lower = sat Char.IsLower
+let upper = sat Char.IsUpper
+let letter = sat Char.IsLetter
+
+let alphanum = parser { 
+  return! letter
+  return! digit }  
+
+let string (str:string) = 
+  let chars = str.ToCharArray() |> List.ofSeq
+  let rec string' = function
+    | [] -> result []
+    | x::xs -> parser { 
+        let! y = char x
+        let! ys = string' xs 
+        return y::ys }
+  string' chars
+
+#if NOTDEFINED
+let a = 1
+#endif
+
+#if INTERACTIVE
+let b = 2
+#endif
+
+type String = System.String
+
+type MyDictionary = System.Collections.Generic.Dictionary<String,String>
+
+type MyAttribute(text : string) =
+    inherit System.Attribute()
+
+    do printfn "MyAttribute created. Text: %s" text
+
+    member this.Text = text
+
+[<MyAttribute("Hello world")>]    
+type MyClass() =
+    member this.SomeProperty = "This is a property"

FsAutoComplete/test/integration/Colorizations/output.json

@@ -0,0 +1,65 @@
+{
+  "Kind": "info",
+  "Data": "Synchronous parsing started"
+}
+{
+  "Kind": "errors",
+  "Data": []
+}
+{
+  "Kind": "info",
+  "Data": "Synchronous parsing started"
+}
+{
+  "Kind": "errors",
+  "Data": []
+}
+{
+  "Kind": "colorizations",
+  "Data": [
+    {
+      "Range": {
+        "StartColumn": 11,
+        "StartLine": 5,
+        "EndColumn": 16,
+        "EndLine": 5
+      },
+      "Kind": "Keyword"
+    },
+    {
+      "Range": {
+        "StartColumn": 13,
+        "StartLine": 50,
+        "EndColumn": 19,
+        "EndLine": 50
+      },
+      "Kind": "Keyword"
+    },
+    {
+      "Range": {
+        "StartColumn": 16,
+        "StartLine": 60,
+        "EndColumn": 22,
+        "EndLine": 60
+      },
+      "Kind": "Keyword"
+    },
+    {
+      "Range": {
+        "StartColumn": 16,
+        "StartLine": 68,
+        "EndColumn": 22,
+        "EndLine": 68
+      },
+      "Kind": "Keyword"
+    }
+  ]
+}
+{
+  "Kind": "info",
+  "Data": "Synchronous parsing started"
+}
+{
+  "Kind": "errors",
+  "Data": []
+}