Welcome to mirror list, hosted at ThFree Co, Russian Federation.

InteractiveSession.fs « Services « MonoDevelop.FSharpBinding « fsharpbinding « external « main - github.com/mono/monodevelop.git - Unnamed repository; edit this file 'description' to name the repository.
summaryrefslogtreecommitdiff
blob: f461f22c5dd387e5391df02713952d5a6df9b3ac (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
namespace MonoDevelop.FSharp

open System
open System.Reflection
open System.IO
open System.Diagnostics
open MonoDevelop.Ide
open MonoDevelop.Ide.CodeCompletion
open MonoDevelop.Core
open Newtonsoft.Json

type CompletionData = {
    displayText: string
    completionText: string
    category: string
    icon: string
    overloads: CompletionData list
    description: string
}

type InteractiveSession() =
    let (|Completion|_|) (command: string) =
        if command.StartsWith("completion ") then
            let payload = command.[11..]
            Some (JsonConvert.DeserializeObject<CompletionData list> payload)
        else
            None

    let (|Tooltip|_|) (command: string) =
        if command.StartsWith("tooltip ") then
            let payload = command.[8..]
            Some (JsonConvert.DeserializeObject<MonoDevelop.FSharp.Shared.ToolTips> payload)
        else
            None

    let (|ParameterHints|_|) (command: string) =
        if command.StartsWith("parameter-hints ") then
            let payload = command.[16..]
            Some (JsonConvert.DeserializeObject<MonoDevelop.FSharp.Shared.ParameterTooltip list> payload)
        else
            None

    let path = "\"" + Path.Combine(Reflection.Assembly.GetExecutingAssembly().Location |> Path.GetDirectoryName, "MonoDevelop.FSharpInteractive.Service.exe") + "\""
    let mutable waitingForResponse = false

    let fsiProcess =
        let processName = 
            if Environment.runningOnMono then Environment.getMonoPath() else path

        let arguments = 
            if Environment.runningOnMono then path else null

        let startInfo =
            new ProcessStartInfo
              (FileName = processName, UseShellExecute = false, Arguments = arguments,
              RedirectStandardError = true, CreateNoWindow = true, RedirectStandardOutput = true,
              RedirectStandardInput = true, StandardErrorEncoding = Text.Encoding.UTF8, StandardOutputEncoding = Text.Encoding.UTF8)

        try
            Process.Start(startInfo)
        with e ->
            LoggingService.LogDebug (sprintf "Interactive: Error %s" (e.ToString()))
            reraise()

    let textReceived = Event<_>()
    let promptReady = Event<_>()

    let sendCommand(str:string) =
        waitingForResponse <- true
        LoggingService.LogDebug (sprintf "Interactive: sending %s" str)
        let stream = fsiProcess.StandardInput.BaseStream
        let bytes = Text.Encoding.UTF8.GetBytes(str + "\n")
        stream.Write(bytes,0,bytes.Length)
        stream.Flush()

    let completionsReceivedEvent = new Event<CompletionData list>()
    let tooltipReceivedEvent = new Event<MonoDevelop.FSharp.Shared.ToolTips>()
    let parameterHintReceivedEvent = new Event<MonoDevelop.FSharp.Shared.ParameterTooltip list>()
    do
        fsiProcess.OutputDataReceived
          |> Event.filter (fun de -> de.Data <> null)
          |> Event.add (fun de ->
              LoggingService.logDebug "Interactive: received %s" de.Data
              if de.Data.Trim() = "SERVER-PROMPT>" then
                  promptReady.Trigger()
              elif de.Data.Trim() <> "" then
                  if waitingForResponse then waitingForResponse <- false
                  textReceived.Trigger(de.Data + "\n"))

        fsiProcess.ErrorDataReceived.Subscribe(fun de -> 
            if not (String.isNullOrEmpty de.Data) then
                try
                    match de.Data with
                    | Completion completions ->
                        completionsReceivedEvent.Trigger completions
                    | Tooltip tooltip ->
                        tooltipReceivedEvent.Trigger tooltip
                    | ParameterHints hints ->
                        parameterHintReceivedEvent.Trigger hints
                    | _ -> LoggingService.logDebug "[fsharpi] don't know how to process command %s" de.Data
                    
                with 
                | :? JsonException ->
                    LoggingService.logError "[fsharpi] - error deserializing error stream - %s" de.Data
                    ) |> ignore

        fsiProcess.EnableRaisingEvents <- true

    member x.Interrupt() =
        LoggingService.logDebug "Interactive: Break!"

    member x.CompletionsReceived = completionsReceivedEvent.Publish
    member x.TooltipReceived = tooltipReceivedEvent.Publish
    member x.ParameterHintReceived = parameterHintReceivedEvent.Publish

    member x.StartReceiving() =
        fsiProcess.BeginOutputReadLine()
        fsiProcess.BeginErrorReadLine()

    member x.TextReceived = textReceived.Publish
    member x.PromptReady = promptReady.Publish

    member x.Kill() =
        if not fsiProcess.HasExited then
            x.SendInput "#q;;"
            for i in 0 .. 10 do
                if not fsiProcess.HasExited then
                    LoggingService.logDebug "Interactive: waiting for process exit after #q... %d" (i*200)
                    fsiProcess.WaitForExit(200) |> ignore

        if not fsiProcess.HasExited then
            fsiProcess.Kill()
            for i in 0 .. 10 do
                if not fsiProcess.HasExited then
                    LoggingService.logDebug "Interactive: waiting for process exit after kill... %d" (i*200)
                    fsiProcess.WaitForExit(200) |> ignore

    member x.SendInput input =
        for line in String.getLines input do
            sendCommand ("input " + line)
    
    member x.SendCompletionRequest input column =
        sendCommand (sprintf "completion %d %s" column input)

    member x.SendParameterHintRequest input column =
        sendCommand (sprintf "parameter-hints %d %s" column input)

    member x.SendTooltipRequest input  =
        sendCommand (sprintf "tooltip %s" input)

    member x.Exited = fsiProcess.Exited