-
Notifications
You must be signed in to change notification settings - Fork 79
/
Copy pathLauncher.fs
142 lines (118 loc) · 5.16 KB
/
Launcher.fs
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
namespace FunScript
open System.IO
open System.Net
open System.Threading
open System.Text
// ----------------------------------------------------------------------------
// Simple web server hosting static files
// ----------------------------------------------------------------------------
module RuntimeImplementation =
[<AutoOpen>]
module HttpExtensions =
type System.Net.HttpListener with
member x.AsyncGetContext() =
Async.FromBeginEnd(x.BeginGetContext, x.EndGetContext)
type System.Net.HttpListenerRequest with
member request.InputString =
use sr = new StreamReader(request.InputStream)
sr.ReadToEnd()
type System.Net.HttpListenerResponse with
member response.Reply(s:string) =
let buffer = Encoding.UTF8.GetBytes(s)
response.ContentLength64 <- int64 buffer.Length
response.OutputStream.Write(buffer,0,buffer.Length)
response.OutputStream.Close()
member response.Reply(typ, buffer:byte[]) =
response.ContentLength64 <- int64 buffer.Length
response.ContentType <- typ
response.OutputStream.Write(buffer,0,buffer.Length)
response.OutputStream.Close()
/// Simple HTTP server
type HttpServer private (url, root) =
let contentTypes =
dict [ ".css", "text/css"; ".html", "text/html"; ".js", "text/javascript";
".gif", "image/gif"; ".png", "image/png"; ".jpg", "image/jpeg";
".mp3", "audio/mpeg"; ".wav", "audio/wav"; ".mpg", "video/mpeg" ]
let tokenSource = new CancellationTokenSource()
let agent = MailboxProcessor<HttpListenerContext>.Start((fun inbox -> async {
while true do
let! context = inbox.Receive()
let s = context.Request.Url.LocalPath
// Handle an ordinary file request
let file = root + (if s = "/" then "/index.html" else s)
if File.Exists(file) then
let ext = Path.GetExtension(file).ToLower()
let typ = contentTypes.[ext]
context.Response.Reply(typ, File.ReadAllBytes(file))
else
context.Response.Reply(sprintf "File not found: %s" file) }), tokenSource.Token)
let server = async {
use listener = new HttpListener()
listener.Prefixes.Add(url)
listener.Start()
while true do
let! context = listener.AsyncGetContext()
agent.Post(context) }
do Async.Start(server, cancellationToken = tokenSource.Token)
/// Stops the HTTP server and releases the TCP connection
member x.Stop() = tokenSource.Cancel()
/// Starts new HTTP server on the specified URL. The specified
/// function represents computation running inside the agent.
static member Start(url, root) =
new HttpServer(url, root)
// ----------------------------------------------------------------------------
// Main method that finds 'main' function and generates JS file
// ----------------------------------------------------------------------------
open FunScript
open System.IO
open System.Reflection
open Microsoft.FSharp.Quotations
open RuntimeImplementation
type Runtime private() =
static member Run(?expression, ?port, ?directory, ?components, ?browse) =
let components = defaultArg components []
let port = defaultArg port 8081
let directory = defaultArg directory ""
let browse = defaultArg browse true
// Find the main method in this assembly
let thisAsm = Assembly.GetExecutingAssembly()
let main =
match expression with
| None ->
printfn "Searching for main function..."
let types = thisAsm.GetTypes()
let flags = BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Static
let mains =
[ for typ in types do
for mi in typ.GetMethods(flags) do
if mi.Name = "main" then yield mi ]
let main =
match mains with
| [it] -> it
| _ -> failwith "Main function not found!"
printfn "Found entry point..."
Expr.Call(main, [])
| Some e -> e
// Get the path
let root = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location)
let root = Path.Combine(root, directory)
// Compile the main function into a script
let sw = System.Diagnostics.Stopwatch.StartNew()
let source = FunScript.Compiler.Compiler.Compile(main, components=components)
let sourceWrapped = sprintf "$(document).ready(function () {\n%s\n});" source
let filename = Path.Combine(root, "page.js")
printfn "Generated JavaScript in %f sec..." (float sw.ElapsedMilliseconds / 1000.0)
System.IO.File.Delete filename
System.IO.File.WriteAllText(filename, sourceWrapped)
let shouldOnlyGenerateCode =
System.Environment.GetCommandLineArgs()
|> Array.exists ((=) "--only-generate-code")
if not shouldOnlyGenerateCode then
// Starting the web server
let url = sprintf "http://localhost:%d/" port
let server = HttpServer.Start(url, root)
printfn "Starting web server at %s" url
if browse then
System.Diagnostics.Process.Start(url) |> ignore
System.Console.ReadLine() |> ignore
server.Stop()