scriptcs-fsharp/FSharpScriptEngine.fs at 2cefd3b36e8d69933a3c0bbf38fac6d5fc7fe302 · scriptcs-contrib/scriptcs-fsharp · GitHub

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
namespace ScriptCs.FSharp

open System
open System.Collections.Generic
open System.IO
open System.Linq
open System.Runtime.ExceptionServices
open Microsoft.FSharp.Compiler.Interactive.Shell
open Common.Logging
open ScriptCs
open ScriptCs.Hosting
open ScriptCs.Contracts

type Result =
    | Success of String
    | Error of string
    | Incomplete

type FSharpEngine(host: IScriptHost) =
    let stdin = new StringReader("")

    let stdoutStream = Text.StringBuilder()
    let stdout = new StringWriter(stdoutStream)

    let stderrStream = Text.StringBuilder()
    let stderr = new StringWriter(stderrStream)

    let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
    let commonOptions = [| "c:\\fsi.exe"; "--nologo"; "--readline-"; "--noninteractive"|]
    let session = FsiEvaluationSession.Create(fsiConfig, commonOptions, stdin, stdout, stderr)

    do
        session.EvalInteraction("let env = new System.Collections.Generic.Dictionary<string, obj>()")
        let result = session.EvalExpression("System.Action<string, obj>(fun k v -> env.Add(k, v))")
        match result with
        | Some value -> let func : Action<string, obj> = unbox value.ReflectionValue in func.Invoke("Host", box host)
        | None -> failwith "The system is down"

    let (>>=) (d1:#IDisposable) (d2:#IDisposable) =
        { new IDisposable with
            member x.Dispose() =
                d1.Dispose()
                d2.Dispose() }

    member x.Execute(code) =
        try
            session.EvalInteraction(code)
            if code.EndsWith ";;" then
                let error = stderrStream.ToString()
                if error.Length > 0 then Error(error) else
                Success(stdoutStream.ToString())
            else Incomplete
        with ex -> Error ex.Message

    member x.AddReference(ref) =
        session.EvalInteraction(sprintf "#r @\"%s\"" ref)

    member x.SilentAddReference(ref) =
        x.AddReference(ref)
        stdoutStream.ToString() |> ignore

    member x.ImportNamespace(namespace') =
        session.EvalInteraction(sprintf "open %s" namespace')

    member x.SilentImportNamespace(namespace') =
        x.ImportNamespace(namespace')
        stdoutStream.ToString() |> ignore

    interface IDisposable with
        member x.Dispose() =
            (stdin >>= stdout >>= stderr).Dispose()

type FSharpScriptEngine(scriptHostFactory: IScriptHostFactory, logger: ILog) =
    let [<Literal>] sessionKey = "F# Session"

    interface IScriptEngine with

        member val FileName = "" with get, set

        member val CacheDirectory = "" with get, set

        member val BaseDirectory = "" with get, set

        member x.Execute(code, args, references, namespaces, scriptPackSession) =
            let distinctReferences = references.PathReferences.Union(scriptPackSession.References).Distinct()
            let sessionState =
                match scriptPackSession.State.TryGetValue sessionKey with
                | false, _ ->
                    let host = scriptHostFactory.CreateScriptHost(ScriptPackManager(scriptPackSession.Contexts), args)
                    logger.Debug("Creating session")
                    let session = new FSharpEngine(host)

                    distinctReferences
                    |> Seq.iter (fun ref ->
                        logger.DebugFormat("Adding reference to {0}", ref)
                        session.SilentAddReference ref)

                    namespaces.Union(scriptPackSession.Namespaces).Distinct()
                    |> Seq.iter (fun ns ->
                        logger.DebugFormat("Importing namespace {0}", ns)
                        session.SilentImportNamespace ns)

                    let sessionState = SessionState<_>(References = AssemblyReferences (distinctReferences, Seq.empty), Session = session)
                    scriptPackSession.State.Add(sessionKey, sessionState)
                    sessionState
                | true, res ->
                    logger.Debug("Reusing existing session")
                    let sessionState = res :?> SessionState<FSharpEngine>

                    let newReferences =
                        match sessionState.References with
                        | null -> distinctReferences
                        | refs when Seq.isEmpty refs.PathReferences -> distinctReferences
                        | refs ->  distinctReferences.Except refs.PathReferences
                    newReferences
                    |> Seq.iter (fun ref ->
                        logger.DebugFormat("Adding reference to {0}", ref)
                        sessionState.Session.AddReference ref)
                    sessionState

            match sessionState.Session.Execute(code) with
            | Success result ->
                let cleaned =
                    result.Split([|"\r"; "\n";|], StringSplitOptions.RemoveEmptyEntries)
                    |> Array.filter (fun str -> not(str = "> "))
                    |> String.concat "\r\n"
                ScriptResult(cleaned)
            | Error e -> ScriptResult(compilationException=exn e)
            | Incomplete -> ScriptResult()