Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
FunScript/examples/Shared/Launcher.fs
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
142 lines (118 sloc)
5.16 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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() |